decodedate - formatdatetime delphi

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

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.?

ACTUALIZAR:

Gabr dio 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 así (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 supone que desea redondear con una 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 en un minuto, hora o incluso segundo, simplemente decodifique y luego codifique el valor de la 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 / decodificar 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.
Desafortunadamente, dado que los valores de tiempo son flotantes, siempre existe la posibilidad de pequeños errores de redondeo, por lo que es posible que no obtenga el valor esperado ...

Answer 4

¡Guauu! 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 partes de milisenconds:

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;

Puedes simplemente probarlo con este ejemplo común o no tan común:

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

Espero que esto ayude a las personas como yo, que necesitan redondear a 1/100, 1/25 o 1/10 segundos.

Answer 5

Si quieres RoundUp o RoundDown ... como Ceil y Floor ...

Aquí hay (no olvides agregar la unidad de Matemáticas a tu cláusula de uso):

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 a 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 Float) en la misma unidad ... agregue la directiva de sobrecarga en la sección de la interfaz, por 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. Utilizo esto porque me parece que la fecha y la hora tiende a "derivar" si la incrementa varias horas o minutos, lo que puede complicar las cosas si está trabajando en una serie temporal 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 de la salida Creo que es un error, no debería estar allí. Mi código con correcciones y 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;