В Delphi: Как мне пройти TDateTime до ближайшей секунды, минуты, пяти минут и т.д.?
Существует ли в Delphi подпрограмма, которая округляет значение TDateTime до ближайшего второго, ближайшего часа, ближайшего 5-минутного, ближайшего полчаса и т.д.?
UPDATE:
Габр дал ответ. Были некоторые небольшие ошибки, возможно, из-за полного отсутствия тестирования; -)
Я немного почистил его и протестировал, и вот финальная версия (?):
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;
Ответы
Ответ 1
Нечто подобное (полностью не проверено, написано прямо в браузере):
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;
Код предполагает, что вы хотите округлить со второй точностью. Миллисекунды выбрасываются.
Ответ 2
Ничего себе! ребята, как вы усложняете слишком много чего-то такого простого... также большинство из вас теряют возможность округлять до ближайшей 1/100 секунды и т.д.
Это намного проще и может также округлить до частей 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;
Вы можете просто протестировать его с помощью таких распространенных или не очень распространенных примеров:
// 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))
)
);
Надеюсь, что это помогает людям вроде меня, которым нужно округлить до 1/100, 1/25 или 1/10 секунд.
Ответ 3
Если вы хотите RoundUp или RoundDown... как Ceil и Floor...
Здесь есть (не забудьте добавить модуль Math в свой раздел 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;
И, конечно, с незначительными изменениями (используйте тип Float вместо типа TDateTime), если их также можно использовать для округления, округления и округления до десятичных/плавающих значений до десятичного/плавающего шага.
Вот они:
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;
Если вы хотите использовать оба типа (TDateTime и Float) на одном устройстве... добавьте директиву по перегрузке в разделе раздела, например:
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;
Ответ 4
Вот непроверенный код с регулируемой точностью.
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;
Ответ 5
Попробуйте блок DateUtils.
Но чтобы округлить минуту, час или даже секунду, просто декодируйте, а затем закодируйте значение даты, с миллисекундами, секундами и минутами, установленными на ноль. Округление до нескольких минут или часов просто означает: декодировать, округлять или уменьшать часы или минуты, а затем снова закодировать.
Для кодирования/декодирования значений времени используйте EncodeTime/DecodeTime из SysUtils. Используйте EncodeDate/DecodeDate для дат. Должно быть возможно создать ваши собственные функции округления со всем этим.
Кроме того, функция SysUtils имеет такие константы, как MSecsPerDay, SecsPerDay, SecsPerMin, MinsPerHour и HoursPerDay. Время в основном составляет миллисекунды за полночь. Вы можете использовать Frac (Time) с помощью MSecsPerDay, который является точным числом миллисекунд.
К сожалению, поскольку значения времени являются поплавками, всегда есть вероятность небольших ошибок округления, поэтому вы не можете получить ожидаемое значение...
Ответ 6
Это очень полезный бит кода, я использую это, потому что я нахожу, что datetime имеет тенденцию "дрейфовать", если вы увеличиваете его на несколько часов или минут много раз, что может испортить ситуацию, если вы работаете со строгим Временные ряды. например, 00: 00: 00.000 становится 23: 59: 59.998
Я внедрил версию кода Gabrs для Sveins, но я предлагаю несколько поправок: значение по умолчанию для меня не срабатывало, а также "(vTimeSec/SecsPerDay)" после выхода, я думаю, это ошибка, его не должно быть. Мой код с исправлениями и комментариями:
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;
