В Delphi: Как мне округлить TDateTime до ближайшей секунды, минуты, пяти минут и т. Д.?

Question

Существует ли в Delphi подпрограмма, округляющая значение TDateTime до ближайшей секунды, ближайшего часа, ближайшей 5-минутной, ближайшей получасовой и т. Д.?

ОБНОВЛЕНИЕ:

Габр предоставил ответ.Были небольшие ошибки, возможно, из-за полного отсутствия тестирования; -)

Я немного его почистил и протестировал, и вот окончательная (?) Версия:

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

Что-то в этом роде (полностью не проверено, написано прямо в браузере):

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;

Код предполагает, что вы хотите округлить с точностью до секунды. Миллисекунды выбрасываются.

Answer 2

Вау! ребята, как вы слишком усложняете что-то такое простое ... также большинство из вас теряет возможность округления до ближайшей 1/100 секунды и т. д.

Это намного проще и может округлять до миллисекунд:

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 секунды.

Answer 3

Если вы хотите использовать RoundUp или RoundDown ... например, Ceil и Floor ...

Здесь есть (не забудьте добавить единицу Math к вашему предложению использования):

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;

Answer 4

Попробуйте блок DateUtils.Но для округления до минуты, часа или даже секунды просто декодируйте, а затем закодируйте значение даты, задав миллисекунды, секунды и минуты равными нулю.Округление до кратности минут или часов просто означает: декодировать, округлить вверх или вниз часы или минуты, а затем снова кодировать.Для кодирования / декодирования значений времени используйте EncodeTime / DecodeTime из SysUtils.Используйте EncodeDate / DecodeDate для дат.Должно быть возможно создать свои собственные функции округления со всем этим.Кроме того, функция SysUtils имеет такие константы, как MSecsPerDay, SecsPerDay, SecsPerMin, MinsPerHour и HoursPerDay.Время - это количество миллисекунд после полуночи.С помощью MSecsPerDay вы можете использовать Frac (Time), который является точным числом миллисекунд. К сожалению, поскольку значения времени являются числами с плавающей запятой, всегда есть вероятность небольших ошибок округления, поэтому вы можете не получить ожидаемое значение ...

Answer 5

Вот непроверенный код с регулируемой точностью.

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 6

Это очень полезный фрагмент кода, я использую его, потому что нахожу, что дата и время имеют тенденцию к «дрейфу», если вы увеличиваете его на часы или минуты много раз, что может испортить ситуацию, если вы работаете со строгимВременные ряды.например, 00: 00: 00.000 становится 23: 59: 59,998. Я реализовал версию кода Габрса 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;