Datetime rounding enhancement
Posted: Fri Jul 24, 2009 9:33 am
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;