Vb, Delphi, .net, framework, C++, Java, Pascal,Visual Studio, Asm, Ruby, C#, j#, Cs, Html, Php, Perl, Asp, xHtml Get Free Souce Code Here...



Get the next day of the month

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 <= bDayOfWeek //The day we want is still yet to come
    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 <= DaysPerMonth(AYear, AMonth))
    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.

0 comments:

Post a Comment