home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
t
/
tpdate.zip
/
DATE.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-06-25
|
31KB
|
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 │▌ }
{▐ └────────┘└─────────────────────────────────────────────────────────────┘▌ }
{▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌ }