Some useful date calculation routines (Views: 31)
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; |