home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frostbyte's 1980s DOS Shareware Collection
/
floppyshareware.zip
/
floppyshareware
/
USCX
/
PTOOLS.ZIP
/
PTOOLDAT.INC
< prev
next >
Wrap
Text File
|
1985-02-23
|
36KB
|
1,016 lines
{ PTOOLDAT.INC Copyright 1984 R D Ostrander Version 1.0
Ostrander Data Services
5437 Honey Manor Dr
Indianapolis IN 46241
These Turbo Pascal functions are date manipulation tools used to Convert
Gregorian date strings, Change Gregorian Dates to and from Julian dates,
Find Day of Week, Add numbers to dates, Find the difference between dates,
Convert dates to 2 byte integers in order to save disk storage, and to
Retrieve the current (system) date. Handles date from 1/1/0100 to 12/31/9999.
This program has been placed in the Public Domain by the author and copies
may be freely made for non-commercial, demonstration, or evaluation purposes.
Use of these subroutines in a program for sale or for commercial purposes in
a place of business requires a $20 fee be paid to the author at the address
above. Personal non-commercial users may also elect to pay the $20 fee to
encourage further development of this and similar programs. With payment you
will be able to receive update notices, diskettes and printed documentation
of this and other PTOOLs from Ostrander Data Services.
PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
Turbo Pascal is a Copyright of Borland International Inc.
Functions available in PTOOLDAT.INC are:
(Result)
PTDGValid (String) : Boolean - True if argument is valid Gregorian
Date
PTDJValid (Real) : Boolean - True if argument is valid Julian Date
(Note that this is useful for
Julian types A & B (ANSI) only)
PTDSValid (Integer) : Boolean - True if argument is valid Short
format Date
PTDGtoJ (String) : Real - Convert argument (Gregorian Date) to
a Julian Date
PTDJtoG (Real) : String - Convert argument (Julian Date) to a
Gregorian Date
PTDGtoG (String) : String - Convert argument (Gregorian Date in
2nd format) to Gregorian Date in
standard (1st) format - Note that
a blank (space filled) string
returned if the argument cannot be
converted
PTDGtoS (String) : Integer - Convert argument (Gregorian Date to
a Short format date. Return -32766 if
not in range of January 1st of Base
year thru June 1st, 179 years after
the Base Year.
PTDStoG (Integer) : String - Convert argument (Short format Date)
to a Gregorian Date
PTDJtoS (Real) : Integer - Convert argument (Julian Date to
a Short format date
PTDStoJ (Integer) : Real - Convert argument (Short format Date)
to a Julian Date
PTDGAdd (String, Integer) : String - Add argument-2 (Integer) number of
days to argument-1 (Gregorian Date)
and express result in Gregorian
format
PTDJAdd (Real, Integer) : Real - Add argument-2 (Integer) number of
days to argument-1 (Julian Date) and
express result in Julian format
PTDGComp (String, String) : Real - Subtract argument-2 (Gregorian Date)
from argument-1 (Gregorian Date)
giving number of days between dates
minus 1.
PTDJComp (Real, Real) : Real - Subtract argument-2 (Julian Date)
from argument-1 (Julian Date) giving
number of days between dates minus 1
PTDGLeap (String) : Boolean - True if argument (Gregorian Date) is
a Leap Year
PTDJLeap (Real) : Boolean - True if argument (Julian Date) is a
Leap Year
PTDSLeap (Integer) : Boolean - True if argument (Short format date)
is a Leap Year
PTDYLeap (Integer) : Boolean - True if argument is a Leap Year
PTDGDay (String) : String - Return Day of Week for argument
(Gregorian Date)
PTDJDay (Real) : String - Return Day of Week for argument
(Julian Date)
PTDSDay (Integer) : String - Return Day of Week for argument
(Short format date)
PTDGCurr : String - Current (system) Gregorian Date
PTDJCurr : Real - Current (system) Julian Date
PTDSCurr : Integer - Current (system) Short format date }
{ 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 = True; { 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] = 'YMD'; { 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 = 'A'; { 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 = 1930;
{***** 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)) 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 PTDGValid (Test : PTOOLDAT_Str_21) : Boolean;
BEGIN
PTDGValid := PTOOLDAT_G_Check (Test, PTOOLDAT_G_Order);
END;
FUNCTION PTDJValid (Test : Real) : Boolean;
VAR
Year : Integer;
Day : Integer;
Ok : Boolean;
BEGIN
Ok := True;
Case PTOOLDAT_J_Type of
'A' : If (Test < 1.0) or
(Test > 99365.0) then Ok := False;
'B' : If (Test < 1.0) or
(Test > 9999365.0) then Ok := False;
End; {Case}
PTDJValid := Ok;
If (Ok = True) and
(PTOOLDAT_J_Type <> 'E') then
Begin
Year := Trunc (Test / 1000);
Day := Trunc (Test - (Int (Year) * 1000));
If (Day > 366)
or ((Day = 366) and
(PTOOLDAT_Leap_Year (Year) = False))
or (Day = 0) then
PTDJValid := False;
End;
END;
FUNCTION PTDSValid (Short : Integer) : Boolean;
BEGIN
If Short <> -32766 then PTDSValid := True
else PTDSValid := False
END;
FUNCTION PTDGtoJ (Input : PTOOLDAT_Str_21) : Real;
BEGIN
If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
PTDGtoJ := PTOOLDAT_Get_Jul;
END;
FUNCTION PTDJtoG (Input : Real) : PTOOLDAT_Str_21;
BEGIN
PTDJtoG := ' ';
If PTOOLDAT_J_Type = 'E' then PTOOLDAT_J_E_Eval (Input)
else
Begin
PTOOLDAT_J_AB_Set_Y (Input);
PTOOLDAT_NumY := Trunc (Input / 1000);
If PTOOLDAT_NumY < 100 then
PTOOLDAT_NumY := PTOOLDAT_Set_Century (PTOOLDAT_NumY);
PTOOLDAT_Set_M_D (Input);
End;
PTDJtoG := PTOOLDAT_Make_G;
END;
FUNCTION PTDGtoG (Input : PTOOLDAT_Str_21) : PTOOLDAT_Str_21;
BEGIN
If PTOOLDAT_G_Check (Input, PTOOLDAT_G2_Order) then
PTDGtoG := PTOOLDAT_Make_G
else
PTDGtoG := ' ';
END;
FUNCTION PTDGtoS (Input : PTOOLDAT_Str_21) : Integer;
BEGIN
If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
PTDGtoS := PTOOLDAT_Get_S
else
PTDGtoS := -32766;
END;
FUNCTION PTDStoG (Short : Integer) : PTOOLDAT_Str_21;
BEGIN
If PTDSValid (Short) = False then PTDStoG := ' '
else
Begin
PTOOLDAT_J_E_Eval (Int (Short) + 32765);
PTDStoG := PTOOLDAT_Make_G;
End
END;
FUNCTION PTDJtoS (Input : Real) : Integer;
CONST
MaxJul : Real = 65532.0;
BEGIN
PTDJtoS := -32766;
If PTOOLDAT_J_TYPE in ['A', 'B'] then
Begin
PTOOLDAT_J_AB_Set_Y (Input);
PTOOLDAT_Set_M_D (Input);
PTDJtoS := PTOOLDAT_Get_S;
End
else
If (Input >= 0) and
(Input <= MaxJul) then PTDJtoS := Trunc (Input - 32765);
END;
FUNCTION PTDStoJ (Short : Integer) : Real;
VAR
Julian_E : Real;
BEGIN
Julian_E := Int (Short) + 32765;
If PTDSValid (Short) then
If PTOOLDAT_J_Type = 'E' then
PTDStoJ := Julian_E
else
Begin
PTOOLDAT_J_E_Eval (Julian_E);
PTDStoJ := PTOOLDAT_Get_Jul;
End;
END;
FUNCTION PTDGAdd (Input : PTOOLDAT_Str_21;
Number : Integer) : PTOOLDAT_Str_21;
BEGIN
If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
Begin
PTOOLDAT_J_E_Eval (PTOOLDAT_J_Type_E + Int (Number));
PTDGAdd := PTOOLDAT_Make_G;
End;
END;
FUNCTION PTDJAdd (Input : Real; Number : Integer) : Real;
BEGIN
If PTOOLDAT_J_Type = 'E' then
PTDJAdd := (Input + Int (Number))
else
Begin
PTOOLDAT_J_AB_Set_Y (Input);
PTOOLDAT_Set_M_D (Input);
PTOOLDAT_J_E_Eval (PTOOLDAT_J_Type_E + Int (Number));
PTDJAdd := PTOOLDAT_Get_Jul;
End;
END;
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;
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;
FUNCTION PTDGLeap (Input : PTOOLDAT_Str_21) : Boolean;
BEGIN
If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
PTDGLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY)
else
PTDGLeap := False;
END;
FUNCTION PTDJLeap (Input : Real) : Boolean;
BEGIN
If PTOOLDAT_J_Type = 'E' then
PTOOLDAT_J_E_Eval (Input)
else
PTOOLDAT_J_AB_Set_Y (Input);
PTDJLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY);
END;
FUNCTION PTDSLeap (Input : Integer) : Boolean;
BEGIN
If PTDSValid (Input) = False then PTDSLeap := False
else
Begin
PTOOLDAT_J_E_Eval (Int (Input) + 32765);
PTDSLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY);
End;
END;
FUNCTION PTDYLeap (Input : Integer) : Boolean;
BEGIN
PTDYLeap := PTOOLDAT_Leap_Year (Input);
END;
FUNCTION PTDGDay (Input : PTOOLDAT_Str_21) : PTOOLDAT_Str_9;
VAR
Hold_Base_Year : Integer;
Hold_Jul_Type : Char;
Day : Integer;
BEGIN
Hold_Base_Year := PTOOLDAT_BaseYear;
PTOOLDAT_BaseYear := 0100;
Hold_Jul_Type := PTOOLDAT_J_Type;
PTOOLDAT_J_Type := 'E';
Day := Trunc (Frac (PTDGtoJ (Input) / 7) * 7.001) + 1;
PTDGDay := PTOOLDAT_DOW (Day);
PTOOLDAT_BaseYear := Hold_Base_Year;
PTOOLDAT_J_Type := Hold_Jul_Type;
END;
FUNCTION PTDJDay (Input : Real) : PTOOLDAT_Str_9;
BEGIN
PTDJDay := PTDGDay (PTDJtoG (Input));
END;
FUNCTION PTDSDay (Input : Integer) : PTOOLDAT_Str_9;
BEGIN
PTDSDay := PTDGDay (PTDStoG (Input));
END;
FUNCTION PTDGCurr : PTOOLDAT_Str_21;
BEGIN
PTDGCurr := PTOOLDAT_G_Convert (PTOOLDAT_Get_Date,
'YMD', PTOOLDAT_G_Order);
END;
FUNCTION PTDJCurr : Real;
BEGIN
PTDJCurr := PTDGtoJ (PTDGCurr);
END;
FUNCTION PTDSCurr : Integer;
BEGIN
PTDSCurr := PTDGtoS (PTDGCurr);
END;