program DelpDate { for Delphi 2 or later } ;
uses SysUtils ;

function CorruptDateTime(const DT : TDateTime) : TDateTime ;
begin 
  if (DT>=0.0) or (Frac(DT)=0.0)
    then Result := DT
    else Result := Int(DT) - Frac(DT) - 2.0 ;
  end {CorruptDateTime} ;

function RectifyDateTime(const DT : TDateTime) : TDateTime ;
begin 
  if (DT>=0.0) or (Frac(DT)=0.0)
    then Result := DT
    else Result := Int(DT) - Frac(DT) ;
  end {RectifyDateTime} ;

function LZ(X : word) : shortstring ;
var S : string[2] ;
begin Str(X:2, S) ; if S[1]=#32 then S[1] := '0' ;
  Result := S end ;

function LZZZ(X : word) : shortstring ;
var S : string[4] ;
begin Str(X, S) ; while Length(S)<4 do S := '0'+S ;
  Result := S end ;

procedure Show(const X : TDateTime) ;
var Yr, Mo, Dy, Hr, Mi, Sc, Ms : word ; DoW : integer ;
begin
  DecodeDate(X, Yr, Mo, Dy) ;
  DecodeTime(X, Hr, Mi, Sc, Ms) ;
  DoW := DayOfWeek(X) ;
  Write(DoW:6, LZZZ(Yr):6, '-', LZ(Mo), '-', LZ(Dy),
    LZ(Hr):3, ':', LZ(Mi), ':', LZ(Sc)) ;
  end {Show} ;

procedure Expound(const X : TDateTime) ;
begin
  Write(X:9:3, Succ(Trunc(X+123456789+5) mod 7):3) ;
  Show(X) ;
  Show(CorruptDateTime(X)) ;
  Write(RectifyDateTime(CorruptDateTime(X)):10:3) ;
  if Abs(RectifyDateTime(CorruptDateTime(X))-X)>1.0E-6 then Write(' *') ;
  if X=0.0 then Write(' -') ;
  Writeln end {Expound} ;


function ParadoxTimeToTDateTime(const D : double) : TDateTime ;
begin // via Jeffrey A. Wormsley
  Result := D/MSecsPerDay - 693594.0 ;
  if (Result <= 0.0) and (Frac(Result) <> 0.0) then
    Result := Int(Result) - Frac(Result) - 2 ;
  end {PTTTDT} ;

procedure ParaShow ;
var D : double ; T : TDateTime ;
begin
Writeln('Paradox msec':16, 'TDateTime':15, 'Decoded to Gregorian':27) ;
  D := 86400000*693591.0 ;
  while D<86400000*693597.5 do begin
    T := ParadoxTimeToTDateTime(D) ;
    Write(D:16:0, T:15:6) ; Show(T) ;
    T := (RectifyDateTime(T)+693594.0)*86400000 ;
    if Abs(T-D)>0.001 then Write(' *') ;
    Writeln ;
    D := D + 86400000/3 end ;
  end {ParaShow} ;

const Q = 693593 ;
P : array [0..9] of double =
  (0, 0.001, 1, 365, 730, 1095, 1461, 36524, 146097, 5*146097) ;
var J : integer ; 

begin
Writeln('DelpDate : www.merlyn.demon.co.uk >= 2002-04-04'^M^J,
{$IFDEF VER100} '  Delphi 3 :', {$ENDIF}
  ' Shows behaviour with negative input') ;
Writeln('Decoded':33, 'Corrupt':27, 'Rectify':16) ;
Writeln(' DateTime DoW',
  ' : DoW Year Mo Dy Hr Mi Sc ',
  ' : DoW Year Mo Dy Hr Mi Sc') ;

for J := -12 to 12 do Expound(0.25*J) ;
Writeln ;
for J := 60 to 61 do Expound(J) ;
Writeln ;
for J := 59 to 61 do Expound(J+36525) ;
Writeln ;
for J := 60 to 61 do Expound(J+36525+36524) ;
Write('<cr>') ; Readln ; Writeln ;
ParaShow ;
Writeln ;
for J := Low(P) to High(P) do begin
  Write('    Paradox Day ', P[J]:12:3, ' =>') ;
  Show(ParadoxTimeToTDateTime(P[J]*86400000.0)) ; Writeln end ;
Writeln ;
Write('First valid Delphi DecodeDate: ':42, -Q) ; Show(-Q) ; Writeln ;
for J := 10 downto -15 do begin
  write(J-Q:9) ; Show(J-Q) ; if Odd(J) then Writeln else write('':4) end ;
Write('<cr>') ; Readln ;
end.