 Mirror

Some useful date calculation routines (Views: 100)

 Problem/Question/Abstract:Some useful date calculation routinesAnswer: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 questionMonth           : Month in questionRelativeFactor  : 1 = First; 2 = Second; 3 = Third; 4 = Fourth; 5 = LastDay             : 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;

<< Back to main page