blob: d06f3f9e32a11f0714d641c0635be1efb020aec2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
{ %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.
|
