type
PDayTable = ^TDayTable;
TDayTable = array[1..12] of Word;
const
MonthDays: array [Boolean] of TDayTable =
((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
function IsLeapYear(Year: Word): Boolean;
begin
Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;
function DoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
var
I: Integer;
DayTable: PDayTable;
begin
Result := False;
DayTable := @MonthDays[IsLeapYear(Year)];
if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
(Day >= 1) and (Day <= DayTable^[Month]) then
begin
for I := 1 to Month - 1 do Inc(Day, DayTable^[i]);
I := Year - 1;
Date := I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta;
Result := True;
end;
end;
procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word);
const
D1 = 365;
D4 = D1 * 4 + 1;
D100 = D4 * 25 - 1;
D400 = D100 * 4 + 1;
var
Y, M, D, I: Word;
T: Integer;
DayTable: PDayTable;
begin
T := DateTimeToTimeStamp(Date).Date;
if T <= 0 then
begin
Year := 0;
Month := 0;
Day := 0;
end else
begin
Dec(T);
Y := 1;
while T >= D400 do
begin
Dec(T, D400);
Inc(Y, 400);
end;
DivMod(T, D100, I, D);
if I = 4 then
begin
Dec(I);
Inc(D, D100);
end;
Inc(Y, I * 100);
DivMod(D, D4, I, D);
Inc(Y, I * 4);
DivMod(D, D1, I, D);
if I = 4 then
begin
Dec(I);
Inc(D, D1);
end;
Inc(Y, I);
DayTable := @MonthDays[IsLeapYear(Y)];
M := 1;
while True do
begin
I := DayTable^[M];
if D < I then Break;
Dec(D, I);
Inc(M);
end;
Year := Y;
Month := M;
Day := D + 1;
end;
end;