Mega Code Archive
Get the next day of the month
<![CDATA[
Title: Get the next day of the month
Question: If you need to know when is the second sunday, last monday, first friday or any other variation for a given month then this function might help you.
Answer:
NOTE: You need do add the unit "DateUtils" to the uses clause (where DayOfTheWeek is declared).
//----------------------------------------------------------------
type
TWeeks = (wFirst, wSecond, wThird, wFourth, wLast);
TWeekDays = (wdMonday, wdTuesday, wdWednesday, wdThursday,
wdFriday, wdSaturday, wdSunday);
//Examples:
//ShowMessage(DateTimeToStr(GetDayOfMonth(Now, wLast, wdTuesday)));
//ShowMessage(DateTimeToStr(GetDayOfMonth(Now, wFirst, wdSunday)));
function DaysPerMonth(AYear, AMonth: Integer): Integer;
const
DaysInMonth: array[1..12] of Integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysInMonth[AMonth];
if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;
function GetDayOfMonth(DT: TDateTime; Weeks: TWeeks; WeekDays: TWeekDays): TDateTime;
var
aDateTime: TDateTime;
aDayOfWeek, bDayOfWeek: Word;
AYear, AMonth, ADay: Word;
begin
DecodeDate(DT, AYear, AMonth, ADay);
aDateTime := EncodeDate(AYear, AMonth, 1); //Returns the 1st day of the month
//-DayOfTheWeek-
//1 - Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, 7 - Sunday
aDayOfWeek := DayOfTheWeek(aDateTime);
//-WeekDays-
//0 - Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, 6 - Sunday
bDayOfWeek := Ord(WeekDays) +1;
if aDayOfWeek then ADay := (bDayOfWeek - aDayOfWeek)
else ADay := 7 - (aDayOfWeek - bDayOfWeek);
//-Weeks-
//0 - first, 1 - second, 2 - third, 3 - fourth, 4 - last
ADay := ADay + Ord(Weeks) * 7;
if Ord(Weeks) = 4 then
if (ADay+1 DaysPerMonth(AYear, AMonth))
or ( (ADay+1 and (bDayOfWeek DayOfTheWeek(EncodeDate(AYear, AMonth, ADay+1))) )
then ADay := ADay - 7;
Result := aDateTime + ADay;
end;
//----------------------------------------------------------------
I'm sure there are better ways to deal with this problem so please let me know if you happen to know any.
]]>