Some useful date calculation routines

Problem/Question/Abstract:

Some useful date calculation routines

Answer:

Ever notice how some date routines are missing from SysUtils? Well as they say, necessity is the mother of invention, I've come up with some date calculation routines that you can include in your own programs that require some date calculations. If you've got any more than this, please feel free to share them!

type
  TDatePart = (dpYear, dpMonth, dpDay);

  {Purpose  : Return a date part.}

function GetDatePart(Date: TDateTime; DatePart: TDatePart): Word;
var
  D, M, Y: Word;
begin
  //Initialize Result - avoids compiler warning
  Result := 0;
  DecodeDate(Date, Y, M, D);
  case DatePart of
    dpYear: Result := Y;
    dpMonth: Result := M;
    dpDay: Result := D;
  end;
end;

{Purpose  : Extracts the date portion of a date time. Useful for
            seeing if two date time values fall on the same day}

function ExtractDatePart(Date: TDateTime): TDate;
begin
  Result := Int(Date);
end;

{Purpose  : Gets the time portion of a date time. Like ExtractDatePart
            this is useful for comparing times.}

function ExtractTimePart(Date: TDateTime): TTime;
begin
  Result := Frac(Date);
end;

{Purpose  : Used for determining whether or not a DateTime is
            a weekday.}

function IsWeekday(Day: TDateTime): Boolean;
begin
  Result := (DayOfWeek(Day) >= 2) and (DayOfWeek(Day) <= 6);
end;

{Purpose  :  Function returns the date of the relative day of a
             month/year combo such as the date of the "Third
             Monday of January." The formal parameters depart a bit
             from the MS SQL Server Schedule agent constants in that
             the RelativeFactor parameter (Freq_Relative_Interval in
             MS-SQL), takes integer values from 1 to 5 as opposed to
             integer values from 2 to the 0th to 2 to the 4th power.

Formal Parameters
======================================================================================
Year            : Year in question
Month           : Month in question
RelativeFactor  : 1 = First; 2 = Second; 3 = Third; 4 = Fourth; 5 = Last
Day             : 1 - 7, day starting on Sunday; 8 = Day;
                  9 = Weekday; 10 = Weekend Day
}

function GetRelativeDate(Year, Month,
  RelativeFactor, Day: Integer): TDateTime;
var
  TempDate: TDateTime;
  DayIndex: Integer;
begin
  TempDate := EncodeDate(Year, Month, 1);
  DayIndex := 0;
  //Now, if you're looking for the last day, just go to the last
  //day of the month, and count backwards until you hit the day
  //you're interested in.
  if (RelativeFactor = 5) then
  begin
    TempDate := EncodeDate(Year, Month, MonthDays[IsLeapYear(Year), Month]);
    case Day of
      1..7:
        if (DayOfWeek(TempDate) = Day) then
          Result := TempDate
        else
        begin
          while (DayOfWeek(TempDate) <> Day) do
            TempDate := TempDate - 1;
          Result := TempDate;
        end;
      9:
        begin
          if IsWeekday(TempDate) then
            Result := TempDate
          else
          begin
            while not IsWeekday(TempDate) do
              TempDate := TempDate - 1;
            Result := TempDate;
          end;
        end;
      10:
        begin
          if not IsWeekday(TempDate) then
            Result := TempDate
          else
          begin
            while IsWeekday(TempDate) do
              TempDate := TempDate - 1;
            Result := TempDate;
          end;
        end;
    else
      //This only happens if you're going after the very last day of the month
      Result := TempDate;
    end;
  end
  else
    //Otherwise, you have to go through the month day by day until you get
    //to the day you want. Since the relative week is a power of 2, just
    //see if the day exponent is a
    case Day of
      1..7:
        begin
          while (DayIndex < RelativeFactor) do
          begin
            if (DayOfWeek(TempDate) = Day) then
              Inc(DayIndex);
            TempDate := TempDate + 1;
          end;
          Result := TempDate - 1;
        end;
      9:
        begin
          while (DayIndex < RelativeFactor) do
          begin
            if IsWeekDay(TempDate) then
              Inc(DayIndex);
            TempDate := TempDate + 1;
          end;
          Result := TempDate - 1;
        end;
      10:
        begin
          while (DayIndex < RelativeFactor) do
          begin
            if not IsWeekDay(TempDate) then
              Inc(DayIndex);
            TempDate := TempDate + 1;
          end;
          Result := TempDate - 1;
        end;
    else
      Result := TempDate + RelativeFactor;
    end;
end;

type
  TDecimalTimeType = (dtSecond, dtMinute, dtHour);

  {Purpose  : Returns hours, minutes, or seconds in decimal format for use
              in date time calculations}

function GetDecimalTime(Count: Integer;
  DecimalTimeType: TDecimalTimeType): Double;
const
  Second = 1 / 86400;
  Minute = 1 / 1440;
  Hour = 1 / 24;
begin
  //Initialize result
  Result := 0;
  case DecimalTimeType of
    dtSecond: Result := Count * Second;
    dtMinute: Result := Count * Minute;
    dtHour: Result := Count * Hour;
  end;
end;

{Purpose  : Converts a MS-style integer time to a TTime}

function IntTimeToTime(Time: Integer): TTime;
var
  S: string;
begin
  S := IntToStr(Time);
  //String must be 5 or 6 character long
  if (Length(S) < 5) or (Length(S) > 6) then
    Result := 0
  else
  begin
    if (Length(S) = 5) then //A morning time
      S := Copy(S, 1, 1) + ':' + Copy(S, 2, 2) + ':' + Copy(S, 4, 2)
    else //Afternoon, evening time
      S := Copy(S, 1, 2) + ':' + Copy(S, 3, 2) + ':' + Copy(S, 5, 2);
    Result := StrToTime(S);
  end;
end;