(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*                         REFDATE                              *)
(*                                                              *)
(*  Purpose: Converts Reflex date format to string type         *)
(*                                                              *)
(****************************************************************)
unit RefDate;
interface
uses MiscTool;
{    If a compiler error occurs here, you need to unpack the source
     to the MiscTool unit from the archived file Tools.arc.  See the
     README file on disk 1 for detailed instructions. }

type
  RDate = word;
  Date = String[8];

procedure DateToStr(ReflexDate : RDate; var DS : Date);

function GetReflexDate(ReflexDate : RDate;
                       var Month, Day, Year : word) : boolean;

function SetReflexDate(Month, Day, Year : word;
                       var ReflexDate : RDate) : boolean;

function StrToDate(DS : Date; var ReflexDate : RDate) : boolean;

const
  MaxDate = $FFFE;
  DateNull = 0;
  DateErr = $FFFF;
  DateNA = $FFFE;

implementation

const
  IntNull = 0;
  YHigh = 2079;
  YBase = 1900;
  LY = 1;
  NY = 0;

  Mondays : array[NY..LY, 0..12] of Rdate =
    ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365),
     (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366)
    );

  DaysInMonth : array[NY..LY, 0..12] of Rdate =
    ((0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
     (0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    );

function GetJDec31(Year : word) : RDate;
begin
  GetJDec31 := RDate(Year * 365 + (Year - 1) div 4);
end;


function LeapYear(Year : word) : word;
begin
  if ((Year mod 4) = 0) and
     not (Year mod 100 = 0) then
    LeapYear := LY
  else
    LeapYear := NY;
end;

function IYear(ReflexDate : RDate) : word;
var
  i : word;
begin
  i := ReflexDate mod 1461;
  if (i < 366) then
    i := 0
  else if (i < 731) then
    i := 1
  else if (i < 1096) then
    i := 2
  else
    i := 3;
  IYear := word(4 * (ReflexDate div 1461) + i + YBase);
end; { IYear }


function FindYear(var ReflexDate : RDate) : word;
var
  i : word;
begin
  i := IYear(ReflexDate);
  { Set ReflexDate to remainder by subtracting Julian of the
    previous Dec. 31 }
  Dec(ReflexDate, GetJDec31(i - YBase));
  FindYear := i;
end; { FindYear }

{ $define DateDebug}

function FindMonth(var ReflexDate : RDate;
                   Year : word;
                   var Month : word) : boolean;
var
  i, j : word;
  found : boolean;
begin
  j := LeapYear(Year - YBase);
  i := 1;
  found := false;
  {$ifdef DateDebug}
  Writeln('Reflex date = ', ReflexDate);
  Writeln('i = ', i);
  Writeln('j = ', j);
  Readln;
  {$endif}
  while not found and (i <= 13) and (ReflexDate >= DaysInMonth[j,pred(i)]) do
  begin
    ReflexDate := ReflexDate - DaysInMonth[j, pred(i)];
    if (ReflexDate > DaysInMonth[j,i]) then
      Inc(i)
    else
      found := true;
    {$ifdef DateDebug}
      Writeln('i = ', i);
      Write('j = ', j);
      Readln;
    {$endif}
  end;
  Month := i;
  {$ifdef DateDebug}
    Writeln('found = ', found);
  {$endif}
  FindMonth := found;
end; { FindMonth }

function GetReflexDate(ReflexDate : RDate;
                       var Month, Day, Year : word) : boolean;
var
  ValidDate : boolean;
  D : RDate;
begin
  D := ReflexDate;
  if (D = DateNull) or (D = DateErr) or (D = DateNA) then
  begin
    Year := IntNull; Month := IntNull; Day := IntNull;
    GetReflexDate := false;
  end
  else
  begin
    Year := FindYear(D);
    if not FindMonth(D, Year, Month) then
    begin
      Year := IntNull; Month := IntNull; Day := IntNull;
      GetReflexDate := false;
    end
    else
    begin
      Day := word(D);
      GetReflexDate := true;
    end;
  end;
end; { GetReflexDate }

procedure DateToStr(ReflexDate : RDate; var DS : Date);
var
  Month,
  Day,
  Year : word;
  DateOk : boolean;

function DateS(i : word) : Date;
var
  S : Date;
begin
  S := Numstr(i);
  if Length(S) = 1 then
    Insert('0', S, 1);
  DateS := S;
end;

begin { DateToStr }
  DateOk := GetReflexDate(ReflexDate, Month, Day, Year);
  if DateOk then
  begin
    DS := DateS(Month) + '/' + DateS(Day) + '/';
    if Year > YBase then
      Dec(Year, YBase);
    DS :=  DS + DateS(Year);
  end
  else
    DS := '';
end; { DateToStr }

function SetReflexDate(Month, Day, Year : word;
                       var ReflexDate : RDate) : boolean;
var
  j : word;
  jdate : Rdate;

begin
  SetReflexDate := false;
  if Year < YBase then
    Inc(Year, YBase);
  if (Month < 1) or (Month > 12) then
    Exit;
  if (day < 1) or (day > 31) then
    Exit;
  Dec(Year, YBase);
  ReflexDate := GetJDec31(Year) + Mondays[LeapYear(Year), pred(Month)] +
                RDate(Day);
  SetReflexDate := true;
end; { SetReflexDate }


function NextNum(var DS : Date) : word;
type
  CharSet = set of char;
const
  DateDelim : CharSet = ['/', '-'];
var
  i : word;
  found : boolean;
  Num : word;
  Code : integer;
  S : Date;
begin
  NextNum := 0;
  if DS = '' then
    Exit;
  i := 1;
  found := false;
  while (i <= Length(DS)) and not found do
  begin
    found := DS[i] in DateDelim;
    if not found then
      Inc(i);
  end;
  if found then
  begin
    S := Copy(DS, 1, pred(i));
    Delete(DS, 1, i);
  end
  else
  begin
    S := DS;
    DS := '';
  end;
  if S[1] = '0' then
    Delete(S, 1, 1);
  Val(S, Num, Code);
  if Code = 0 then
    NextNum := Num;
end; { NextNum }

function StrToDate(DS : Date;
                   var ReflexDate : RDate) : boolean;
var
  Month,
  Day,
  Year : word;

begin
  Month := NextNum(DS);
  Day := NextNum(DS);
  Year := NextNum(DS);
  StrToDate := SetReflexDate(Month, Day, Year, ReflexDate);
end; { StrToDate }

end.
