Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PTOOLBBS.ZIP/PTOOLBBS.BOX

Text File | 1986-01-08 | 35.7 KB | 929 lines

{ PTOOL1.BOX     Copyright 1985  R D Ostrander                   Version 1.0
                                 Ostrander Data Services
                                 5437 Honey Manor Dr
                                 Indianapolis  IN  46241


  PTOOLDAT portion of PTOOL1.BOX begins here ******************************

  Constants and Parameters Begin Here ************************************* }


TYPE

     PTOOLDAT_Str_21   = String [21];                    {Gregorian Dates    }
     PTOOLDAT_Str_3    = String [3];                     {Order of elements  }
     PTOOLDAT_Str_9    = String [9];                     {Day of Week        }
     PTOOLDAT_Elements = Array [1..3]  of String [21];   {Parsing elements   }
     PTOOLDAT_Numbers  = Array [1..3]  of Integer;       {Parsing numbers    }
     PTOOLDAT_Months   = Array [1..12] of String [9];    {Months Names       }
     PTOOLDAT_Days     = Array [1..7]  of PTOOLDAT_Str_9;{Days of the Week   }


CONST

   { Gregorian Date      A string expression of up to 21 characters.
     --------------      example:  02/15/50  or  February 2, 1950

                         The order and style to display the elements
                         (Month, Day, Year) are determined by the
                         parameters below.

                         As an argument, the date is passed as a string
                         expression with 3 elements in the same order as
                         displayed separated by at least one of the
                         characters  / - , . ' ; : ( ) · or a space.      }

                                           {    Gregorian Date parameters    }
                                           {*********************************}
 PTOOLDAT_G_YrDisp  : Byte        = 2;     { # of Display Chars for Year     }
                                           {     2    = 50                   }
                                           {     4    = 1950                 }
 PTOOLDAT_G_MoDisp  : Byte        = 2;     { # of Display Chars for Month    }
                                           {     2    = 02                   }
                                           {     3    = Feb                  }
                                           {     9    = February             }
 PTOOLDAT_G_DaDisp  : Byte        = 2;     { # of Display Chars for Day      }
                                           {     2    = 15                   }
 PTOOLDAT_G_Order   : String [3]  = 'MDY'; { Order of Display                }
                                           {     MDY  = 02 15 50             }
 PTOOLDAT_G_Sep1    : String [3]  = '/';   { 1st Separation Character        }
                                           {     /    = 02/15 50             }
 PTOOLDAT_G_Sep2    : String [3]  = '/';   { 2nd Separation Character        }
                                           {     /    = 02/15/50             }
 PTOOLDAT_G_ZeroSup : Boolean     = FALSE; { Zero Suppress Display?          }
                                           {     True =  2/15/50             }
                                           {*********************************}

   { The 2nd Gregorian Date is used solely as input for
     the conversion function PTDGtoG                    }

                                           {  2nd Gregorian Date parameters  }
                                           {*********************************}
 PTOOLDAT_G2_Order  : String [3]  = 'MDY'; { Order of Input                  }
                                           {*********************************}

   { Julian Date      A Real number in either of three formats:
     -----------      A = ANSI Date (YYDDD)  YY is the year within century
                                            DDD is the day of the year
                      B = ANSI Date (YYYYDDD) YYYY is the year
                                              DDD  is the day of the year
                      E = Elapsed days since January 1 of the base year below.
                               Note that this may result in a negative number
                               if the date is previous to the base year
                          CAUTION - If the base year below is changed, this
                               value becomes meaningless.



                                           {      Julian Date parameter      }
                                           {*********************************}
 PTOOLDAT_J_Type    : Char        = 'E';   { Julian Date Type                }
                                           {     A    = ANSI Date (YYDDD)    }
                                           {                      (50046)    }
                                           {     B    = ANSI DATE (YYYYDDD)  }
                                           {                      (1950046)  }
                                           {     E    = Days since January   }
                                           {                1st of base year }
                                           {                      (7350)     }
                                           {*********************************}

   { Short Date      An integer value representing the number of days since
     ----------      January 1 of the base year below minus 32765. USE WITH
                     CAUTION, dates earlier than the base year or later than
                     179 years after the base year cannot be calculated (date
                     returned is -32766). This date is useful for saving disk
                     or table storage only - it must be changed back to
                     another form to be used.

     Day of Week      A String expression of up to 9 characters
     -----------      The format depends on the parameter below:

                1 = 1      2      3       4         5        6      7
                3 = Sun    Mon    Tue     Wed       Thr      FrI    Sat
                9 = Sunday Monday Tuesday Wednesday Thursday Friday Saturday }

                                           {      Day of Week parameter      }
                                           {*********************************}
 PTOOLDAT_Day_Type  : Byte        = 3;     { Day of week Type                }
                                           {     1    = 4                    }
                                           {     2    = We                   }
                                           {     3    = Wed                  }
                                           {     9    = Wednesday            }
                                           {*********************************}

    {Base Year        This is used for dates in Julian Type B format, for
     ---------           conversion of dates entered without a century, and
                         for Short format dates.
                      If Base Year is 1930 then the year 50 will be calculated
                         as 1950, the year 29 will be calculated as 2029.    }

 PTOOLDAT_BaseYear  : Integer     = 1901;

{*****   PTOOLDAT Internal usage fields follow:  *****}

 PTOOLDAT_Element   : PTOOLDAT_Elements = (' ', ' ', ' ');
 PTOOLDAT_Number    : PTOOLDAT_Numbers  = (0, 0, 0);
 PTOOLDAT_ElY       : String [9] = '         ';
 PTOOLDAT_ElM       : String [9] = '         ';
 PTOOLDAT_ElD       : String [9] = '         ';
 PTOOLDAT_NumY      : Integer = 0;
 PTOOLDAT_NumM      : Integer = 0;
 PTOOLDAT_NumD      : Integer = 0;

 PTOOLDAT_Mon   : PTOOLDAT_Months    = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
                                        'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
                                        'Nov', 'Dec');
 PTOOLDAT_Month : PTOOLDAT_Months    = ('January', 'February', 'March',
                                        'April', 'May', 'June', 'July',
                                        'August', 'September', 'October',
                                        'November', 'December');
 PTOOLDAT_Day   : PTOOLDAT_Days      = ('Sun', 'Mon', 'Tue', 'Wed', 'Thr',
                                        'Fri', 'Sat');
 PTOOLDAT_DayOW : PTOOLDAT_Days      = ('Sunday', 'Monday', 'Tuesday',
                                        'Wednesday', 'Thursday', 'Friday',
                                        'Saturday');


{ Internal FUNCTIONs Begin Here ******************************************* }


PROCEDURE PTOOLDAT_Parse (VAR Test               : PTOOLDAT_Str_21;
                          VAR Number_of_Elements : Integer);

Var
   I, J, E : Byte;                             { Get elements of input }
                                               { Any of the characters }
Begin                                          { below may seperate    }
     I := 1;                                   { the elements.         }
     For E := 1 to 3 do
         Begin
              While (Test [I] in
                          ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' '])
                and (I <= Length (Test)) do
                    I := I + 1;
              J := 1;
              While (not (Test [I] in
                          ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' ']))
                and (I <= Length (Test))
                and ((I <= E*2) or (length(Test) > 6)) do
                    Begin
                         PTOOLDAT_Element [E] [J] := Test [I];
                         J := J + 1;
                         I := I + 1;
                         Number_of_Elements := E;
                         PTOOLDAT_Element [E] [0] := Char (J - 1);
                    End;
         End;
     While (Test [I] in ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' '])
       and (I <= Length (Test)) do
           I := I + 1;
     If (not (Test [I] in ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' ']))
       and (I <= Length (Test)) then
           Number_of_Elements := 4;
End;


FUNCTION PTOOLDAT_Set_Century (InYear : Integer) : Integer;

Var                                   { Add correct century based on Base }
   Century : Integer;                 { Year - if less than then next     }
                                      { century else same.                }
Begin
     Century := Trunc (Int ( PTOOLDAT_BaseYear / 100)) * 100;
     If InYear >= PTOOLDAT_BaseYear - Century
     then PTOOLDAT_Set_Century := Century + InYear
     else PTOOLDAT_Set_Century := Century + InYear + 100;
End;


FUNCTION PTOOLDAT_GetNum (Test : PTOOLDAT_Str_21; MDY : Char) : Integer;

Var
   Number    : Integer;                         { Get the number of the }
   Code      : Integer;                         { Month, Day, or Year   }
   I, J      : Byte;
   Year      : Integer;
   Century   : Integer;
   Ch        : Char;
   TestMon   : String [3];
   TestMonth : String [9];

Begin
     PTOOLDAT_GetNum := 0;
     Number := 0;
     Val (Test, Number, Code);
     Case MDY of
      'M' : If (Code = 0)
           and (Number in [1..12]) then
               PTOOLDAT_GetNum := Number
            else
               Begin
                    For I := 1 to 21 do
                        Begin
                             Ch := Test [I];
                             Test [I] := UpCase (Ch);
                        End;
                    For I := 1 to 12 do
                        Begin
                             For J := 1 to 3 do
  { Check for    }               Begin
  { alphabetic   }                    Ch := PTOOLDAT_Mon [I] [J];
  { month inputs }                    TestMon [J] := UpCase (Ch);
                                 End;
                             For J := 1 to 9 do
                                 Begin
                                      Ch := PTOOLDAT_Month [I] [J];
                                      TestMonth [J] := UpCase (Ch);
                                 End;
                             TestMon [0] := PTOOLDAT_Mon [I] [0];
                             TestMonth [0] := PTOOLDAT_Month [I] [0];
                             If (Test = TestMon)
                             or (Test = TestMonth) then
                                PTOOLDAT_GetNum := I;
                        End;
               End;
      'D' : If Code = 0 then
               If Number in [1..31] then PTOOLDAT_GetNum := Number;
      'Y' : If Code = 0 then
               If Number > 99 then PTOOLDAT_GetNum := Number
                 else
                  PTOOLDAT_GetNum := PTOOLDAT_Set_Century (Number);
      End; {Case}
End;


FUNCTION PTOOLDAT_Leap_Year (InYear : Integer) : Boolean;

Var                                          { Find out if it's a Leap Year }
   Century : Integer;
   Year    : Integer;

Begin
     If InYear < 100 then
        InYear := PTOOLDAT_Set_Century (InYear);
     Century := Trunc (Int (InYear / 100));
     Year := InYear - (Century * 100);
     PTOOLDAT_Leap_Year := True;
     If Year <> (Trunc (Int (Year / 4)) * 4) then PTOOLDAT_Leap_Year := False;
     If (Year = 0) and
        (Century = (Trunc (Int (Century / 4)) * 4)) and
        (Century <> (Trunc (Int (Century / 10)) * 10)) then
           PTOOLDAT_Leap_Year := False;
End;


FUNCTION PTOOLDAT_G_Check (Test : PTOOLDAT_Str_21;
                           OrderIn : PTOOLDAT_Str_3)
                          : Boolean;

Var                                      { Find out if the Element areas    }
   Num_of_El : Integer;                  { represent a valid Gregorian date }
   E         : Byte;                     { and set Number areas             }
   Ok        : Boolean;

Begin
     Ok := True;
     PTOOLDAT_Parse (Test, Num_of_El);
     If Num_of_El <> 3 then
        Ok := False;
     For E := 1 to 3 do
         Begin
              PTOOLDAT_Number [E] := PTOOLDAT_GetNum (PTOOLDAT_Element [E],
                                                      OrderIn [E]);
              If PTOOLDAT_Number [E] = 0 then Ok := False;
         End;
     If Ok = True then
        Begin
             For E := 1 to 3 do
                 Case OrderIn [E] of
                  'Y' : PTOOLDAT_NumY := PTOOLDAT_Number [E];
                  'M' : PTOOLDAT_NumM := PTOOLDAT_Number [E];
                  'D' : PTOOLDAT_NumD := PTOOLDAT_Number [E];
                  End; {Case}
             If PTOOLDAT_NumD > 30 then
                If not (PTOOLDAT_NumM in [1, 3, 5, 7, 8, 10, 12]) then
                   Ok := False;
             If (PTOOLDAT_NumD > 29) and
                (PTOOLDAT_NumM = 2) then Ok := False;
             If (PTOOLDAT_NumD > 28) and
                (PTOOLDAT_NumM = 2) and
                (PTOOLDAT_Leap_Year (PTOOLDAT_NumY) = False) then
                Ok := False;
        End;
     PTOOLDAT_G_Check := Ok;
End;


FUNCTION PTOOLDAT_Make_G : PTOOLDAT_Str_21;

Var                              { Transform the Number & Element areas }
   E      : Byte;                { into a Gregorian date                }
   Output : String [21];

Begin
     If PTOOLDAT_G_YrDisp = 2 then
        Str (PTOOLDAT_NumY - (Trunc (Int (PTOOLDAT_NumY / 100)) * 100):2,
             PTOOLDAT_ElY)
     else
        Str (PTOOLDAT_NumY:4, PTOOLDAT_ElY);
     If PTOOLDAT_ElY [1] = ' ' then PTOOLDAT_ElY [1] := '0';
     Case PTOOLDAT_G_MoDisp of
      2 : Begin
               Str (PTOOLDAT_NumM:2, PTOOLDAT_ElM);
               If PTOOLDAT_ElM [1] = ' ' then
                  If PTOOLDAT_G_ZeroSup then Delete (PTOOLDAT_ElM, 1, 1)
                                        else PTOOLDAT_ElM [1] := '0';
          End;
      3 : PTOOLDAT_ElM := PTOOLDAT_Mon [PTOOLDAT_NumM];
      9 : PTOOLDAT_ElM := PTOOLDAT_Month [PTOOLDAT_NumM];
     End; {Case}
     Str (PTOOLDAT_NumD:2, PTOOLDAT_ElD);
     If PTOOLDAT_ElD [1] = ' ' then
        If PTOOLDAT_G_ZeroSup then Delete (PTOOLDAT_ElD, 1, 1)
                              else PTOOLDAT_ElD [1] := '0';
     Output := '';
     For E := 1 to 3 do
         Begin
              Case PTOOLDAT_G_Order [E] of
               'Y' : Output := Output + PTOOLDAT_ElY;
               'M' : Output := Output + PTOOLDAT_ElM;
               'D' : Output := Output + PTOOLDAT_ElD;
               End; {Case}
              Case E of
               1 : Output := Output + PTOOLDAT_G_Sep1;
               2 : Output := Output + PTOOLDAT_G_Sep2;
               End; {Case}
         End;
     PTOOLDAT_Make_G := Output;
End;


FUNCTION PTOOLDAT_G_Convert (Test  : PTOOLDAT_Str_21;
                             OrderIn, OrderOut : PTOOLDAT_Str_3)
                            : PTOOLDAT_Str_21;

Begin                                               { Transform date formats }
     PTOOLDAT_G_Convert := ' ';
     If PTOOLDAT_G_Check (Test, OrderIn) then
        PTOOLDAT_G_Convert := PTOOLDAT_Make_G;
End;


FUNCTION PTOOLDAT_Day_of_Year : Integer;

Var                                           { Get Day of Year }
   Result : Integer;

Const
     Days : Array [1..12] of Integer = (0, 31, 59, 90, 120, 151, 181, 212,
                                        243, 273, 304, 334);

Begin
      Result := Days [PTOOLDAT_NumM] + PTOOLDAT_NumD;
      If (PTOOLDAT_NumM > 2) and
         (PTOOLDAT_Leap_Year (PTOOLDAT_NumY)) then
         Result := Result + 1;
      PTOOLDAT_Day_of_Year := Result;
End;


FUNCTION PTOOLDAT_J_Type_E : Real;

Var                                        { Get 'E' type Julian Date from }
   Accum : Real;                           { Number area                   }
   I, J  : Integer;

Begin
     If PTOOLDAT_BaseYear <= PTOOLDAT_NumY then
        Begin
             J := Trunc ( Int((PTOOLDAT_NumY - PTOOLDAT_BaseYear) / 4));
             Accum := Int (J) * 1461;
             I := PTOOLDAT_BaseYear + (J * 4);
             While I < PTOOLDAT_NumY do
                   Begin
                        If PTOOLDAT_Leap_Year (I) then Accum := Accum + 366
                                                  else Accum := Accum + 365;
                        I := I + 1;
                  End;
             PTOOLDAT_J_Type_E := Accum + PTOOLDAT_Day_of_Year - 1;
        End
     else
        Begin
             If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then
                Accum := 367 - PTOOLDAT_Day_of_Year
             else
                Accum := 366 - PTOOLDAT_Day_of_Year;
             J := Trunc ( Int ((PTOOLDAT_BaseYear - PTOOLDAT_NumY) / 4));
             Accum := Accum + (Int (J) * 1461);
             I := PTOOLDAT_NumY + 1 + (J * 4);
             While I < PTOOLDAT_BaseYear do
                   Begin
                        If PTOOLDAT_Leap_Year (I) then Accum := Accum + 366
                                                  else Accum := Accum + 365;
                        I := I + 1;
                   End;
             PTOOLDAT_J_Type_E := Accum * -1;
        End;
End;


PROCEDURE PTOOLDAT_Set_M_D (Input : Real);

Var                                               { Get Month & Day }
   InInt    : Integer;                            { from DDD        }
   I        : Byte;
   J        : Integer;
   DayTest  : Array [1..12] of Integer;

Const
     Days : Array [1..12] of Integer = (0, 31, 59, 90, 120, 151, 181, 212,
                                        243, 273, 304, 334);

Begin
     InInt := Trunc (Input - ((Int (Trunc (Input / 1000))) * 1000));
     Move (Days, DayTest, 24);
     If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then
        For I := 3 to 12 do
            DayTest [I] := DayTest [I] + 1;
     For I := 1 to 12 do
         If InInt > DayTest [I] then
            Begin
                 PTOOLDAT_NumM := I;
                 J := DayTest [I];
            End;
     PTOOLDAT_NumD := InInt - J;
End;


PROCEDURE PTOOLDAT_J_E_Eval (Input : Real);
                                                { Convert a Julian type 'E' }
Var                                             { date to Number area       }
   Years, Days  : Integer;
   I            : Byte;
   Test         : Integer;

Begin
     If Input >= 0 then
        Begin
             Years := Trunc (Input / 1461);
             Days := Trunc (Input - (Int (Years) * 1461)) + 1;
             PTOOLDAT_NumY := PTOOLDAT_BaseYear;
             For I := 1 to 4 do
                 Begin
                      If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Test := 366
                                                            else Test := 365;
                      If Days > Test then
                         Begin
                              Days := Days - Test;
                              PTOOLDAT_NumY := PTOOLDAT_NumY + 1;
                         End;
                 End;
             PTOOLDAT_NumY := PTOOLDAT_NumY + (Years * 4);
        End
     else
        Begin
             Input := Input * -1;
             Years := Trunc (Input / 1461);
             Days := Trunc (Input - (Int (Years) * 1461));
             PTOOLDAT_NumY := PTOOLDAT_BaseYear - 1;
             For I := 1 to 4 do
                 Begin
                      If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Test := 366
                                                            else Test := 365;
                      If Days > Test then
                         Begin
                              Days := Days - Test;
                              PTOOLDAT_NumY := PTOOLDAT_NumY - 1;
                         End;
                 End;
             PTOOLDAT_NumY := PTOOLDAT_NumY - (Years * 4);
             If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Days := 367 - Days
                                                   else Days := 366 - Days;
        End;
     PTOOLDAT_Set_M_D (Days);
End;


PROCEDURE PTOOLDAT_J_AB_Set_Y (Input : Real);     { Put Year in Number area }
                                                  { From YYmmm              }
Begin
     PTOOLDAT_NumY := Trunc (Input / 1000);
     If PTOOLDAT_NumY < 100 then
        PTOOLDAT_NumY := PTOOLDAT_Set_Century (PTOOLDAT_NumY);
End;


FUNCTION PTOOLDAT_Get_Jul : Real;
                                          { Get Julian Date from Number area }
Begin
     Case PTOOLDAT_J_Type of
      'A' : PTOOLDAT_Get_Jul := (Int (PTOOLDAT_NumY) * 1000)
                              - (Int (PTOOLDAT_NumY / 100) * 100000.0)
                              + Int (PTOOLDAT_Day_of_Year);
      'B' : PTOOLDAT_Get_Jul := (Int (PTOOLDAT_NumY) * 1000)
                              + Int (PTOOLDAT_Day_of_Year);
      'E' : PTOOLDAT_Get_Jul := PTOOLDAT_J_Type_E;
      End; {Case}
End;


FUNCTION PTOOLDAT_Get_S : Integer;
                                      { Get Short date from Number area }
Var
   Julian : Real;

Const
     MaxJul : Real = 65532.0;

Begin
     Julian := PTOOLDAT_J_Type_E;
     If (Julian >= 0) and
        (Julian <= MaxJul) then PTOOLDAT_Get_S := Trunc (Julian - 32765)
                           else PTOOLDAT_Get_S := -32766;
End;


FUNCTION PTOOLDAT_DOW (Day : Integer) : PTOOLDAT_Str_9;

Var
   Hold_DOW : PTOOLDAT_Str_9;                     { Convert 1 - 7 to day }
                                                  { of week verbage      }
Begin
     Case PTOOLDAT_Day_Type of
      1 : Begin
               Str (Day:1, Hold_DOW);
               PTOOLDAT_DOW := Hold_DOW;
          End;
      3 : PTOOLDAT_DOW := PTOOLDAT_Day [Day];
      9 : PTOOLDAT_DOW := PTOOLDAT_DayOW [Day];
      End; {Case}
End;


FUNCTION PTOOLDAT_Get_Date : PTOOLDAT_Str_21;

Type                                         { BIOS call to get current date }
    BiosCall = Record
               Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
               End;

Var
    BiosRec          : BiosCall;
    Year, Month, Day : String [4];

Begin
     With BiosRec do
          Begin
               Ax := $2a shl 8;
          End;
     MsDos (BiosRec);
     With BiosRec do
          Begin
               Str (Cx, Year);
               Str (Dx mod 256, Day);
               Str (Dx shr 8, Month);
          End;
     PTOOLDAT_Get_Date := Year + ' ' + Month + ' ' + Day;
End;


{Called FUNCTIONs Begin Here ******************************************** }

FUNCTION PTDGtoJ (Input : PTOOLDAT_Str_21) : Real;
begin
     If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
        PTDGtoJ := PTOOLDAT_Get_Jul;
end;

{FUNCTIONs available in PTOOLTIM.INC are:

                               (Result)

 PTTValid  (String)          : Boolean - True if argument is valid time
 PTTHtoD   (String)          : Real    - Convert argument (HH:MM:SS String) to
                                         a Decimal Time
 PTTDtoH   (Real)            : String  - Convert argument (Decimal Time) to a
                                         HH:MM:SS String
 PTTHtoH   (String)          : String  - Convert argument (HH:MM:SS String) to
                                         HH:MM:SS String in display format.
 PTTAdd    (String, Real)    : String  - Add argument-2 number of Days, Hours
                                         Minutes or Seconds (depending on
                                         Decimal Time Type) to argument-1
                                         (HH:MM:SS String) and express result
                                         as a HH:MM:SS String
 PTTComp  (String, String)  : Real    - Subtract argument-2 (HH:MM:SS String)
                                         from argument-1 (HH:MM:SS String)
                                         giving number of Days, Hours, Minutes
                                         or Seconds (depending on Decimal Time
                                         Type)
 PTTHCurr                    : String  - Current (system) Time as a HH:MM:SS
                                         String
 PTTDCurr                    : Real    - Current (system) Time as Decimal
                                         Days, Hours, Minutes or Seconds
                                         (depending on Decimal Time Type)   }



{ Constant Values  (Parameters) Begin Here ******************************** }


TYPE

     PTOOLTIM_Str_11   = String [11];
     PTOOLTIM_Elements = Array [1..4] of String [11];


CONST

   { HH:MM:SS String     A string expression of up to 11 characters.
     ---------------     example:  12:02:54 am

                         The style to display the elements (HH, MM, SS)
                         is determined by the parameters below.

                         As an argument, the time is passed as a string
                         expression with 3 or 4 elements separated by at
                         least one of the characters  / - , . ' ; : ( )
                         or a space.                                         }

                                           {   HH:MM:SS String parameters    }
                                           {*********************************}
 PTOOLTIM_HH_Disp   : Byte        = 24;    { Hour Display format             }
                                           {   12    = 12 hour format        }
                                           {   24    = 24 hour format        }
 PTOOLTIM_SS_Disp   : Char        = 'S';   { Seconds Display format          }
                                           {   'S'   = Display Seconds       }
                                           {   ' '   = Display HH:MM only    }
                                           {*********************************}


   { Decimal Time     A Real number in either of four formats:
     ------------        D = Decimal Days
                         H = Decimal Hours
                         M = Decimal Minutes
                         S = Decimal Seconds }

                                           {      Decimal Time parameter     }
                                           {*********************************}
 PTOOLTIM_D_Type    : Char        = 'S';   { Decimal Time Type               }
                                           {*********************************}


{ ****** Areas for internal use follow ****** }

 PTOOLTIM_Element   : PTOOLTIM_Elements = (' ', ' ', ' ', ' ');
 PTOOLTIM_NumH      : Integer = 0;
 PTOOLTIM_NumM      : Integer = 0;
 PTOOLTIM_NumS      : Integer = 0;



{ Internal FUNCTIONs Begin Here ******************************************* }


PROCEDURE PTOOLTIM_Parse (VAR Test               : PTOOLTIM_Str_11;
                          VAR Number_of_Elements : Integer);
Var
   I, J, K, E : Byte;                          { Get elements of input }
                                               { Any of the characters }
Begin                                          { below may seperate    }
     I := 1;                                   { the elements.         }
     K := 1;
     For E := 1 to 3 do
         Begin
              PTOOLTIM_Element [E] := ' ';
              While (not (Test [I] in ['0' .. '9']))
                and (I <= Length (Test)) do
                    Begin
                         PTOOLTIM_Element [4] [K] := Test [I];
                         K := K + 1;
                         I := I + 1;
                    End;
              J := 1;
              While (Test [I] in ['0' .. '9'])
                and (I <= Length (Test)) do
                    Begin
                         PTOOLTIM_Element [E] [J] := Test [I];
                         J := J + 1;
                         I := I + 1;
                         Number_of_Elements := E;
                         PTOOLTIM_Element [E] [0] := Char (J - 1);
                    End;
         End;
     While I <= Length (Test) do
           Begin
                PTOOLTIM_Element [4] [K] := Test [I];
                K := K + 1;
                I := I + 1;
           End;
     PTOOLTIM_Element [4] [0] := Char (K - 1);
End;

FUNCTION PTOOLTIM_H_Check (Test : PTOOLTIM_Str_11) : Boolean;
Var                                      { Find out if the Element areas     }
   Num_of_El : Integer;                  { represent a valid HH:MM:SS String }
   Code      : Integer;                  { and set Number areas              }

Begin
     PTOOLTIM_H_Check := True;
     PTOOLTIM_Parse (Test, Num_of_El);
     If (Num_of_El < 2) or
        (Num_of_El > 3) then
        PTOOLTIM_H_Check := False;
     Val (PTOOLTIM_Element [1], PTOOLTIM_NumH, Code);
     If Code <> 0 then PTOOLTIM_H_Check := False;
     Val (PTOOLTIM_Element [2], PTOOLTIM_NumM, Code);
     If Code <> 0 then PTOOLTIM_H_Check := False;
     PTOOLTIM_NumS := 0;
     If Num_of_El = 3 then
             Val (PTOOLTIM_Element [3], PTOOLTIM_NumS, Code);
     If (Pos ('p', PTOOLTIM_Element [4]) <> 0)
     or (Pos ('P', PTOOLTIM_Element [4]) <> 0) then
        If PTOOLTIM_NumH < 12  then
           PTOOLTIM_NumH := PTOOLTIM_NumH + 12
           else begin end
     else
        If PTOOLTIM_NumH = 12 then PTOOLTIM_NumH := PTOOLTIM_NumH - 12;
     If (PTOOLTIM_NumH > 23) or
        (PTOOLTIM_NumM > 59) or
        (PTOOLTIM_NumS > 59) or
        (PTOOLTIM_NumH < 0) or
        (PTOOLTIM_NumM < 0) or
        (PTOOLTIM_NumS < 0) then PTOOLTIM_H_Check := False;
End;


FUNCTION PTOOLTIM_Make_H : PTOOLTIM_Str_11;
Var                              { Transform the Number areas }
   Output : String [11];         { into a HH:MM:SS String     }
   Work   : String [2];

Begin
     Case PTOOLTIM_HH_Disp of
      12 : If PTOOLTIM_NumH > 12 then Str (PTOOLTIM_NumH - 12:2, Output)
           else
              If PTOOLTIM_NumH = 0 then Output := '12'
              else
                 Str (PTOOLTIM_NumH:2, Output);
      24 : Str (PTOOLTIM_NumH:2, Output);
      End; {Case}
     If Output [1] = ' ' then Delete (Output, 1, 1);
     Str (PTOOLTIM_NumM:2, Work);
     If Work [1] = ' ' then Work [1] := '0';
     Output := Output + ':' + Work;
     If PTOOLTIM_SS_Disp <> ' ' then
        Begin
             Str (PTOOLTIM_NumS:2, Work);
             If Work [1] = ' ' then Work [1] := '0';
             If PTOOLTIM_SS_Disp = 'S' then Output := Output + ':' + Work
                                       else Output := Output + '.' + Work;
        End;
     If PTOOLTIM_HH_Disp = 12 then
     If PTOOLTIM_NumH < 12 then Output := Output + ' am'
                           else Output := Output + ' pm';
     PTOOLTIM_Make_H := Output;
End;


FUNCTION PTOOLTIM_Get_D_Days : Real;  { Get Decimal Days from Number area }
Begin
     PTOOLTIM_Get_D_Days := (Int (PTOOLTIM_NumH) / 24)
                          + (Int (PTOOLTIM_NumM) / 1440)
                          + (Int (PTOOLTIM_NumS) / 86400.0);
End;


FUNCTION PTOOLTIM_Get_Decimal : Real;
                                        { Get Decimal time from }
Begin                                   { Number area           }
     Case PTOOLTIM_D_Type of
      'D' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days;
      'H' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days * 24;
      'M' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days * 1440;
      'S' : PTOOLTIM_Get_Decimal := PTOOLTIM_GET_D_Days * 86400.0;
      End; {Case}
End;



PROCEDURE PTOOLTIM_Get_Time;
                                         { BIOS call to put current time }
Type                                     { into Number areas             }
    BiosCall = Record
               Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
               End;

Var
    BiosRec : BiosCall;
    Ah, Al  : Byte;

Begin
     Ah := $2c;
     With BiosRec do
          Begin
               Ax := Ah shl 8 + Al;
          End;
     Intr ($21, BiosRec);
     With BiosRec do
          Begin
               PTOOLTIM_NumH := Cx shr 8;
               PTOOLTIM_NumM := Cx mod 256;
               PTOOLTIM_NumS := Dx shr 8;
          End;
End;


{Called FUNCTIONs Begin Here ******************************************** }


(*FUNCTION PTTValid (Test : PTOOLTIM_Str_11) : Boolean;
begin
     PTTValid := PTOOLTIM_H_Check (Test);
end;*)


FUNCTION PTTHtoD (Input : PTOOLTIM_Str_11) : Real;
begin
     If PTOOLTIM_H_Check (Input) then
        PTTHtoD := PTOOLTIM_Get_Decimal;
end;


FUNCTION PTTDtoH (Input : Real) : PTOOLTIM_Str_11;
begin
     Case PTOOLTIM_D_Type of
      'H' : Input := Input / 24;
      'M' : Input := Input / 1440;
      'S' : Input := Input / 86400.0;
      End; {Case}
     Input := Frac (Input);
     PTOOLTIM_NumH := Trunc (Input * 24.001);
     PTOOLTIM_NumM := Trunc ((Input - (Int (PTOOLTIM_NumH) / 24)) * 1440.001);
     PTOOLTIM_NumS := Trunc ((Input - (Int (PTOOLTIM_NumH) / 24)
                                    - (Int (PTOOLTIM_NumM) / 1440))
                                        * 86400.001);
     PTTDtoH := PTOOLTIM_Make_H;
end;


OVERLAY FUNCTION PTTComp (Minuend, Subtrahend : PTOOLTIM_Str_11) : Real;
VAR
   HoldNum : Real;

begin
     HoldNum := PTTHtoD (Minuend);
     PTTComp := HoldNum - PTTHtoD (Subtrahend);
end;


OVERLAY FUNCTION PTTHCurr : PTOOLTIM_Str_11;
begin
     PTOOLTIM_Get_Time;
     PTTHCurr := PTOOLTIM_Make_H;
end;


OVERLAY FUNCTION PTTDCurr : Real;
begin
     PTOOLTIM_Get_Time;
     PTTDCurr := PTOOLTIM_Get_Decimal;
end;

OVERLAY FUNCTION PTDGComp (Minuend, Subtrahend : PTOOLDAT_Str_21) : Real;
VAR
   Hold_Jul_Type : Char;

begin
     Hold_Jul_Type := PTOOLDAT_J_Type;
     PTOOLDAT_J_Type := 'E';
     PTDGComp := PTDGtoJ (Minuend) - PTDGtoJ (Subtrahend);
     PTOOLDAT_J_Type := Hold_Jul_Type;
end;

OVERLAY FUNCTION PTDJComp (Minuend, Subtrahend : Real) : Real;
VAR
   Hold_Jul : Real;

begin
     If PTOOLDAT_J_Type = 'E' then PTDJComp := Minuend - Subtrahend
     else
        Begin
             PTOOLDAT_J_AB_Set_Y (Minuend);
             PTOOLDAT_Set_M_D (Minuend);
             Hold_Jul := (PTOOLDAT_J_Type_E);
             PTOOLDAT_J_AB_Set_Y (Subtrahend);
             PTOOLDAT_Set_M_D (Subtrahend);
             PTDJComp := Hold_Jul - (PTOOLDAT_J_Type_E);
        End;
end;


OVERLAY FUNCTION PTDGCurr : PTOOLDAT_Str_21;
begin
     PTDGCurr := PTOOLDAT_G_Convert (PTOOLDAT_Get_Date,
                                     'YMD', PTOOLDAT_G_Order);
end;