unit MyDates;

interface

uses  SysUtils, Dialogs;

Type
 TMyDate = class
   public
       Day,
       Month,
       Year,
       SeqNum : longint;

       procedure SetSeq( SN : longint );
       procedure SetDay( D, M, Y : longint );
       function  DayOfYear : integer;
 end;

function  DateToString (Dt: TMyDate) : string;
function  DateToMDY    (Dt: TMyDate) : string;
function  SeqToString  (Seq : longint) : string;
function  SeqToMDY     (Seq : longint) : string;
function  MdyToDate    (S : string)  : TMyDate;
function  MdyToSeq     (S : string)  : longint;

function  DaysInMonth  (Year, Month : longint) : longint;
function  DaysInYear   (Year : longint)        : longint;

function  MyDateToDelphiDate (SeqNum:longint) : TDateTime;
function  DelphiDateToMyDate (DelphiDate:TDateTime) : longint;

function MonthCode3(Mon:integer): string;

procedure DateSequence ( D, M, Y : longint; var SN : longint);
procedure SequenceDate ( var D, M, Y : longint; SN : longint );

IMPLEMENTATION

{$RANGECHECKS OFF}

//----------------------------------------------------------------------------
procedure TMyDate.SetSeq ( SN : longint );
begin
     SeqNum := SN;
     SequenceDate( Day, Month, Year, SeqNum );
end;

//----------------------------------------------------------------------------
procedure TMyDate.SetDay ( D, M, Y : longint );
begin
     Day := D;
     Month := M;
     Year := Y;
     DateSequence( Day, Month, Year, SeqNum );
end;

//----------------------------------------------------------------------------
function TMyDate.DayOfYear : integer;
var
   Tmp : longint;
begin
     DateSequence( 1, 1, Year, Tmp );
     DayOfYear := SeqNum - Tmp + 1;
end;

//----------------------------------------------------------------------------
//  The function DateToString converts a Date variable into a string in the
//  format "MMM DD, YYYY" , e.g. "Jan 13, 1993"
//----------------------------------------------------------------------------
function DateToString (Dt: TMyDate) : string;
var
  P1, P2, P3, P4 : integer;
  Y              : longint;
  Day, Mon, Year : string;
begin
  Mon := MonthCode3(integer(Dt.Month));

  P1 := Dt.Day div 10;
  P2 := Dt.Day - (P1*10);
  Day := chr(P1 + 48) + chr(P2 + 48);

  Y := Dt.Year;
  P1 :=  Y div 1000;
  P2 := (Y - (P1*1000)) div 100;
  P3 := (Y - (P1*1000) - (P2*100)) div 10;
  P4 :=  Y - (P1*1000) - (P2*100) - (P3*10);
  Year := chr(P1 + 48) + chr(P2 + 48) +
          chr(P3 + 48) + chr(P4 + 48);

  DateToString := Mon + ' ' + Day + ', ' + Year;
end;

//----------------------------------------------------------------------------
function MdyToDate(S : string) : TMyDate;
var
   I, M, D, Y : longint;
   SM, SD, SY, SS : string;
   Dt : TMyDate;
begin
   Dt := TMyDate.Create;
   Dt.SetSeq(0);
   Result := Dt;              // default return value

   I := Pos('/', S);
   SM := Copy(S, 1, I-1);     // extract the month portion
   SS := Copy(S, I+1, 99);    // leave just the rest (dd/yyyy)

   I := Pos('/', SS);
   SD := Copy(SS, 1, I-1);     // extract the day portion
   SY := Copy(SS, I+1, 99);    // the rest is the year

   try
     val(SM, M, I);
     if (I <> 0) then begin
        Result.SetSeq(Dt.SeqNum);
        Dt.Free;
        exit;
     end;
     val(SD, D, I);
     if (I <> 0) then begin
        Result.SetSeq(Dt.SeqNum);
        Dt.Free;
        exit;
     end;
     val(SY, Y, I);
     if (I <> 0) then begin
        Result.SetSeq(Dt.SeqNum);
        Dt.Free;
        exit;
     end;
     Result.SetDay(D, M, Y);
     Dt.Free;
   except
     Dt.Free;
     exit;          // return value is 0 so calling procedure assumes error
   end;
end;

//----------------------------------------------------------------------------
function MdyToSeq(S : string) : longint;
var
   I, M, D, Y : longint;
   SM, SD, SY, SS : string;
begin
   Result := -999;            // default return value

   I := Pos('/', S);
   SM := Copy(S, 1, I-1);     // extract the month portion
   SS := Copy(S, I+1, 99);    // leave just the rest (dd/yyyy)

   I := Pos('/', SS);
   SD := Copy(SS, 1, I-1);     // extract the day portion
   SY := Copy(SS, I+1, 99);    // the rest is the year

   try
     val(SM, M, I);  if (I <> 0) then exit;
     val(SD, D, I);
        if (I <> 0) then exit;
     val(SY, Y, I);
        if (I <> 0) then exit;
     DateSequence(D, M, Y, I);
     Result := I;
   except
     Raise;
     Result := -999;
     exit;          // return value is 0 so calling procedure can assume error
   end;
end;

//----------------------------------------------------------------------------
//  The function DateToMDY converts a Date variable into a string in the
//  format "MM/DD/YYYY" , e.g. "01/13/1993"
//----------------------------------------------------------------------------
function DateToMDY (Dt: TMyDate) : string;
var
  P1, P2, P3, P4 : integer;
  Y              : longint;
  Day, Mon, Year : string;
begin
  P1 := Dt.Month div 10;
  P2 := Dt.Month - (P1*10);
  Mon := chr(P1 + 48) + chr(P2 + 48);

  P1 := Dt.Day div 10;
  P2 := Dt.Day - (P1*10);
  Day := chr(P1 + 48) + chr(P2 + 48);

  Y := Dt.Year;
  P1 :=  Y div 1000;
  P2 := (Y - (P1*1000)) div 100;
  P3 := (Y - (P1*1000) - (P2*100)) div 10;
  P4 :=  Y - (P1*1000) - (P2*100) - (P3*10);
  Year := chr(P1 + 48) + chr(P2 + 48) +
          chr(P3 + 48) + chr(P4 + 48);

  DateToMDY := Mon + '/' + Day + '/' + Year;
end;


//----------------------------------------------------------------------------
//  The function SeqToMDY converts a sequence number into a string in the
//  format "MM/DD/YYYY" , e.g. "01/13/1993"
//----------------------------------------------------------------------------
function  SeqToMDY(Seq : longint) : string;
var
   D1 : TMyDate;
begin
   D1 := TMyDate.Create;
   D1.SetSeq(Seq);
   Result := DateToMDY(D1);
   D1.Free;
end;

//----------------------------------------------------------------------------
//  The function SeqToString converts a sequence number into a string in the
//  format "MMM DD, YYYY" , e.g. "Jan 13, 1993"
//----------------------------------------------------------------------------
function  SeqToString(Seq : longint) : string;
var
   D1 : TMyDate;
begin
   D1 := TMyDate.Create;
   D1.SetSeq(Seq);
   Result := DateToString(D1);
   D1.Free;
end;

//----------------------------------------------------------------------------
//  The function DaysInMonth returns the number of days in the specified month.
//----------------------------------------------------------------------------
function DaysInMonth (Year, Month : longint) : longint;
var
   M2, Y2 : longint;
   D1, D2 : TMyDate;
begin
   D1 := TMyDate.Create;
   D2 := TMyDate.Create;
   M2 := Month+1;
   Y2 := Year;
   if (M2 > 12) then begin
      M2 := M2 - 12;
      Y2 := Y2 + 1;
   end;
   D1.SetDay(1, Month, Year);
   D2.SetDay(1,    M2,   Y2);
   Result := D2.SeqNum - D1.SeqNum;
   D1.Free;
   D2.Free;
end;

//----------------------------------------------------------------------------
//   The function DaysInYear returns the number of days in the specified year.
//----------------------------------------------------------------------------
function DaysInYear (Year : longint) : longint;
var
   D1, D2 : TMyDate;
begin
   D1 := TMyDate.Create;
   D2 := TMyDate.Create;
   D1.SetDay(1, 1, Year);
   D2.SetDay(1, 1, Year+1);
   Result := D2.SeqNum - D1.SeqNum;
   D1.Free;
   D2.Free;
end;

//----------------------------------------------------------------------------
function MyDateToDelphiDate(SeqNum:longint) : TDateTime;
var
   D, M, Y    : longint;
   Yr, Mn, Dy : Word;
begin
   SequenceDate(D, M, Y, SeqNum);
   Yr := Y;
   Mn := M;
   Dy := D;
   Result := EncodeDate(Yr, Mn, Dy);
end;

//----------------------------------------------------------------------------
function DelphiDateToMyDate(DelphiDate:TDateTime) : longint;
var
   D, M, Y, Seq  : longint;
   Yr, Mn, Dy    : Word;
begin
   DecodeDate(DelphiDate, Yr, Mn, Dy);
   Y := Yr;
   M := Mn;
   D := Dy;
   DateSequence(D, M, Y, Seq);
   Result := Seq;
end;

//----------------------------------------------------------------------------
//  This routine computes the number of the date, with days numbered
//  sequentially from 1 (corresponding to the base date).  The base
//  date must be 1 March on any LEAP YEAR or century boundary.  Dates
//  must be between the base date and the base date plus 2,147,483,646.
//  This routine is set up to use only 4-byte integer variables and
//  to avoid intermediate use of reals in the evaluation of expressions.
//  It is a modification of the previous version which used 2-byte integer
//  variables.  For reference on the 2-byte version of this subroutine
//  see Dr. Dobb's Journal 80:66-70.
//----------------------------------------------------------------------------
procedure DateSequence ( D, M, Y : longint;
                          var SN : longint);
var
   BaseYear,
   I,
   NumYrs,
   TotC,
   LeapC,
   SkipC,
   NonLeapC : longint;
begin
   BaseYear := 0;
   if Y <= BaseYear then begin
      MessageDlg('Error in DateSequence : Year <= BaseYear', mtError, [mbOk], 0);
      halt
   end
   else begin
      NumYrs := Y - BaseYear - 1 + (M + 9) div 12;
      TotC   := (BaseYear + NumYrs) div 100 - (BaseYear div 100);
      SkipC  := 3 - (BaseYear div 100) mod 4;
      LeapC  := (TotC + 3 - SkipC) div 4;
      NonLeapC := TotC - LeapC;
      I  := (M + 9) mod 12;
      SN := 365*NumYrs + (NumYrs div 4)-NonLeapC + (153*I + 2) div 5 + D;
   end;
end;

//----------------------------------------------------------------------------
//  This routine computes the date of the number, with days numbered
//  sequentially from 1 (corresponding to the base date).  The base date must
//  be 1 March of any year divisible by 4 (i.e. leap years and century years).
//  The base year must be greater than or equal to 0.  Dates must be between
//  the base date and the base date plus 2,147,483,636. This routine is set
//  up to use 4-byte integer variables and to avoid intermediate use of reals
//  in the evaluation of expressions. For more complete documentation on the
//  routine, refer to the DateSequence method.
//----------------------------------------------------------------------------
procedure SequenceDate ( var D, M, Y : longint; SN : longint );
var
   CentDays,
   BaseYear : longint;
begin
   BaseYear := 0;
   CentDays := 36524;               { 100 AD is not a leap year }
   while (SN > CentDays) do begin
      BaseYear := BaseYear + 100;
      SN := SN - CentDays;
      if (((BaseYear+100) div 400) * 400) = (BaseYear+100) then
         CentDays := 36525
      else CentDays := 36524;
   end;
   Y := (SN - 1 - SN div 1461) div 365;
   D := SN - (365 * Y) - (Y div 4);
   M := ((5*D - 3) div 153 + 2) mod 12 + 1;
   Y := Y + BaseYear + 1 - (M + 9) div 12;
   D := D - (153*((M + 9) mod 12) + 2) div 5;
end;

//----------------------------------------------------------------------------
function MonthCode3(Mon:integer): string;
begin
   if (Mon =  1) then Result := 'Jan';
   if (Mon =  2) then Result := 'Feb';
   if (Mon =  3) then Result := 'Mar';
   if (Mon =  4) then Result := 'Apr';
   if (Mon =  5) then Result := 'May';
   if (Mon =  6) then Result := 'Jun';
   if (Mon =  7) then Result := 'Jul';
   if (Mon =  8) then Result := 'Aug';
   if (Mon =  9) then Result := 'Sep';
   if (Mon = 10) then Result := 'Oct';
   if (Mon = 11) then Result := 'Nov';
   if (Mon = 12) then Result := 'Dec';
end;

END.
