In Delphi: How do I round a TDateTime to closest second, minute, five-minute etc?

Does there exist a routine in Delphi that rounds a TDateTime value to the closest second, closest hour, closest 5-minute, closest half hour etc?

UPDATE:

Gabr provided an answer. There were some small errors, possibly due to the complete lack of testing ;-)

I cleaned it up a bit and tested it, and here's the final(?) version:

function RoundDateTimeToNearestInterval(vTime : TDateTime; vInterval : TDateTime = 5*60/SecsPerDay) : TDateTime;
var
  vTimeSec,vIntSec,vRoundedSec : int64;
begin
  //Rounds to nearest 5-minute by def开发者_如何学Pythonault
  vTimeSec := round(vTime * SecsPerDay);
  vIntSec := round(vInterval * SecsPerDay);

  if vIntSec = 0 then exit(vTimeSec / SecsPerDay);

  vRoundedSec := round(vTimeSec / vIntSec) * vIntSec;

  Result := vRoundedSec / SecsPerDay;
end;

---

Wow! guys, how do you complicate too much something so simple... also most of you loose the option to round to nearest 1/100 second, etc...

This one is much more simple and can also round to milisenconds parts:

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;

You can just test it with this common or not so common examples:

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

Hope this helps people like me, that need to round to 1/100, 1/25 or 1/10 seconds.

---

Something like that (completely untested, written directly in browser):

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;

The code assumes you want rounding with second precision. Milliseconds are thrown away.

---

If you want to RoundUp or RoundDown ... like Ceil and Floor...

Here there are (do not forget to add Math unit to your uses clause):

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;

And of course with a minor change (use Float type instead of TDateTime type) if can also be used to Round, RoundUp and RoundDown decimal/float values to a decimal/float step.

Here they are:

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;

If you want to use both types (TDateTime and Float) on same unit... add overload directive on interface section, example:

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;

---

Here is an untested code with adjustable precision.

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;

---

Try the DateUtils unit.
But to round on a minute, hour or even second, just Decode and then encode the date value, with milliseconds, seconds and minutes set to zero. Rounding to multiples of minutes or hours just means: decode, round up or down the hours or minutes, then encode again.
To encode/decode time values, use EncodeTime/DecodeTime from SysUtils. Use EncodeDate/DecodeDate for dates. It should be possible to create your own rounding functions with all of this.
Also, the SysUtils function has constants like MSecsPerDay, SecsPerDay, SecsPerMin, MinsPerHour and HoursPerDay. A time is basically the number of milliseconds past midnight. You can miltiply Frac(Time) with MSecsPerDay, which is the exact number of milliseconds.
Unfortunately, since time values are floats, there's always a chance of small rounding errors, thus you might not get the expected value...

---

If anyone reads this far down in the post then here's another thought. As z666zz666z said, it doesn't have to be complicated. TDateTime in Delphi is a double precision floating point number with the integer portion representing the day. If the rounding value is passed as the number of 'periods' in the day then the rounding function would simply be: Round(dt * RoundingValue) / RoundingValue. The method would be:

procedure RoundTo(var dt: TDateTime; RoundingValue:integer);
    begin
    if RoundingValue > 0 then
        dt := Round(dt * RoundingValue) / RoundingValue;
    end;

Examples:

RoundTo(targetDateTime, SecsPerDay); // round to the nearest second
RoundTo(targetDateTime, SecsPerDay div 10); // round to the nearest 10 seconds
RoundTo(targetDateTime, MinsPerDay); // round to the nearest minute
RoundTo(targetDateTime, MinsPerDay div 5); // round to the nearest five minutes
RoundTo(targetDateTime, HoursPerDay); // round to the nearest hour

It even caters to sub second rounding:

RoundTo(targetDateTime, SecsPerDay * 10); // round to the nearest 1/10 second

---

This is a very useful bit of code, I use this because I find the datetime tends to 'drift' if you increment it by hours or minutes many times over, which can mess things up if you're working to a strict time series. eg so 00:00:00.000 becomes 23:59:59.998 I implemented Sveins version of Gabrs code, but I suggest a few amendments: The default value didn't work for me, also the '(vTimeSec / SecsPerDay)' after the exit I think is a mistake, it shouldn't be there. My code with corrections & comments, is:

    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;

---

The simplest (round to minutes):

DateTime := OneMinute * Round(DateTime / OneMinute);