Get a list of dates of specific days in a given date range (Views: 2141)
Problem/Question/Abstract: Can anyone help with a routine that will return a list of dates of specific days in a given date range? For example, I want a list of dates of the third Monday of each month in a given date range. The user will be able to nominate the date range, the day of the week, and which day (i.e. 1st, 2nd, 3rd or 4th). Answer: The procedure to call is ListDates(). The important function is DateInPeriod(). Because of DayOfWeek(), Sunday is WeekDay = 1. Tested briefly. function ValidateWeekDay(const WeekDay: Word): Word; begin Result := WeekDay mod 7; if Result = 0 then Result := 7; end; function DayInMonth(const Year, Month, WeekDay, Nr: Word): Word; var MonthStart, Shift: Word; begin MonthStart := DayOfWeek(EncodeDate(Year, Month, 1)); Shift := ValidateWeekDay(8 + WeekDay - MonthStart); Result := Shift + (7 * (Nr - 1)); end; function DateInPeriod(const Date, FromDate, ToDate: TDate): Boolean; begin Result := (Trunc(Date) >= Trunc(FromDate)) and (Trunc(Date) <= Trunc(ToDate)) end; procedure ListDates(const FromDate, ToDate: TDate; const WeekDay, Nr: Word; const DatesList: TStrings); var Year, Month, Day: Word; Date: TDate; procedure NextMonth; begin if Month = 12 then begin Month := 1; inc(Year); end else inc(Month); end; begin DatesList.Clear; DecodeDate(FromDate, Year, Month, Day); while EncodeDate(Year, Month, 1) <= Trunc(ToDate) do begin Date := EncodeDate(Year, Month, DayInMonth(Year, Month, WeekDay, Nr)); if DateInPeriod(Date, FromDate, ToDate) then DatesList.Add(FormatDateTime(ShortDateFormat, Date)); NextMonth; end; end; |