Date Functions Class

type
   TDateOrder = (doMDY, doDMY, doYMD, doDMMMY, doMMMDY, doYMMMD);
   PDayTable = ^TDayTable;
   TDayTable = array[1..12] of Word;

   TAdrockDayOfWeek =
(Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, InvalidDayOfWeek);
   TAdrockDates = Class
     HolidayStringList : TStrings;
    public
    Constructor Create;

    Function ReturnDelphiDayOfWeek(StartingDayOfWeek, WeekDay : Integer) : Integer;
    Function ReturnWeekDayName(StartingDayOfWeek, WeekDay : Integer) : String;
    Function ReturnWeekofMonth(StartingDayOfWeek : Integer; WorkDate : TDateTime) : Word;
    Function ReturnWeekofYear(StartingDayOfWeek : Integer; WorkDate : TDateTime) : Integer;

    Function ReturnDayOfWeek(StartingDayOfWeek : Integer; WorkDate : TDateTime) : Word;
    Function ReturnDayOfMonth(WorkDate : TDateTime) : Word;
    Function ReturnDayOfYear(WorkDate : TDateTime) : Word;

Function ReturnMonth(WorkDate : TDateTime) : Word;

    { Donated by Tim Boyd (timboyd@bigfoot.com) }
    function ReturnFirstOfQuarter(const DateTime: TDateTime): TDateTime;
    { Donated by Tim Boyd (timboyd@bigfoot.com) }
    function ReturnLastOfQuarter(const DateTime: TDateTime): TDateTime;

    Function ReturnQuarter(WorkDate : TDateTime) : Word;
    Function ReturnYear(WorkDate : TDateTime) : Word;
    Function ReturnCentury(WorkDate : TDateTime) : Word;
    Function ReturnDayTh(WorkDate : TDateTime) : String;
    Function ReturnDayThi(WorkDay : Integer) : String;

    Function ReturnDaysAgo(WorkDate : TDateTime) : String;
    Function ReturnWeeksAgo(StartingDayOfWeek : Integer; WorkDate : TDateTime) : String;
    Function ReturnMonthsAgo(WorkDate : TDateTime) : String;
    Function ReturnQuartersAgo(WorkDate : TDateTime) : String;
    Function ReturnYearsAgo(WorkDate : TDateTime) : String;

    Function AreDatesInSameMonth(FirstDate, SecondDate : TDateTime) : Boolean;
    Function AreDatesInSameYear(FirstDate, SecondDate : TDateTime) : Boolean;
    Function AreDatesInSameMonthAndYear(FirstDate, SecondDate : TDateTime) : Boolean;

    Function ReturnBoundaryWeeksBetweenDates(StartingDayOfWeek : Integer; FirstDate, SecondDate : TDateTime) : Integer;
    Function ReturnBoundaryQuartersBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;
    Function ReturnBoundaryMonthsBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;
    Function ReturnBoundaryYearsBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;

    Function ReturnDaysBetweenDates(FirstDate, SecondDate : TDateTime) : LongInt;
    Function ReturnWeeksBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;
    Function ReturnMonthsBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;
    Function ReturnQuartersBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;
    Function ReturnYearsBetweenDates(FirstDate, SecondDate : TDateTime) : Integer;

    function GetDayTable(Year: Word): PDayTable;
    function DoEncodeDate(fYear, fMonth, fDay: Word; var fDate: TDateTime): Boolean;
    procedure ScanCommasAndBlanks(const S: string; var Pos: Integer);
    procedure ScanBlanks(const S: string; var Pos: Integer);
    function ScanMonthWord(const S: string; var Pos: Integer;var Number: Word): Boolean;
    function ScanNumber(const S: string; var Pos: Integer; var Number: Word): Boolean;
    function ScanCharNoSpace(const S: string; var Pos: Integer; Ch: Char): Boolean;
    function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
    function GetTextDateOrder(const DateFormat: string): TDateOrder;
    function GetDateOrder(const DateFormat: string): TDateOrder;
    Function ReturnEasterSunday(Year : Word) : TDateTime;

    Function ReturnDateOrder : TDateOrder;
    Function ConvertFromJulian(Julian : Longint) : TDateTime;
    Function ConvertToJulian(Date : TDateTIme) : Longint;
    Function ConvertToJuliani(Year, Month, Day : Word) : Longint;
    function AdrockDateToStr(WorkDate : TDateTime) : String;
    function AdrockScanDate(const S: string; var Pos: Integer; var fDate: TDateTime): Boolean;
    function ScanDate(const S: string; var Pos: Integer; var Date: TDateTime): Boolean;
    Function IsValidDate(WorkDate : String) : Boolean;

    Function IsValidAdrockDate(WorkDate : String) : Boolean;
    Function IsValidAdrockDateTime(WorkDate : String) : Boolean;
    Function IsValidAdrockTime(WorkDate : String) : Boolean;

    function AdrockStrToDate(WorkDate : String) : TDateTime;
    function AdrockStrToDateTime(WorkDate : String) : TDateTime;
    function AdrockStrToTime(WorkDate : String) : TDateTime;

    Function IsLeapyear(WorkDate : TDateTime) : Boolean;
    function IsLeapYeari(aYear : Integer) : Boolean;
    Function IsDateInRange(WorkDate, StartDate, EndDate : TDateTime) : Boolean;

    Function AddDays(NumberOfDays : Integer; WorkDate :TDateTime) : TDateTime;
    Function AddWeeks(NumberOfWeeks : Integer; WorkDate :TDateTime) : TDateTime;
    Function AddMonths(NumberOfMonths : Integer; WorkDate :TDateTime) : TDateTime;
    Function AddQuarters(NumberOfQuarters : Integer; WorkDate :TDateTime) : TDateTime;
    Function AddYears(NumberOfYears : Integer; WorkDate :TDateTime) : TDateTime;

Function FormatDate(FormatMask : String; WorkDate : TDateTime) : String;

    Function DaysInMonth(WorkDate : TDateTime) : Word;
    Function DaysInMonthi(Month, Year : Word) : Word;
    Function DaysInYear(WorkDate : TDateTime) : Word;
    function DaysInYeari(Year : Integer) : Word;
    Function DaysLeftInMonth(WorkDate : TDateTime) : Word;
    function DaysLeftInMonthi(Day, Month, Year : Integer) : Word;
    Function DaysLeftInYear(WorkDate : TDateTime) : Word;
    Function DaysLeftInYeari(Day, Month, Year : Integer) : Word;

Function AddDate(DateMask : String; NumberOfPeriods : Integer; WorkDate : TDatetime) : TDateTime;
Function DateDiff(DateMask : String; StartingDayOfWeek : Integer; FirstDate, SecondDate : TDatetime) : Longint;

Function AddTime(fDateTime : TDateTime; Hours, Minutes, Seconds : longint) : TDateTime;
Procedure TimeDiff(fDateTime1, fDateTime2 : TDateTime; var Hours, Mins, Secs : longint);

    Function GetFirstofMonthWeekNumber(StartingDayOfMonth : Integer; WorkDate : TDateTime) : Integer;
    Function ReturnPersonsAge_Work(Today, DOB : TDateTime) : Integer;
    Function ReturnPersonsAge(DOB : TDateTime) : Integer;
    function AgeStr(aDate: TDateTime): string;

Function ReturnDateOrdinalDayOfWeek(StartOfMonth : Boolean; Week, WeekDay, Month, Year : Integer) : TDateTime;

    Function ReturnDaysInthePast(WorkDate : TDateTime; TestDate : TDateTime) : String;
    Function ReturnWeeksInthePast(StartingDayOfWeek : Integer; WorkDate : TDateTime; TestDate : TDateTime) : String;
    Function ReturnMonthsInthePast(WorkDate : TDateTime; TestDate : TDateTime) : String;
    Function ReturnQuartersInthePast(WorkDate : TDateTime; TestDate : TDateTime) : String;
    Function ReturnYearsInthePast(WorkDate : TDateTime; TestDate : TDateTime) : String;

    Function ReturnFirstAndLastOfAGivenWeek(WeekStart : TAdrockWeekDay; WeekNumberStyle : TAdrockWeekStyle;
                 WeekNumber, Year : Integer; var FirstDate, LastDate : TDateTime): Boolean;
    Function ReturnFirstOfAGivenWeek(WeekStart : TAdrockWeekDay; WeekNumberStyle : TAdrockWeekStyle;
                 WeekNumber, Year : Integer): TDateTime;
    Function ReturnLastOfAGivenWeek(WeekStart : TAdrockWeekDay; WeekNumberStyle : TAdrockWeekStyle;
                 WeekNumber, Year : Integer): TDateTime;

Function ReturnFirstOfAWeek(StartingDayOfWeek: Integer; WorkDate : TDateTime) : TDateTime;
Function ReturnLastOfAWeek(StartingDayOfWeek: Integer; WorkDate : TDateTime) : TDateTime;

Function ReturnLastOfGivenMonth(ADate: TDateTime) : TDateTime;
Function ReturnFirstOfGivenMonth(ADate: TDateTime) : TDateTime;

Function ReturnFirstOfTheWeek : TDateTime;
Function ReturnLastOfTheWeek : TDateTime;

    Function ReturnFirstOfTheMonth : TDateTime;
    Function ReturnLastOfTheMonth : TDateTime;
    Function ReturnFirstOfTheYear : TDateTime;
    Function ReturnLastOfTheYear : TDateTime;

Function ReturnFirstOfNextWeek : TDateTime;
Function ReturnLastOfNextWeek : TDateTime;

    Function ReturnFirstOfLastWeek : TDateTime;
    Function ReturnLastOfLastWeek : TDateTime;
    Function ReturnFirstOfLastMonth : TDateTime;
    Function ReturnLastOfLastMonth : TDateTime;
    Function ReturnFirstOfNextMonth : TDateTime;
    Function ReturnLastOfNextMonth : TDateTime;

    Function ReturnFirstOf2MonthsAgo : TDateTime;
    Function ReturnFirstOf3MonthsAgo : TDateTime;
    Function ReturnFirstOf6MonthsAgo : TDateTime;

Function ReturnFirstOfLastYear : TDateTime;
Function ReturnLastOfLastYear : TDateTime;

function IntToDate(WorkDate : Longint) : TDateTime;
function DateToInt(WorkDate : TDateTime) : Longint;

    { Added with Version 1.10 }
    Function IsDateWithinRange(TestDate, FirstDate, LastDate : TDatetime)    : Boolean;
    Function NextBusinessDay(RequiredDate : TDateTime) : TDateTime;
    Function PrevBusinessDay(RequiredDate : TDateTime) : TDateTime;
    function ReturnBusinessDaysBetweenDates(FirstDate, LastDate : TDatetime) : Integer;
    Function VerbalDate(WorkDate : TDatetime) : String;

    Function IsValidMonthName(MonthName : String) : Boolean;
    Function IsValidDayName(DayName : String) : Boolean;
    Function IsMonday(WorkDate : TDateTime) : Boolean;
    Function IsTuesday(WorkDate : TDateTime) : Boolean;
    Function IsWednesday(WorkDate : TDateTime) : Boolean;
    Function IsThursday(WorkDate : TDateTime) : Boolean;
    Function IsFriday(WorkDate : TDateTime) : Boolean;
    Function IsSaturday(WorkDate : TDateTime) : Boolean;
    Function IsSunday(WorkDate : TDateTime) : Boolean;

    Function IsJanuary(WorkDate : TDateTime) : Boolean;
    Function IsFebruary(WorkDate : TDateTime) : Boolean;
    Function IsMarch(WorkDate : TDateTime) : Boolean;
    Function IsApril(WorkDate : TDateTime) : Boolean;
    Function IsMay(WorkDate : TDateTime) : Boolean;
    Function IsJune(WorkDate : TDateTime) : Boolean;
    Function IsJuly(WorkDate : TDateTime) : Boolean;
    Function IsAugust(WorkDate : TDateTime) : Boolean;
    Function IsSeptember(WorkDate : TDateTime) : Boolean;
    Function IsOctober(WorkDate : TDateTime) : Boolean;
    Function IsNovember(WorkDate : TDateTime) : Boolean;
    Function IsDecember(WorkDate : TDateTime) : Boolean;

Function IsWeekend(WorkDate : TDateTime) : Boolean;
Function IsWeekday(WorkDate : TDateTime) : Boolean;

    Function IsAM(WorkDate : TDateTime) : Boolean;
    Function IsPM(WorkDate : TDateTime) : Boolean;
    Function IsMorning(WorkDate : TDateTime) : Boolean;
    Function IsAfternoon(WorkDate : TDateTime) : Boolean;

Function IsMidday(WorkDate : TDateTime) : Boolean;
Function IsMidNight(WorkDate : TDateTime) : Boolean;

    Function IsChristmasDay(WorkDate : TDateTime) : Boolean;
    Function IsNewYearsDay (WorkDate : TDateTime) : Boolean;
    Function IsEasterSunday(WorkDate : TDateTime) : Boolean;

Function IsFirstOfTheMonth(WorkDate : TDateTime) : Boolean;
Function IsLastOfTheMonth(WorkDate : TDateTime) : Boolean;

    Function IsHoliday(WorkDate : TDateTime) : Boolean;
    Function IsBusinessDay(WorkDate : TDateTime) : Boolean;
    Function IsBusinessHoliday(WorkDate : TDateTime) : Boolean;
    function IsDateInPosNegRange(WorkDate, CompareDate : TDateTime; PositiveDays, NegativeDays : Integer) : Boolean;
    function IsDateInPosNegBusinessRange(WorkDate, CompareDate : TDateTime; PositiveDays, NegativeDays : Integer) : Boolean;
    Procedure SetHolidayStringList(NewHolidayStringList : TStrings);
    Function AddBusinessDays(NumberOfDays : Integer; WorkDate :TDateTime) : TDateTime;

Function IsEmptyDate(WorkDate : String) : Boolean;

Procedure SetSystemTime(Hour, Minute, Second, Hundreths : Byte);
Procedure SetSystemDate(Year : Word; Month, Day : Byte);

    { Added in V1.40 }
    Function SecondsBetweenDates(fStartDateTime, fEndDateTime : TDateTime) : Longint;
    Function DecodeTextDate(DateFormatStr, DateStr : String) : TDateTime;

Function ConvertDayOfWeekToInt(DayOfWeek : TadrockDayOfWeek) : Integer;
Function ConvertIntToDayOfWeek(DayOfWeek : Integer) : TAdrockDayofWeek;

Function CenturyCutoff : Word;
function ExpandYear(fyear : Word) : Word;

    Function ReturnWeekofYear_Work(RealWeek : Boolean; Recursive : Integer;
                StartingDayOfWeek : Integer; WorkDate : TDateTime) : Word;
    Function ReturnWeeksInYear(StartingDayOfWeek : Integer; Year : Integer) : Integer;

    Procedure ReturnYearsMonthsDaysBetweenDates(FirstDate, LastDate : TDateTime; var Negative : Boolean;
              var fYear, fMonth, fDay : Word);
    Function FillandFormatDates(UseColor : Boolean; Color1, Color2 : TColor; EndStr : String;
              fYear, fMonth, fDay : Word) : String;

Function MailDateToDateTime(MailDateTimeString : string; var DateTime : TDateTime; var TimeZone : string) : Boolean;
private
end;

{ Routines that can be called by any code that includes this unit }

procedure FreeAdrockDateClass;

     {*****************************************************************************}
     {** Create an instance of the AdrockDateClass, this instance does not get   **}
     {** freed, you must call FreeAdrockDateClass to do that. At the end of your **}
     {** program is the best place.                                              **}
     {*****************************************************************************}
     Procedure CreateAdrockDateClass;

Function ReturnEasterSunday(Year : Word) : TDateTime;
Function ReturnMonth(WorkDate : TDateTime) : Word;

    Function ReturnWeeksAgo(StartingDayOfWeek : Integer; WorkDate : TDateTime) : String;
    Function ReturnMonthsAgo(WorkDate : TDateTime) : String;
    Function ReturnQuartersAgo(WorkDate : TDateTime) : String;
    Function ReturnYearsAgo(WorkDate : TDateTime) : String;

    Function IsValidAdrockDate(WorkDate : String) : Boolean;
    Function IsValidAdrockDateTime(WorkDate : String) : Boolean;
    Function IsValidAdrockTime(WorkDate : String) : Boolean;
    function AdrockStrToDate(WorkDate : String) : TDateTime;
    function AdrockStrToDateTime(WorkDate : String) : TDateTime;
    function AdrockStrToTime(WorkDate : String) : TDateTime;

function AdrockDateToStr(WorkDate : TDateTime) : String;

    Function IsValidDate(WorkDate : String) : Boolean;
    Function IsLeapyear(WorkDate : TDateTime) : Boolean;
    function IsLeapYeari(aYear : Integer) : Boolean;
    Function IsDateInRange(WorkDate, StartDate, EndDate : TDateTime) : Boolean;

Function FormatDate(FormatMask : String; WorkDate : TDateTime) : String;

Function AddTime(fDateTime : TDateTime; Hours, Minutes, Seconds : longint) : TDateTime;
Procedure TimeDiff(fDateTime1, fDateTime2 : TDateTime; var Hours, Mins, Secs : longint);

Function ReturnDateOrdinalDayOfWeek(StartOfMonth : Boolean; Week, WeekDay, Month, Year : Integer) : TDateTime;

    Function ReturnFirstAndLastOfAGivenWeek(WeekStart : TAdrockWeekDay; WeekNumberStyle : TAdrockWeekStyle;
        WeekNumber, Year : Integer; var FirstDate, LastDate : TDateTime): Boolean;
    Function ReturnFirstOfAGivenWeek(WeekStart : TAdrockWeekDay; WeekNumberStyle : TAdrockWeekStyle;
        WeekNumber, Year : Integer): TDateTime;
    Function ReturnLastOfAGivenWeek(WeekStart : TAdrockWeekDay; WeekNumberStyle : TAdrockWeekStyle;
        WeekNumber, Year : Integer): TDateTime;

Function ReturnFirstOfAWeek(StartingDayOfWeek: Integer; WorkDate : TDateTime) : TDateTime;
Function ReturnLastOfAWeek(StartingDayOfWeek: Integer; WorkDate : TDateTime) : TDateTime;

Function ReturnLastOfGivenMonth(ADate: TDateTime) : TDateTime;
Function ReturnFirstOfGivenMonth(ADate: TDateTime) : TDateTime;

Function ReturnFirstOfTheWeek : TDateTime;
Function ReturnLastOfTheWeek : TDateTime;

    Function ReturnFirstOfTheMonth : TDateTime;
    Function ReturnLastOfTheMonth : TDateTime;
    Function ReturnFirstOfTheYear : TDateTime;
    Function ReturnLastOfTheYear : TDateTime;

    Function ReturnFirstOfNextWeek : TDateTime;
    Function ReturnLastOfNextWeek : TDateTime;
    Function ReturnFirstOfLastWeek : TDateTime;
    Function ReturnLastOfLastWeek : TDateTime;
    Function ReturnFirstOfLastMonth : TDateTime;
    Function ReturnLastOfLastMonth : TDateTime;
    Function ReturnFirstOfNextMonth : TDateTime;
    Function ReturnLastOfNextMonth : TDateTime;

Function ReturnFirstOfLastYear : TDateTime;
Function ReturnLastOfLastYear : TDateTime;

    Function ReturnFirstOf2MonthsAgo : TDateTime;
    Function ReturnFirstOf3MonthsAgo : TDateTime;
    Function ReturnFirstOf6MonthsAgo : TDateTime;

function IntToDate(WorkDate : Longint) : TDateTime;
function DateToInt(WorkDate : TDateTime) : Longint;

Function IsWeekend(WorkDate : TDateTime) : Boolean;
Function IsWeekday(WorkDate : TDateTime) : Boolean;

Function IsMidday(WorkDate : TDateTime) : Boolean;
Function IsMidNight(WorkDate : TDateTime) : Boolean;

    Function IsChristmasDay(WorkDate : TDateTime) : Boolean;
    Function IsNewYearsDay (WorkDate : TDateTime) : Boolean;
    Function IsEasterSunday(WorkDate : TDateTime) : Boolean;

Function IsFirstOfTheMonth(WorkDate : TDateTime) : Boolean;
Function IsLastOfTheMonth(WorkDate : TDateTime) : Boolean;

    Function IsBusinessDay(WorkDate : TDateTime) : Boolean;
    function IsDateInPosNegRange(WorkDate, CompareDate : TDateTime; PositiveDays, NegativeDays : Integer) : Boolean;
    function IsDateInPosNegBusinessRange(WorkDate, CompareDate : TDateTime; PositiveDays, NegativeDays : Integer) : Boolean;
    Function AddBusinessDays(NumberOfDays : Integer; WorkDate :TDateTime) : TDateTime;

    Function IsHoliday(WorkDate : TDateTime) : Boolean;
    Function IsBusinessHoliday(WorkDate : TDateTime) : Boolean;
    Procedure SetHolidayStringList(NewHolidayStringList : TStrings);

{ Added in V1.20 }
Function IsEmptyDate(WorkDate : String) : Boolean;

    { Added in V1.30 }
    { Please refer to the HISTORY file why these functions have been removed }
    Procedure SetSystemTime(Hour, Minute, Second, Hundreths : Byte);
    Procedure SetSystemDate(Year : Word; Month, Day : Byte);

    { Added in V1.40 }
    Function SecondsBetweenDates(fStartDateTime, fEndDateTime : TDateTime) : Longint;
    Function DecodeTextDate(DateFormatStr, DateStr : String) : TDateTime;

Function ConvertDayOfWeekToInt(DayOfWeek : TadrockDayOfWeek) : Integer;
Function ConvertIntToDayOfWeek(DayOfWeek : Integer) : TAdrockDayofWeek;

    Procedure ReturnYearsMonthsDaysBetweenDates(FirstDate, LastDate : TDateTime; var Negative : Boolean;
                var fYear, fMonth, fDay : Word);
    Function FillandFormatDates(UseColor : Boolean; Color1, Color2 : TColor; EndStr : String;
                fYear, fMonth, fDay : Word) : String;

Function MailDateToDateTime(MailDateTimeString : string; var DateTime : TDateTime; var TimeZone : string) : Boolean;

    Function ConvertToJuliani(Year, Month, Day : Word) : Longint;
    Function ConvertToJulian(Date : TDateTIme) : Longint;
    Function ConvertFromJulian(Julian : Longint) : TDateTime;
    Function ReturnDateOrder : TDateOrder;

Function GetDefaultStartDayOfWeek : TAdrockWeekDay;
Function GetDefaultWeek1 : TAdrockWeekStyle;

Procedure SetDefaultStartDayOfWeek(StartDay : TAdrockWeekDay);
Procedure SetDefaultWeek1(Week1 : TAdrockWeekStyle);