Delphi'de: Bir TDateTime'ı en yakın ikinci, dakika, beş dakika vb.

Question

Delphi'de bir TDateTime değerini en yakın ikinci, en yakın saate, en yakın 5 dakikalık, en yakın yarım saate varan bir rutin var mı?

GÜNCELLEME:

Gabr bir cevap verdi. Orada bazı küçük hatalar muhtemelen bunu biraz o kadar temizlenir ve test

;-) test tam olmaması nedeniyle, vardı ve burada son hali var (?): Böyle

function RoundDateTimeToNearestInterval(vTime : TDateTime; vInterval : TDateTime = 5*60/SecsPerDay) : TDateTime; 
var 
    vTimeSec,vIntSec,vRoundedSec : int64; 
begin 
    //Rounds to nearest 5-minute by default 
    vTimeSec := round(vTime * SecsPerDay); 
    vIntSec := round(vInterval * SecsPerDay); 

    if vIntSec = 0 then exit(vTimeSec/SecsPerDay); 

    vRoundedSec := round(vTimeSec/vIntSec) * vIntSec; 

    Result := vRoundedSec/SecsPerDay; 
end; 

Answer 1

şey (tamamen tarayıcıda yazılmamış, tamamen denenmemiş):

function RoundToNearest(time, interval: TDateTime): TDateTime; 
var 
    time_sec, int_sec, rounded_sec: int64; 
begin 
    time_sec := Round(time * SecsPerDay); 
    int_sec := Round(interval * SecsPerDay); 
    rounded_sec := (time_sec div int_sec) * int_sec; 
    if (rounded_sec + int_sec - time_sec) - (time_sec - rounded_sec) then 
    rounded_sec := rounded_sec + time+sec; 
    Result := rounded_sec/SecsPerDay; 
end; 

Bu kod, ikinci hassasiyetle yuvarlamayı istediğinizi varsayar. Milisaniye atıldı.

Answer 2

İşte, ayarlanabilir hassasiyete sahip denenmemiş bir kod.

Type 
    TTimeDef = (tdSeconds, tdMinutes, tdHours, tdDays) 

function ToClosest(input : TDateTime; TimeDef : TTimeDef ; Range : Integer) : TDateTime 
var 
    Coeff : Double; 
RInteger : Integer; 
DRInteger : Integer; 
begin 
    case TimeDef of 
    tdSeconds : Coeff := SecsPerDay; 
    tdMinutes : Coeff := MinsPerDay; 
    tdHours : Coeff := MinsPerDay/60; 
    tdDays : Coeff := 1; 
    end; 

    RInteger := Trunc(input * Coeff); 
    DRInteger := RInteger div Range * Range 
    result := DRInteger/Coeff; 
    if (RInteger - DRInteger) >= (Range/2) then 
    result := result + Range/Coeff; 

end; 

Answer 3

DateUtils birimini deneyin.
Ama bir dakika, saat veya hatta bir saniye boyunca, sadece Decode ve daha sonra tarih değerini kodlayın, milisaniye, saniye ve dakika sıfıra ayarlanmış. Dakikalar veya saatlerin katları için yuvarlama, sadece şu anlama gelir: kod çözme, saat veya dakikaları yuvarlama veya yuvarlama, sonra tekrar kodlama.
Zaman değerlerini kodlamak/kod çözmek için SysUtils'ten EncodeTime/DecodeTime kullanın. Tarihler için EncodeDate/DecodeDate kullanın. Tümüyle kendi yuvarlama fonksiyonlarınızı yaratmak mümkün olmalıdır.
Ayrıca, SysUtils işlevi, MSecsPerDay, SecsPerDay, SecsPerMin, MinsPerHour ve HoursPerDay gibi sabitleri vardır. Bir zaman, temel olarak gece yarısından sonra geçen milisaniyelerin sayısıdır. Milisaniye sayısı tam olan MScsPerDay ile Frac (Zaman) miltiply yapabilirsiniz. saat değerleri yüzer olduğundan
yazık ki,

Answer 4

Vay ... böylece beklenen değer almayabilir, her zaman küçük yuvarlama hatalarının bir şans var! çocuklar, çok basit şeyleri nasıl karmaşıklaştırıyorsunuz ... ayrıca çoğunuz en yakın 1/100 saniyeye kadar yuvarlama seçeneğinizi kaybedersiniz ...

Bu, çok daha basit ve aynı zamanda milisenaniye yuvarlanabilir parçalar:

function RoundToNearest(TheDateTime,TheRoundStep:TDateTime):TdateTime; 
    begin 
     if 0=TheRoundStep 
     then begin // If round step is zero there is no round at all 
        RoundToNearest:=TheDateTime; 
       end 
     else begin // Just round to nearest multiple of TheRoundStep 
        RoundToNearest:=Round(TheDateTime/TheRoundStep)*TheRoundStep; 
       end; 
    end; 

sadece bu ortak ya da değil çok yaygın örnekleri ile test edebilirsiniz: Bu benim gibi insanlara yardım

// Note: Scroll to bottom to see examples of round to 1/10 of a second, etc 

// Round to nearest multiple of one hour and a half (round to 90'=1h30') 
ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(1,30,0,0)) 
         ) 
      ); 

// Round to nearest multiple of one hour and a quarter (round to 75'=1h15') 
ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(1,15,0,0)) 
         ) 
      ); 

// Round to nearest multiple of 60 minutes (round to hours) 
ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(1,0,0,0)) 
         ) 
      ); 

// Round to nearest multiple of 60 seconds (round to minutes) 
ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(0,1,0,0)) 
         ) 
      ); 

// Round to nearest multiple of second (round to seconds) 
ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(0,0,1,0)) 
         ) 
      ); 

// Round to nearest multiple of 1/100 seconds 
ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,141) 
             ,EncodeTime(0,0,0,100)) 
         ) 
      ); 

// Round to nearest multiple of 1/100 seconds 
    ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(0,0,0,100)) 
         ) 
      ); 

// Round to nearest multiple of 1/10 seconds 
    ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,151) 
             ,EncodeTime(0,0,0,10)) 
         ) 
      ); 

// Round to nearest multiple of 1/10 seconds 
    ShowMessage(FormatDateTime('hh:nn:ss.zzz' 
          ,RoundToNearest(EncodeTime(15,31,37,156) 
             ,EncodeTime(0,0,0,10)) 
         ) 
      ); 

Hope, o isteği Yuvarlamada 1/100, 1/25 veya 1/10 saniye.

Ceil ve Kat gibi

Answer 5

Eğer RoundUp veya ROUNDDOWN istiyorsanız ... ... İşte

vardır (sizin kullandığı maddeye Matematik birim eklemek için unutmayın):

function RoundUpToNearest(TheDateTime,TheRoundStep:TDateTime):TDateTime; 
    begin 
     if 0=TheRoundStep 
     then begin // If round step is zero there is no round at all 
        RoundUpToNearest:=TheDateTime; 
       end 
     else begin // Just round up to nearest bigger or equal multiple of TheRoundStep 
        RoundUpToNearest:=Ceil(TheDateTime/TheRoundStep)*TheRoundStep; 
       end; 
    end; 

function RoundDownToNearest(TheDateTime,TheRoundStep:TDateTime):TDateTime; 
    begin 
     if 0=TheRoundStep 
     then begin // If round step is zero there is no round at all 
        RoundDownToNearest:=TheDateTime; 
       end 
     else begin // Just round down to nearest lower or equal multiple of TheRoundStep 
        RoundDownToNearest:=Floor(TheDateTime/TheRoundStep)*TheRoundStep; 
       end; 
    end; 

Ve Tabii ki, yuvarlak, RoundUp ve RoundDown ondalık/float değerleri bir ondalık/float adım için de kullanılabilir eğer küçük bir değişiklik ile (TDateTime tipi yerine Float kullanın).İşte

onlar:

function RoundUpToNearest(TheValue,TheRoundStep:Float):Float; 
    begin 
     if 0=TheRoundStep 
     then begin // If round step is zero there is no round at all 
        RoundUpToNearest:=TheValue; 
       end 
     else begin // Just round up to nearest bigger or equal multiple of TheRoundStep 
        RoundUpToNearest:=Ceil(TheValue/TheRoundStep)*TheRoundStep; 
       end; 
    end; 

function RoundToNearest(TheValue,TheRoundStep:Float):Float; 
    begin 
     if 0=TheRoundStep 
     then begin // If round step is zero there is no round at all 
        RoundToNearest:=TheValue; 
       end 
     else begin // Just round to nearest multiple of TheRoundStep 
        RoundToNearest:=Floor(TheValue/TheRoundStep)*TheRoundStep; 
       end; 
    end; 

function RoundDownToNearest(TheValue,TheRoundStep:Float):Float; 
    begin 
     if 0=TheRoundStep 
     then begin // If round step is zero there is no round at all 
        RoundDownToNearest:=TheDateTime; 
       end 
     else begin // Just round down to nearest lower or equal multiple of TheRoundStep 
        RoundDownToNearest:=Floor(TheValue/TheRoundStep)*TheRoundStep; 
       end; 
    end; 

hem türlerini kullanmak (TDateTime ve Float) aynı birimdeki ... arayüz bölümünde aşırı yük yönergesini eklemek istiyorsanız, örnek:

function RoundUpToNearest(TheDateTime,TheRoundStep:TDateTime):TDateTime;overload; 
function RoundToNearest(TheDateTime,TheRoundStep:TDateTime):TDateTime;overload; 
function RoundDownToNearest(TheDateTime,TheRoundStep:TDateTime):TDateTime;overload; 

function RoundUpToNearest(TheValue,TheRoundStep:Float):Float;overload; 
function RoundToNearest(TheValue,TheRoundStep:Float):Float;overload; 
function RoundDownToNearest(TheValue,TheRoundStep:Float):Float;overload; 

Answer 6

Bu çok kullanışlı bir kod, ben bunu kullanıyorum çünkü datetime 'drift' eğilimi buluyorum çünkü saatlerce ya da dakikalarca defalarca artırırsanız, zaman serileri için çalışıyorsanız, işlerinizi halledebilirsiniz. Örneğin 00: 00: 00.000: 23: 59: 59.998 Gabrs kodunun Sveins versiyonunu uygulamıştım, ama birkaç değişiklik önerdim: Varsayılan değer benim için de işe yaramadı, aynı zamanda '(vTimeSec/SecsPerDay)' çıkış sanırım bir hata, orada olmamalı. Düzeltmeler & ile ilgili yorum kodunuz:

Procedure TNumTool.RoundDateTimeToNearestInterval 
         (const ATime:TDateTime; AInterval:TDateTime{=5*60/SecsPerDay}; Var Result:TDateTime); 
    var           //Rounds to nearest 5-minute by default 
     vTimeSec,vIntSec,vRoundedSec : int64;  //NB datetime values are in days since 12/30/1899 as a double 
    begin 
     if AInterval = 0 then 
     AInterval := 5*60/SecsPerDay;     // no interval given - use default value of 5 minutes 
     vTimeSec := round(ATime * SecsPerDay);   // input time in seconds as integer 
     vIntSec := round(AInterval * SecsPerDay);  // interval time in seconds as integer 
     if vIntSec = 0 then 
     exit;           // interval is zero -cannot round the datetime; 
     vRoundedSec := round(vTimeSec/vIntSec) * vIntSec; // rounded time in seconds as integer 
     Result  := vRoundedSec/SecsPerDay;    // rounded time in days as tdatetime (double) 
    end;