Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPDATE.ZIP/DATE.PAS

Pascal/Delphi Source File | 1992-06-25 | 30.5 KB | 627 lines

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║             D A T E              ║                   ▌}
{▐                   ║              V 1.5               ║                   ▌}
{▐                   ║         David Gegenheimer        ║                   ▌}
{▐                   ╠══════════════════════════════════╣                   ▌}
{▐                   ║  Last Change Made  :  06/25/1992 ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This unit is given freely, as is.  The author will not, and should not   ▌}
{▐ be held responsible for any damages incurred by its use/misuse.  The     ▌}
{▐ use of this unit should happen only after the user has examined its code ▌}
{▐ and found that it meets his/her satisfaction.  The author would really   ▌}
{▐ appreciate hearing about any bugs in this unit that are found.  However, ▌}
{▐ this unit cannot be modified and re-destributed by anyone except David   ▌}
{▐ Gegenheimer.  The reason being for this is mainly to protect myself. If  ▌}
{▐ someone modifies the code for the worse, and sends it out - I get the    ▌}
{▐ blame!.                                                                  ▌}
{▐ On the brighter side!   This code is free!  Please Send no Money!        ▌}
{▐                    Use it in any program you like!                       ▌}
{▐                                                                          ▌}
{▐ If you have found any bugs, please write me at the following address, &  ▌}
{▐ tell me the bug, and what BBS you downloaded it from  so that I can send ▌}
{▐ them an update! THANK YOU!                                               ▌}
{▐                                                                          ▌}
{▐                           David Gegenheimer                              ▌}
{▐                           600 Clayton Dr.                                ▌}
{▐                           Houma, La. 70364                               ▌}
{▐                                                                          ▌}
{▐ This unit allows for easy date manipulation via Julian Date conversion.  ▌}
{▐ The routines and their parameters are as follows:                        ▌}
{▐                                                                          ▌}
{▐  Function  JulianDate (Day,Month,Year)                                   ▌}
{▐          - Send it 3 Integers                                            ▌}
{▐          - Returns a variable of type JDate                              ▌}
{▐          - Ex. AJDate := JulianDate (1,1,1992); (AJDate = 2448622)       ▌}
{▐                                                                          ▌}
{▐  Procedure CalendarDate (AJDate,Day,Month,Year)                          ▌}
{▐          - Send it a Julian Date, and 3 Integers                         ▌}
{▐          - Returns the Day,Month, & Year contained in the Julian Date    ▌}
{▐          - Ex. CalendarDate (2448622,Day,Month,Year); (1/1/92)           ▌}
{▐                                                                          ▌}
{▐  Function  DayOfTheWeek (AJDate)                                         ▌}
{▐          - Send it a Julian Date                                         ▌}
{▐          - Returns an integer representing the Day of the Week           ▌}
{▐          - (1 = Sunday, 2 = Monday, ... 6 = Friday, 7 = Saturday)        ▌}
{▐          - Ex. TheDayOfTheWeek := DayOfTheWeek (A_Julian_Date);          ▌}
{▐                                                                          ▌}
{▐  Function  MonthAbrv (Month,Full)                                        ▌}
{▐          - Send it an Integer and a Boolean variable                     ▌}
{▐          - Returns a String containing the month's name                  ▌}
{▐          - If Full is TRUE then the full months name is returned         ▌}
{▐          - If Full is FALSE then a 3 character abbreviation is returned  ▌}
{▐          - Ex. Mnth_Name := MonthAbrv (1,True);  (Mnth_Name = 'January') ▌}
{▐          - Ex. Mnth_Name := MonthAbrv (1,False); (Mnth_Name = 'Jan');    ▌}
{▐                                                                          ▌}
{▐  Function  ValidDate (Day,Month,Year)                                    ▌}
{▐          - Send it 3 Integers                                            ▌}
{▐          - Returns TRUE if a valid date or FALSE if an Invalid date      ▌}
{▐          - Ex. GoodDate := ValidDate (2,31,1992); (GoodDate = False)     ▌}
{▐          - Ex. GoodDate := ValidDate (1,30,1992); (GoodDate = True)      ▌}
{▐                                                                          ▌}
{▐  Procedure DrawCalendar (X,Y,Day,Month,Year,TopColor,BotColor,HiColor);  ▌}
{▐          - Send it 6 Integers                                            ▌}
{▐          - X,Y is the Upperleft corner of the calendar to be printed     ▌}
{▐          - Day if not 0 will be Hilighted on the calendar;               ▌}
{▐          - Month and Year describe the contents of the calendar          ▌}
{▐          - TopColor is in the format: BackGround*16+ForeGround           ▌}
{▐          - BotColor is in the format: BackGround*16+ForeGround           ▌}
{▐          - HiColor  is in the format: BackGround*16+ForeGround           ▌}
{▐          - Ex. DrawCalendar (35,10,1,1,1992,Red*16+Yellow,Blue*16+White) ▌}
{▐          - Result is:       January , 1992      <-- Yellow on Red        ▌}
{▐                          Su  M  T  W  H  F Sa   <-- Yellow on Red        ▌}
{▐                                    1  2  3  4   <-- White on Blue        ▌}
{▐                           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      <-- White on Blue        ▌}
{▐            Note: This Chart appears at X = 35, Y= 10                     ▌}
{▐                                                                          ▌}
{▐  Procedure DateToStr                                                     ▌}
{▐            - Real Simple, send it the date, and tell it how you want it  ▌}
{▐                                                                          ▌}
{▐  Procedure StrToDate                                                     ▌}
{▐            - The reverse of DateToStr                                    ▌}
{▐                                                                          ▌}
{▐  Function  DateToday                                                     ▌}
{▐            - Returns a ten character string containing todays date.      ▌}
{▐                                                                          ▌}
{▐  Function  SDateCompare                                                  ▌}
{▐            - Send it two string dates.                                   ▌}
{▐            - It returns   -1 if Date1 is Before Date2                    ▌}
{▐                            0 if Date1 is Date2                           ▌}
{▐                            1 If Date1 is After  Date2                    ▌}
{▐                                                                          ▌}
{▐  Function  SDateDiff                                                     ▌}
{▐            - Send it two string dates.                                   ▌}
{▐            - It returns the difference in days between date1 and date2   ▌}
{▐            - Note: The calculation is performed:  Date1 - Date2.         ▌}
{▐                                                                          ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Unit Date;

Interface

Uses Crt,Dos;

Type  JDate = LongInt;

Const _MMDDYY = 1;  {█ Date String Format - Month,Day,Year █}
      _DDMMYY = 2;  {█ Date String Format - Day,Month,Year █}
      _YYMMDD = 3;  {█ Date String Format - Year,Month,Day █}
      _YYDDMM = 4;  {█ Date String Format - Year,Day,Month █}
      _DDYYMM = 5;  {█ Date String Format - Day,Year,Month █}
      _MMYYDD = 6;  {█ Date String Format - Month,Year,Day █}

Function  JulianDate   (    Day           : Integer;
                            Month         : Integer;
                            Year          : Integer)  : JDate;

Procedure CalendarDate (    AJDate        : JDate;
                        Var Day,
                            Month,
                            Year          : Integer);

Function  DayOfTheWeek (    AJDate        : JDate)    : Integer;

Function  MonthAbrv    (    Month         : Integer;
                            Full          : Boolean)  : String;

Function  ValidDate    (    Day           : Integer;
                            Month         : Integer;
                            Year          : Integer) : Boolean;

Procedure DrawCalendar (    X,Y           : Integer;
                            Day           : Integer;
                            Month         : Integer;
                            Year          : Integer;
                            TopColor      : Integer;
                            BotColor      : Integer;
                            HiColor       : Integer);

Procedure DateToStr    (    Day           : Integer;
                            Month         : Integer;
                            Year          : Integer;
                        Var DateStr       : String;
                            LeadingZeros  : Boolean;
                            TwoDigitYear  : Boolean;
                            Divider       : Char;
                            Format        : Integer);

Procedure StrToDate    (    DateStr       : String;
                        Var Day,
                            Month,
                            Year          : Integer;
                            Format        : Integer);

Procedure StrToJDate   (    DateStr       : String;
                        Var AJDate        : JDate;
                            Format        : Integer;
                            TwoDigitYear  : Boolean);
Function  DateToday                                  : String;
Function  SDateCompare (    Date1         : String;
                            Date2         : String;
                            Format1       : Integer;
                            Format2       : Integer;
                            TwoDigitYear1 : Boolean;
                            TwoDigitYear2 : Boolean) : Integer;
Function  SDateDiff    (    Date1         : String;
                            Date2         : String;
                            Format1       : Integer;
                            Format2       : Integer;
                            TwoDigitYear1 : Boolean;
                            TwoDigitYear2 : Boolean) : LongInt;

Implementation

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║        J u l i a n D a t e       ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This function calculates and returns a julian date given Day,Month,Year. ▌}
{▐ Note: If you send it an invalid date, such as 2/29/91 it will correct it ▌}
{▐       as 3/1/91.  If this is a problem, check for ValidDate before.      ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function JulianDate (Day,Month,Year : Integer) : JDate;
Var A,B       : Integer;
    Year_Corr : Real;
Begin
   B := 0;
   If Month <= 2 Then
      Begin
         Dec (Year);
         Inc (Month,12);
      End;
   If (Year * 10000.0 + Month * 100.0 + Day >= 15821015.0) Then
      Begin
         A := Year Div 100;
         B := 2 - A + A Div 4;
      End;
   If Year > 0 Then
      Year_Corr := 0.0
   Else
      Year_Corr := 0.75;
   JulianDate := JDate (Trunc((365.25 * Year - Year_Corr)) +
                        Trunc((30.6001 * (Month+1) + Day + 1720994 + B)));
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║     C a l e n d a r D a t e      ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This procedure is the opposite of JulianDate, it returns the Day,Month,  ▌}
{▐ Year, given a Julian Date.                                               ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Procedure CalendarDate (AJDate : JDate; Var Day,Month,Year : Integer);
Var A,B,C,D,E,Z,Alpha : LongInt;
Begin
   Z := AJDate + 1;
   If (Z < 2299161) Then
      A := Z
   Else
      Begin
         Alpha := Trunc ((Z-1867216.25) / 36524.25);
         A     := Z + 1 + Alpha - Alpha Div 4;
      End;
   B   := A + 1524;
   C   := Trunc ((B - 122.1) / 365.25);
   D   := Trunc (365.25 * C);
   E   := Trunc ((B - D) / 30.6001);
   Day := B - D - Trunc (30.6001 * E);
   If E < 13.5 Then
      Month := E - 1
   Else
      Month := E - 13;
   If Month > 2.5 Then
      Year := C - 4716
   Else
      Year := C - 4715;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║      D a y O f T h e W e e k     ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This function, given a julian date, will return an integer in the range  ▌}
{▐ (1-7) that represents a day of the week with sunday being 1 and saturday ▌}
{▐ is 7.                                                                    ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function DayOfTheWeek (AJDate : JDate) : Integer;
Begin
   DayOfTheWeek := Integer ((AJDate+2) Mod 7 + 1);
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║         V a l i d D a t e        ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This function, given a day, month, and Year (ex. 1,2,1992) will return   ▌}
{▐ TRUE if that date is Valid, or FALSE if that date is Invalid.            ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function ValidDate (Day,Month,Year : Integer) : Boolean;
Var TempDay,TempMonth,TempYear : Integer;
    TempJDate                  : JDate;
Begin
   TempJDate := JulianDate (Day,Month,Year);
   CalendarDate (TempJDate,TempDay,TempMonth,TempYear);
   If (Day = TempDay) And (Month = TempMonth) And (Year = TempYear) Then
      ValidDate := True
   Else
      ValidDAte := False;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║         M o n t h A b r v        ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This function, given an integer in the range (1-12) will return a string ▌}
{▐ containing that months name.  If the integer sent is not a valid month,  ▌}
{▐ then the string 'ERROR' is returned.  If full is true then the full name ▌}
{▐ of the month is returned. If it is TRUE, then a 3 character abbreviation ▌}
{▐ is returned.                                                             ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function MonthAbrv (Month : Integer; Full : Boolean) : String;
Var MonthStr : String [9];
Begin
   Case Month Of
       1 : MonthStr := 'January';
       2 : MonthStr := 'February';
       3 : MonthStr := 'March';
       4 : MonthStr := 'April';
       5 : MonthStr := 'May';
       6 : MonthStr := 'June';
       7 : MonthStr := 'July';
       8 : MonthStr := 'August';
       9 : MonthStr := 'September';
      10 : MonthStr := 'October';
      11 : MonthStr := 'November';
      12 : MonthStr := 'December';
   End;
   If Full Then
      MonthAbrv := MonthStr
   Else
      MonthAbrv := Copy (MonthStr,1,3);
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║     D r a w C a l e n d a r      ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This procedure will draw a calendar of the given month & year at X,Y.    ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Procedure DrawCalendar (X,Y,Day,Month,Year,TopColor,BotColor,HiColor : Integer);
Var AJDate : JDate;
    Loop   : Integer;
    Msg    : String;
    Dow    : Integer;
Begin
   TextAttr := TopColor;
   Str      (Year,Msg);
   Msg      := MonthAbrv (Month,True)+' , '+Msg;
   GotoXY (X,Y);
   Write  ('                      ');
   GotoXY (X+(11-(Length(Msg) Div 2)),Y);
   Write  (Msg);
   GotoXY (X,Y+1);
   Write  (' Su  M  T  W  H  F Sa ');
   Inc    (Y,2);
   TextAttr := BotColor;
   GotoXY (X,Y);
   Write  ('                      ');
   For Loop := 1 to 31 Do
       Begin
          AJDate := JulianDate (Loop,Month,Year);
          Dow    := DayOfTheWeek(AJDate);
          If Loop < 10 Then
             GotoXY (X+Dow*3-1,Y)
          Else
             GotoXY (X+Dow*3-2,Y);
          If ValidDate (Loop,Month,Year) Then
             Begin
                If Loop = Day Then
                   TextAttr := HiColor;
                Write (Loop);
                TextAttr := BotColor;
             End;
          If Dow Mod 7 = 0 Then
             Begin
                Inc (Y);
                GotoXY (X,Y);
                Write ('                      ');
             End;
       End;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║         D a t e T o S t r        ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This routine changes Day/Month/Year To A String.                         ▌}
{▐ Its parameters are as follows:                                           ▌}
{▐       Day,Month,Year ................... The Date to be converted        ▌}
{▐       DateStr .......................... The resulting date string       ▌}
{▐       LeadingZeros ..................... TRUE -- Dates are:  02/09/92    ▌}
{▐                                          FALSE - Dates are:  2/9/92      ▌}
{▐       TwoDigitYear ..................... TRUE -- Dates are  11/12/92     ▌}
{▐                                          FALSE - Dates are  11/12/1992   ▌}
{▐       Divider .......................... Any char ex. '/' -  5/6/92      ▌}
{▐                                                       '-' -  5-6-92      ▌}
{▐                                                       '■' -  5■6■92      ▌}
{▐       Format ........................... The Way the date is organized   ▌}
{▐                                          1) MM/DD/YY  4) YY/DD/MM        ▌}
{▐                                          2) DD/MM/YY  5) DD/YY/MM        ▌}
{▐                                          3) YY/MM/DD  6) MM/YY/DD        ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Procedure DateToStr (Day,Month,Year : Integer; Var DateStr  : String;
                     LeadingZeros   : Boolean; TwoDigitYear : Boolean;
                     Divider : Char;
                     Format  : Integer);
Var DStr : String [2];
    MStr : String [2];
    YStr : String [4];
Begin
   Str (Day  ,DStr);
   Str (Month,MStr);
   Str (Year ,YStr);
   If LeadingZeros Then
      Begin
         If Day < 10 Then
            DStr := '0'+DStr;
         If Month < 10 Then
            MStr := '0'+MStr;
      End;
   If TwoDigitYear Then
      If Length (Ystr ) >= 4 Then
         YStr := YStr [3] + YStr [4];
   Case Format Of
       _MMDDYY : DateStr := MStr + Divider + DStr + Divider + YStr;
       _DDMMYY : DateStr := DStr + Divider + MStr + Divider + YStr;
       _YYMMDD : DateStr := YStr + Divider + MStr + Divider + DStr;
       _YYDDMM : DateStr := YStr + Divider + DStr + Divider + MStr;
       _DDYYMM : DateStr := DStr + Divider + YStr + Divider + MStr;
       _MMYYDD : DateStr := MStr + Divider + YStr + Divider + DStr;
   End;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║         S t r T o D a t e        ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Procedure StrToDate (DateStr : String; Var Day,Month,Year : Integer; Format : Integer);
Var Position : Integer;

    Function GetInt : Integer;
    Var AnInt   : Integer;
        TempStr : String;
        Ret     : Integer;
    Begin
       TempStr := '';
       While (Position <= Length (DateStr)) And
             (DateStr [Position] In ['0','1','2','3','4','5','6','7','8','9']) Do
          Begin
             TempStr := TempStr + DateStr [Position];
             Inc (Position);
          End;
       Val (TempStr,AnInt,Ret);
       GetInt := AnInt;
       Inc (Position);
    End;

Begin
   Position := 1;
   Case Format Of
       _MMDDYY : Begin
                    Month := GetInt;
                    Day   := GetInt;
                    Year  := GetInt;
                 End;
       _DDMMYY : Begin
                    Day   := GetInt;
                    Month := GetInt;
                    Year  := GetInt;
                 End;
       _YYMMDD : Begin
                    Year  := GetInt;
                    Month := GetInt;
                    Day   := GetInt;
                 End;
       _YYDDMM : Begin
                    Year  := GetInt;
                    Day   := GetInt;
                    Month := GetInt;
                 End;
       _DDYYMM : Begin
                    Day   := GetInt;
                    Year  := GetInt;
                    Month := GetInt;
                 End;
       _MMYYDD : Begin
                    Month := GetInt;
                    Year  := GetInt;
                    Day   := GetInt;
                 End;
   End;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║        S t r T o J D a t e       ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Procedure StrToJDate (DateStr : String; Var AJDate : JDate; Format : Integer;
                      TwoDigitYear : Boolean);
Var Position        : Integer;
    Day,Month,Year  : Integer;
    Function GetInt : Integer;
    Var AnInt   : Integer;
        TempStr : String;
        Ret     : Integer;
    Begin
       TempStr := '';
       While (Position <= Length (DateStr)) And
             (DateStr [Position] In ['0','1','2','3','4','5','6','7','8','9']) Do
          Begin
             TempStr := TempStr + DateStr [Position];
             Inc (Position);
          End;
       Val (TempStr,AnInt,Ret);
       GetInt := AnInt;
       Inc (Position);
    End;

Begin
   Position := 1;
   Case Format Of
       _MMDDYY : Begin
                    Month := GetInt;
                    Day   := GetInt;
                    Year  := GetInt;
                 End;
       _DDMMYY : Begin
                    Day   := GetInt;
                    Month := GetInt;
                    Year  := GetInt;
                 End;
       _YYMMDD : Begin
                    Year  := GetInt;
                    Month := GetInt;
                    Day   := GetInt;
                 End;
       _YYDDMM : Begin
                    Year  := GetInt;
                    Day   := GetInt;
                    Month := GetInt;
                 End;
       _DDYYMM : Begin
                    Day   := GetInt;
                    Year  := GetInt;
                    Month := GetInt;
                 End;
       _MMYYDD : Begin
                    Month := GetInt;
                    Year  := GetInt;
                    Day   := GetInt;
                 End;
   End;
   If Year < 100 Then
      Year := Year + 1900;
   AJDate := JulianDate (Day,Month,Year);
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║        D a t e T o d a y         ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ Returns a string containing todays date.                                 ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function DateToday : String;
Var Year,Month,Day,DayOfWeek : Word;
    TempDate                 : String;
Begin
   GetDate (Year,Month,Day,DayOfWeek);
   DateToStr (Day,Month,Year,TempDate,True,False,'-',1);
   DateToday := TempDate;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║      S D a t e C o m p a r e     ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This function compares to date strings and returns:                      ▌}
{▐                     -1)  If date1 is before date2                        ▌}
{▐                      0)  If date1 is equal to date 2                     ▌}
{▐                      1)  If date1 is after date                          ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function SDateCompare (Date1,Date2 : String; Format1,Format2 : Integer;
                       TwoDigitYear1,TwoDigitYear2 : Boolean) : Integer;
Var JDate1 : JDate;
    JDate2 : JDate;
Begin
   StrToJDate (Date1,JDate1,Format1,TwoDigitYear1);
   StrToJDate (Date2,JDate2,Format2,TwoDigitYear2);
   If JDate1 < JDate2 Then
      SDateCompare := -1
   Else
      If JDate1 = JDate2 Then
         SDateCompare := 0
      Else
         SDateCompare := 1;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
{▐                   ╔══════════════════════════════════╗                   ▌}
{▐                   ║         S D a t e D i f f        ║                   ▌}
{▐                   ╚══════════════════════════════════╝                   ▌}
{▐══════════════════════════════════════════════════════════════════════════▌}
{▐ This function returns the number of days between two dates.              ▌}
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
Function  SDateDiff (Date1,Date2 : String; Format1,Format2 : Integer;
                     TwoDigitYear1,TwoDigitYear2 : Boolean) : LongInt;
Var JDate1 : JDate;
    JDate2 : JDate;
Begin
   StrToJDate (Date1,JDate1,Format1,TwoDigitYear1);
   StrToJDate (Date2,JDate2,Format2,TwoDigitYear2);
   SDateDiff := JDate1 - JDate2;
End;
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

Begin
End.
{▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█▀▀▀▀▀▀▀▀▀▀▀▀▌ }
{▐              █   M o d i f i c a t i o n    H i s t o r y   █            ▌ }
{▐              █▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█            ▌ }
{▐ ┌────────┐┌─────────────────────────────────────────────────────────────┐▌ }
{▐ │  Date  ││                 Description of Modification                 │▌ }
{▐ ├────────┤├─────────────────────────────────────────────────────────────┤▌ }
{▐ │02/07/92││ Started writing this code.                                  │▌ }
{▐ │02/10/92││ Finished debugging, and wrapped up commenting               │▌ }
{▐ │02/21/92││ Added:   Procedure DateToStr                                │▌ }
{▐ │        ││          Procedure StrToDate                                │▌ }
{▐ │06/16/92││ Added:   Function  DateToday                                │▌ }
{▐ │06/25/92││ Added:   Function  SDateCompare                             │▌ }
{▐ │        ││          Function  SDateDiff                                │▌ }
{▐ └────────┘└─────────────────────────────────────────────────────────────┘▌ }
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌ }