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;