Mega Code Archive

Calendardates

THREE DIFFERENT EXAMPLES OF CODE TO PLAY WITH CALENDAR DATES (eg first monday in month etc) -THE 2ND AND 3RD EXAMPLES LOOK GOOD. see also Data&Time.txt **************************************************************************** For those who want a shorter Last Day of the Month routine. [Than everything below!] EncodeDate(year, month, MonthDays[IsLeapYear(year), month]); MonthDays and IsLeapYear are defined in SysUtils ***************************************************************************** Here's some code I wrote to find the first, second, third, and fourth Monday of the month. I'm sure you can easily adapt it for other days. var i, vday: integer; vstartdate,vmonday:tdatetime; if CBfreq.text='MONTHLY1' then begin for i:= 1 to 8 do begin vstartdate:=vstartdate-day(vstartdate)+1; vday:=dayofweek(vstartdate); if vday=1 then vmonday:=vstartdate+1; if vday=2 then vmonday:=vstartdate; if vday=3 then vmonday:=vstartdate+6; if vday=4 then vmonday:=vstartdate+5; if vday=5 then vmonday:=vstartdate+4; if vday=6 then vmonday:=vstartdate+3; if vday=7 then vmonday:=vstartdate+2; if vmonday>=date then CBnext.items.add(datetostr(vmonday)); //I populate a combo box with a series of first Mondays vstartdate:=changemonth(vstartdate,1); end; //for end;//monthly if CBfreq.text='MONTHLY2' then begin for i:= 1 to 8 do begin vstartdate:=vstartdate-day(vstartdate)+1; vday:=dayofweek(vstartdate); if vday=1 then vmonday:=vstartdate+1; if vday=2 then vmonday:=vstartdate; if vday=3 then vmonday:=vstartdate+6; if vday=4 then vmonday:=vstartdate+5; if vday=5 then vmonday:=vstartdate+4; if vday=6 then vmonday:=vstartdate+3; if vday=7 then vmonday:=vstartdate+2; vmonday:=vmonday+7; if vmonday>=date then CBnext.items.add(datetostr(vmonday)); vstartdate:=changemonth(vstartdate,1); end; //for end;//monthly 2nd Monday if CBfreq.text='MONTHLY3' then begin vstartdate:=vstartdate-day(vstartdate)+1; for i:= 1 to 8 do begin vday:=dayofweek(vstartdate); if vday=1 then vmonday:=vstartdate+1; if vday=2 then vmonday:=vstartdate; if vday=3 then vmonday:=vstartdate+6; if vday=4 then vmonday:=vstartdate+5; if vday=5 then vmonday:=vstartdate+4; if vday=6 then vmonday:=vstartdate+3; if vday=7 then vmonday:=vstartdate+2; vmonday:=vmonday+14; if vmonday>=date then CBnext.items.add(datetostr(vmonday)); vstartdate:=changemonth(vstartdate,1); end;//for i end;//month3 if CBfreq.text='MONTHLY4' then begin for i:= 1 to 8 do begin vstartdate:=vstartdate-day(vstartdate)+1; vday:=dayofweek(vstartdate); if vday=1 then vmonday:=vstartdate+1; if vday=2 then vmonday:=vstartdate; if vday=3 then vmonday:=vstartdate+6; if vday=4 then vmonday:=vstartdate+5; if vday=5 then vmonday:=vstartdate+4; if vday=6 then vmonday:=vstartdate+3; if vday=7 then vmonday:=vstartdate+2; vmonday:=vmonday+21; if vmonday>=date then CBnext.items.add(datetostr(vmonday)); vstartdate:=changemonth(vstartdate,1); end; //for end;//monthly 4th Monday if CBfreq.text='BI-MONTHLY' then begin for i:= 1 to 8 do begin vstartdate:=vstartdate-day(vstartdate)+1; vday:=dayofweek(vstartdate); if vday=1 then vmonday:=vstartdate+1; if vday=2 then vmonday:=vstartdate; if vday=3 then vmonday:=vstartdate+6; if vday=4 then vmonday:=vstartdate+5; if vday=5 then vmonday:=vstartdate+4; if vday=6 then vmonday:=vstartdate+3; if vday=7 then vmonday:=vstartdate+2; if vmonday>=date then CBnext.items.add(datetostr(vmonday)); vstartdate:=changemonth(vstartdate,2); end; //for end;//bi-monthly if CBfreq.text='TRI-MONTHLY' then begin for i:= 1 to 8 do begin vstartdate:=vstartdate-day(vstartdate)+1; vday:=dayofweek(vstartdate); if vday=1 then vmonday:=vstartdate+1; if vday=2 then vmonday:=vstartdate; if vday=3 then vmonday:=vstartdate+6; if vday=4 then vmonday:=vstartdate+5; if vday=5 then vmonday:=vstartdate+4; if vday=6 then vmonday:=vstartdate+3; if vday=7 then vmonday:=vstartdate+2; if vmonday>=date then CBnext.items.add(datetostr(vmonday)); vstartdate:=changemonth(vstartdate,3); end; //for end;//tri-monthly end; //if _______________________________________________ Delphi mailing list -> Delphi@elists.org http://www.elists.org/mailman/listinfo/delphi ****************************************************************************** The following is from our ESBPCS: type TESBDOMType = (domFirst, domSecond, domThird, domFourth, domLast); {: Returns the Given Occurrence (Day of Month) of a Day of Week in a given Month/Year. Thus can be used to find the first Wednesday, Last Monday, etc. DOMType can be one of the following: domFirst - First occurrence in a Month. domSecond - Second occurrence in a Month. domThird - Third occurrence in a Month. domFourth - Fourth occurrence in a Month. domLast - Last occurrence in a Month. @param DOMType the desired Day of Month Type. @param DOW the Day of Week, 1 = Sunday, 7 = Saturady. @param Month the month of the year, 1 = Jan, 12 = Dec. @param Year 4-digit year such as 1999. @returns the Date uniquely defined by the above. @cat DTMath @cat MonthMath } function DayOfMonth2Date (const DOMType: TESBDOMType; const DOW: Byte; const Month, Year: Word): TDateTime; var Ofs: Integer; DT: TDateTime; begin if DOMType < domLast then begin DT := GetFirstDayOfMonth (Month, Year); Ofs := DOW - DayOfWeek (DT); if Ofs < 0 then Ofs := Ofs + 7; Result := DT + Ofs + 7 * Integer (DOMType); end else begin DT := GetLastDayOfMonth (Month, Year); Ofs := DayofWeek (DT) - DOW; if Ofs < 0 then Ofs := Ofs + 7; Result := DT - Ofs; end; end; You will need routines to return the First and Last Days of the Month/Year for the above... You may also want to check out our FREE ESBDates which also includes GPTimeZone which includes another way of doing the above :) HTH Glenn Crouch mailto:glenn@esbconsult.com.au ICQ:36017076 ESB Consultancy, http://www.esbconsult.com.au Home of ESBPCS, ESBStats, ESBPDF Analysis & ESBCalc Kalgoorlie-Boulder, Western Australia (TeamND, TeamOE, Addict Support, eLists.org Management) ******************************************************************************** unit RelDate; interface uses Controls; type TDayOfWeek = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday); function RelativeDate(Date: TDate; WeekDay: TDayOfWeek; Which: integer): TDate; implementation uses SysUtils; function FindDay(Date: TDate; WeekDay: TDayOfWeek; Delta: integer): TDate; var Count: longint; begin Count := Trunc(Date) + Delta; Result := (Count - ((Count - Ord(WeekDay) + 6) mod 7)) * 1.0; end; function RelativeDate(Date: TDate; WeekDay: TDayOfWeek; Which: integer): TDate; {e.g. RelativeDate(Now, Wednesday, 1) will find the first Wednesday in the current month RelativeDate(Now, Sunday, -1) will find the last Sunday in the current month RelativeDate(Now, Monday, -2) will find the penultimate Monday in the current month } var Year, Month, Day: word; Count: longint; Delta: shortint; begin DecodeDate(Date, Year, Month, Day); if Which > 0 then begin Count := Trunc(Date) - Day + 7; Delta := -1; end else begin Count := Trunc(Date) - Day + MonthDays[IsLeapYear(Year), Month]; Delta := 1; end; Result := (FindDay(Count * 1.0, WeekDay, 0) + ((Which + Delta) * 7)) * 1.0; end; end. Regards, Russell Hewitt *************************************************************************** Glenn Crouch - ESB wrote: > > function GetLastDayOfMonth(Mo, Yr: Word): TDateTime; > > begin > > // find first day of subsequent month and subtract a day > > Result := EncodeDate(Yr, Mo + 1, 1) - 1.0; > > end; > > Not good option for December (Mo = 12) ... But basically yes :) Ooops, good point, seems like I always miss those wrap-around situations, how about: function GetLastDayOfMonth(Mo, Yr: Word): TDateTime; var TempYr, TempMo: Word; begin // find first day of subsequent month and subtract a day TempYr := Yr; TempMo := Mo + 1; if TempMo = 13 then begin // Whoa Nellie, next month is next year! TempMo := 1; // January Inc(TempYr); // subsequent year end; Result := EncodeDate(TempYr, TempMo, 1) - 1.0; end; Thanks for catching that! ;-) Of course an even more robust solution would check that Mo was in the range 1..12 to begin with, which I haven't done. What is a sensible "bad date" value to return on an error like that? Since TDateTime is a type alias for an IEEE double, one could use NaN I guess? Stephen Posey slposey@concentric.net ******************************************************* Glenn Crouch - ESB wrote: > > The following is from our ESBPCS: Interesting, I note that your definition only implicitly includes the fifth occurence of a day via the domLast value; there's no way to explicitly ask for the 5th occurence and perhaps get some kind of exception or an error value back indicating that it doesn't exist, you'd have to ask for both domFourth and domLast and check whether they were the same. E.g. for January 2001: DayOfMonth2Date(domFourth, 4, 1, 2001) will return Jan. 24 DayOfMonth2Date(domLast, 4, 1, 2001) will return Jan. 31 but DayOfMonth2Date(domFourth, 5, 1, 2001) and DayOfMonth2Date(domLast, 5, 1, 2001) will both return Jan. 25 > type > TESBDOMType = (domFirst, domSecond, domThird, domFourth, domLast); > > {: Returns the Given Occurrence (Day of Month) of a Day of Week in a given > Month/Year. Thus can be used to find the first Wednesday, Last Monday, > etc. DOMType can be one of the following: > domFirst - First occurrence in a Month. > domSecond - Second occurrence in a Month. > domThird - Third occurrence in a Month. > domFourth - Fourth occurrence in a Month. > domLast - Last occurrence in a Month. > > @param DOMType the desired Day of Month Type. > @param DOW the Day of Week, 1 = Sunday, 7 = Saturady. > @param Month the month of the year, 1 = Jan, 12 = Dec. > @param Year 4-digit year such as 1999. > @returns the Date uniquely defined by the above. > @cat DTMath > @cat MonthMath > } > function DayOfMonth2Date (const DOMType: TESBDOMType; const DOW: Byte; > const Month, Year: Word): TDateTime; > var > Ofs: Integer; > DT: TDateTime; > begin > if DOMType < domLast then > begin > DT := GetFirstDayOfMonth (Month, Year); > Ofs := DOW - DayOfWeek (DT); > if Ofs < 0 then > Ofs := Ofs + 7; > Result := DT + Ofs + 7 * Integer (DOMType); > end > else > begin > DT := GetLastDayOfMonth (Month, Year); > Ofs := DayofWeek (DT) - DOW; > if Ofs < 0 then > Ofs := Ofs + 7; > Result := DT - Ofs; > end; > end; Hmmmm, is all the ESB code formatted like this? Or is what I'm seeing an artifact of tab conversion in the Email stream somewhere? > You will need routines to return the First and Last Days of the Month/Year > for the above... That's easy enough: function GetFirstDayOfMonth(Mo, Yr: Word): TDateTime; begin // find first day of month Result := EncodeDate(Yr, Mo, 1); end; function GetLastDayOfMonth(Mo, Yr: Word): TDateTime; begin // find first day of subsequent month and subtract a day Result := EncodeDate(Yr, Mo + 1, 1) - 1.0; end;