Author: Tomas Rutkauskas
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.
1
2 function ValidateWeekDay(const WeekDay: Word): Word;
3 begin
4 Result := WeekDay mod 7;
5 if Result = 0 then
6 Result := 7;
7 end;
8
9 function DayInMonth(const Year, Month, WeekDay, Nr: Word): Word;
10 var
11 MonthStart, Shift: Word;
12 begin
13 MonthStart := DayOfWeek(EncodeDate(Year, Month, 1));
14 Shift := ValidateWeekDay(8 + WeekDay - MonthStart);
15 Result := Shift + (7 * (Nr - 1));
16 end;
17
18 function DateInPeriod(const Date, FromDate, ToDate: TDate): Boolean;
19 begin
20 Result := (Trunc(Date) >= Trunc(FromDate)) and (Trunc(Date) <= Trunc(ToDate))
21 end;
22
23 procedure ListDates(const FromDate, ToDate: TDate; const WeekDay, Nr: Word;
24 const DatesList: TStrings);
25 var
26 Year, Month, Day: Word;
27 Date: TDate;
28
29 procedure NextMonth;
30 begin
31 if Month = 12 then
32 begin
33 Month := 1;
34 inc(Year);
35 end
36 else
37 inc(Month);
38 end;
39
40 begin
41 DatesList.Clear;
42 DecodeDate(FromDate, Year, Month, Day);
43 while EncodeDate(Year, Month, 1) <= Trunc(ToDate) do
44 begin
45 Date := EncodeDate(Year, Month, DayInMonth(Year, Month, WeekDay, Nr));
46 if DateInPeriod(Date, FromDate, ToDate) then
47 DatesList.Add(FormatDateTime(ShortDateFormat, Date));
48 NextMonth;
49 end;
50 end;
|