Get a list of dates of specific days in a given date range

Mirror

Get a list of dates of specific days in a given date range (Views: 711)

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;

<< Back to main page