En Delphi: ¿Cómo redondeo un TDateTime al segundo, minuto, minuto más cercano, etc.?

Question

¿Existe una rutina en Delphi que redondea un valor de TDateTime al segundo más cercano, a la hora más cercana, a los 5 minutos más cercanos, a la media hora más cercana, etc.?

ACTUALIZACIÓN:

Gabr proporcionan una respuesta. Hubo algunos errores pequeños, posiblemente debido a la falta total de pruebas ;-)

lo limpié un poco y lo probé, y aquí está la versión final (?):

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

Algo por el estilo (completamente no probado, escrito directamente en el navegador):

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; 

El código asume que desea redondear con la segunda precisión. Milisegundos son desechados.

Answer 2

Aquí hay un código no probado con precisión ajustable.

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

Pruebe la unidad DateUtils.
Pero para redondear un minuto, una hora o incluso un segundo, simplemente decodifique y luego codifique el valor de fecha, con milisegundos, segundos y minutos configurados en cero. Redondear a múltiplos de minutos u horas solo significa: decodificar, redondear hacia arriba o hacia abajo las horas o minutos, luego codificar de nuevo.
Para codificar/descodificar valores de tiempo, use EncodeTime/DecodeTime de SysUtils. Use EncodeDate/DecodeDate para las fechas. Debería ser posible crear sus propias funciones de redondeo con todo esto.
Además, la función SysUtils tiene constantes como MSecsPerDay, SecsPerDay, SecsPerMin, MinsPerHour y HoursPerDay. Un tiempo es básicamente el número de milisegundos pasada la medianoche. Puede miliplicar Frac (Tiempo) con MSecsPerDay, que es la cantidad exacta de milisegundos.
Por desgracia, ya que los valores de tiempo son los flotadores, siempre hay una posibilidad de pequeños errores de redondeo, por lo que no podría obtener el valor esperado ...

Answer 4

Wow! chicos, ¿cómo complicar demasiado algo tan simple ... también la mayoría de ustedes pierden la opción de redondear a 1/100 segundo más cercano, etc ...

Este es mucho más simple y también puede redondear a milisenconds partes:

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; 

Sólo puede probar con estos ejemplos tan comunes o no comunes:

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

esperanza esto ayuda a la gente como yo, que deben redondear a 1/100, 1/25 o 1/10 segundos.

Answer 5

Si desea RoundUp o RoundDown ... como techo y el piso ...

Aquí hay (no se olvide de agregar unidad de matemáticas a su cláusula de usos):

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; 

Y por supuesto con un pequeño cambio (use el tipo Float en lugar del tipo TDateTime) si también se puede usar para los valores Round/RoundUp y RoundDown decimal/float en un paso decimal/flotante.

Aquí están:

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; 

Si desea utilizar ambos tipos (TDateTime y flotar) en la misma unidad ... añadir Directiva sobrecarga en sección de interfaz, ejemplo:

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

Este es un fragmento de código muy útil, lo utilizo porque me parece que el datetime tiende a 'derivar' si lo incrementa muchas horas o minutos, lo que puede complicar las cosas si está trabajando en una serie de tiempo estricta. por ejemplo, 00: 00: 00,000 pasa a ser 23: 59: 59.998 Implementé la versión Sveins del código de Gabrs, pero sugiero algunas enmiendas: el valor predeterminado no me funcionó, también el '(vTimeSec/SecsPerDay)' después del Salir, creo que es un error, no debería estar allí. Mi código con las correcciones & comentarios, es:

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;