Datetime rounding enhancement

[h.hasenack]

I have been using this patch for a long time now, to allow better rounding of intervals < half month. It also allows rounding of dates before 1-1-1900.

Code: Select all

Function TeeRoundDate(Const ADate:TDateTime; AStep:TDateTimeStep):TDateTime;
var Year  : Word;
    Month : Word;
    Day   : Word;
begin
  if ADate=0 then // only suppress rounding for the Delphi 'null' date 30-12-1899
     result:=ADate
  else
  begin
    if AStep<dtHalfMonth then
    begin
      Case AStep of
        dtOneDay: result:=round(ADate); 
        dtTwoDays: result:=round(ADate/2.0)*2;
        dtThreeDays: result:=round(ADate/3.0)*3;
        dtOneWeek: result:=2.0+round((ADate-2.0)/7.0)*7;
        else result:=ADate;
      end;
    end
    else
    begin
      DecodeDate(ADate,Year,Month,Day);
      Case AStep of
         dtHalfMonth   : if Day>=15 then Day:=15
                                    else Day:=1;
         dtOneMonth,
         dtTwoMonths,
         dtThreeMonths,
         dtFourMonths,
         dtSixMonths   : Day:=1;
         dtOneYear     : begin
                           Day:=1;
                           Month:=1;
                         end;
      end;
      result:=EncodeDate(Year,Month,Day);
    end;
  end;
end;

[Yeray]

Hi Hans,

I've added this to the wish list to be implemented in future releases (TV52014310).

Thank you.

[Narcís]

Hi Hans,

Thanks for your feedback! I've added your suggestion to v8 sources so that you can expect this being in next maintenance release.