mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 10:18:22 +02:00
47 lines
877 B
ObjectPascal
47 lines
877 B
ObjectPascal
{ %opt=-Co -Cr -O2 }
|
|
program ddbug;
|
|
|
|
{$mode objfpc}
|
|
|
|
const datedelta=693594;
|
|
|
|
procedure DecodeDate(Date:double; out Year, Month, Day: word);
|
|
var
|
|
ly,ld,lm,j : cardinal;
|
|
begin
|
|
if Date <= -datedelta then // If Date is before 1-1-1 then return 0-0-0
|
|
begin
|
|
Year := 0;
|
|
Month := 0;
|
|
Day := 0;
|
|
end
|
|
else
|
|
begin
|
|
j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
|
|
ly:= j DIV 146097;
|
|
j:= j - 146097 * cardinal(ly);
|
|
ld := j SHR 2;
|
|
j:=(ld SHL 2 + 3) DIV 1461;
|
|
ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
|
|
lm:=(5 * ld-3) DIV 153;
|
|
ld:= (5 * ld +2 - 153*lm) DIV 5;
|
|
ly:= 100 * cardinal(ly) + j;
|
|
if lm < 10 then
|
|
inc(lm,3)
|
|
else
|
|
begin
|
|
dec(lm,9);
|
|
inc(ly);
|
|
end;
|
|
year:=ly;
|
|
month:=lm;
|
|
day:=ld;
|
|
end;
|
|
end;
|
|
|
|
var y,m,d:word;
|
|
|
|
begin
|
|
decodedate(3.826203881944445E+004,y,m,d);
|
|
end.
|