2010-11-08 13 views
13

Esiste una routine in Delphi che arrotonda un valore TDateTime al secondo più vicino, all'ora più vicina, alla mezz'ora più vicina, alla mezz'ora più vicina ecc.?In Delphi: Come faccio a arrotondare un TDateTime al secondo più prossimo, minuto, cinque minuti ecc?

UPDATE:

Gabr fornito una risposta. Ci sono stati alcuni piccoli errori, probabilmente a causa della completa mancanza di prove ;-)

ho pulito un po 'e provato, ed ecco la versione definitiva (?):

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; 
+0

che cosa era sbagliato con la mia risposta? –

+0

Niente, davvero, mi è appena capitato di testare prima la soluzione di Gabr. Inoltre, il suo suggerimento di un singolo parametro per tipo di intervallo E dimensione era più elegante di una soluzione con DUE parametri per la stessa cosa. Secondo me almeno. –

+0

Questo è un bit di codice molto utile, trovo che il datetime tende a 'drift' se lo si incrementa di ore o minuti molte volte. che può rovinare le cose se stai lavorando a una serie temporale rigorosa. Qualche pecca sul tuo esempio, anche se Svein, il valore predefinito non ha funzionato per me, anche il '(vTimeSec/SecsPerDay)' dopo l'uscita, penso che sia un errore, non dovrebbe esserci. Il mio codice con correzioni e commenti, è: – SolarBrian

risposta

8

Qualcosa del genere (completamente testato, scritto direttamente in browser):

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; 

Il codice presuppone che si desidera arrotondare con la seconda precisione. I millisecondi vengono gettati via.

+0

Grazie! Ci sono stati alcuni piccoli errori, ma l'ho ripulito un po ':-) –

2

Ecco un codice non testato con precisione regolabile.

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; 
2

Provare l'unità DateUtils.
Ma per arrotondare su un minuto, un'ora o anche un secondo, basta Decodificare e quindi codificare il valore della data, con millisecondi, secondi e minuti impostati su zero. Arrotondare a multipli di minuti o ore significa semplicemente: decodificare, arrotondare in su o in giù per le ore o i minuti, quindi eseguire nuovamente la codifica.
Per codificare/decodificare i valori temporali, utilizzare EncodeTime/DecodeTime da SysUtils. Utilizzare EncodeDate/DecodeDate per le date. Dovrebbe essere possibile creare le proprie funzioni di arrotondamento con tutto questo.
Inoltre, la funzione SysUtils ha costanti come MSecsPerDay, SecsPerDay, SecsPerMin, MinsPerHour e HoursPerDay. Un tempo è fondamentalmente il numero di millisecondi dopo la mezzanotte. Miltiply Frac (Time) con MSecsPerDay, che è il numero esatto di millisecondi.
Purtroppo, dal momento che i valori di tempo sono galleggianti, c'è sempre una possibilità di piccoli errori di arrotondamento, in tal modo si potrebbe non ottenere il valore atteso ...

7

Wow! ragazzi, come complicate troppo qualcosa di così semplice ... anche la maggior parte di voi perde l'opzione per arrotondare a 1/100 di secondo, ecc ...

Questo è molto più semplice e può anche arrotondare a milisecondi parti:

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; 

si può solo provare con questo comune o non così esempi comuni:

// 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)) 
         ) 
      ); 

Spero che questo aiuti le persone come me, che hanno bisogno di arrotondare al 1/100, 1/25 o 1/10 secondi.

5

Se si vuole RoundUp o RoundDown ... come soffitto e pavimento ...

Qui ci sono (non dimenticare di aggiungere unità di matematica al vostro clausola uses):

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; 

E ovviamente con una modifica minore (utilizzare il tipo Float invece del tipo TDateTime) se può essere utilizzato anche per arrotondare, arrotondare e arrotondare i valori decimali/mobili a un decimale/virgola mobile.

Eccoli:

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; 

Se si desidera utilizzare entrambi i tipi (TDateTime e Float) sulla stessa unità ... aggiungi direttiva sovraccarico nella sezione interfaccia, ad esempio:

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; 
0

Questo è un bit di codice molto utile, lo uso perché trovo che il datetime tende a 'drift' se lo si incrementa di ore o minuti molte volte, il che può rovinare tutto se si lavora su serie temporali rigorose. ad es. 00: 00: 00.000 diventa 23: 59: 59.998 Ho implementato la versione di Sveins del codice Gabrs, ma suggerisco alcune modifiche: Il valore predefinito non ha funzionato per me, anche il '(vTimeSec/SecsPerDay)' dopo il uscita penso sia un errore, non dovrebbe essere lì. Il mio codice con correzioni & commenti, è:

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; 
Problemi correlati