'-------------------------------------------------------------------------------- ' Globals '-------------------------------------------------------------------------------- GLOBAL shortWeekDay() AS STRING ' (1 TO 7) : e.g. Mon, Tue, Wed... GLOBAL longWeekDay() AS STRING ' (1 TO 7) : e.g. Monday, Tuesday... GLOBAL shortMonthName() AS STRING ' (1 TO 12) : e.g. JAN, FEB, MAR... GLOBAL longMonthName() AS STRING ' (1 TO 12) : e.g. January, February... '-------------------------------------------------------------------------------- '-------------------------------------------------------------------------------- ' Function DateStr returns a date according to a format string '-------------------------------------------------------------------------------- ' w short weekday name (3 characters) e.g. Mon, Tue, Wed... ' wd full weekday name e.g. Monday, Tuesday... ' wn week number ' d short day number (1 or 2 digits) ' dd long day number (2 digits, prefixed with '0') ' dn day number in the week (Mon=1..Sun=7) ' m short month number (1 or 2 digits) ' mm long month number (2 digits, prefixed with '0') ' M short month name (3 characters) e.g. JAN, FEB, MAR... ' MM long month name e.g. January, February... ' yy short year number (2 digits) ' yyyy long year number (4 digits) '-------------------------------------------------------------------------------- FUNCTION DateStr(BYVAL year AS LONG, _ BYVAL month AS LONG, _ BYVAL day AS LONG, _ BYVAL format AS STRING) AS STRING LOCAL i, j, k AS LONG LOCAL wn, dow AS LONG LOCAL r AS STRING REDIM PRESERVE shortWeekDay(1 TO 7) REDIM PRESERVE longWeekDay(1 TO 7) REDIM PRESERVE shortMonthName(1 TO 12) REDIM PRESERVE longMonthName(1 TO 12) IF shortWeekDay(1) = "" THEN ARRAY ASSIGN shortWeekDay() _ = "lun", "mar", "mer", "jeu", "ven", "sam", "dim" IF longWeekDay(1) = "" THEN ARRAY ASSIGN longWeekDay() _ = "lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche" IF shortMonthName(1) = "" THEN ARRAY ASSIGN shortMonthName() _ = "JAN", "FEV", "MAR", "AVR", "MAI", "JUN", "JUL", "AOU", "SEP", "OCT", "NOV", "DEC" IF longMonthName(1) = "" THEN ARRAY ASSIGN longMonthName() _ = "janvier", "février", "mars", "avril", "mai", "juin", "juillet", _ "août", "septembre", "octobre", "novembre", "décembre" wn = WeekNb(year, month, day) dow = DayOfWeek(year, month, day) ' Protect keywords with curled braces r = format REPLACE "wn" WITH "{WN}" IN r ' week number REPLACE "wd" WITH "{LW}" IN r ' long weekday REPLACE "w" WITH "{SW}" IN r ' short weekday REPLACE "dd" WITH "{LD}" IN r ' long day number REPLACE "dn" WITH "{DN}" IN r ' day number in the week REPLACE "d" WITH "{SD}" IN r ' short day number REPLACE "mm" WITH "{L#}" IN r ' long month number REPLACE "m" WITH "{S#}" IN r ' short month number REPLACE "MM" WITH "{LO}" IN r ' long month name REPLACE "M" WITH "{SH}" IN r ' short month name REPLACE "yyyy" WITH "{Y4}" IN r ' year on 4 digits REPLACE "YYYY" WITH "{Y4}" IN r ' be a little permissive: YYYY=yyyy REPLACE "yy" WITH "{Y2}" IN r ' year on 2 digits REPLACE "YY" WITH "{Y2}" IN r ' be a little permissive: YY=yy ' Now, replace protected keywords with their values REPLACE "{WN}" WITH TRIM$(STR$(wn)) IN r REPLACE "{LW}" WITH longWeekDay(dow) IN r REPLACE "{SW}" WITH shortWeekDay(dow) IN r REPLACE "{LD}" WITH FORMAT$(day, "00") IN r REPLACE "{DN}" WITH FORMAT$(dow, "0") IN r REPLACE "{SD}" WITH TRIM$(STR$(day)) IN r REPLACE "{L#}" WITH FORMAT$(month, "00") IN r REPLACE "{S#}" WITH TRIM$(STR$(month)) IN r REPLACE "{LO}" WITH longMonthName(month) IN r REPLACE "{SH}" WITH shortMonthName(month) IN r REPLACE "{Y4}" WITH TRIM$(STR$(year)) IN r REPLACE "{Y2}" WITH RIGHT$(TRIM$(STR$(year)), 2) IN r FUNCTION = r END FUNCTION '-------------------------------------------------------------------------------- '-------------------------------------------------------------------------------- ' Function Julian - returns Julian Day Number (JDN) ' Actually it counts days elapsed since "11/25/-4713" (= Nov. 25, 4714 BCE) '-------------------------------------------------------------------------------- FUNCTION Julian(BYVAL year AS LONG, _ BYVAL month AS LONG, _ BYVAL day AS LONG) AS LONG LOCAL Days AS LONG, yearsBC AS LONG, yearsAD AS LONG IF month < 3 THEN ' January or February? month = month + 12 ' 13th or 14th month .... DECR year ' .... of prev. year END IF yearsBC = 4714 - 1 ' 4713 BC thru 1 BC yearsAD = year - 1 ' 1 AD thru (year of date minus 1) Days = INT((yearsBC + yearsAD) * 365.25) ' calculate days in years Days = Days - (year \ 100) ' substract century leapdays Days = Days + (year \ 400) ' re-add valid ones Days = Days + INT(30.6 * (month - 1) + .2) ' days in months elapsed (+ adjustment) FUNCTION = Days + day ' days in month of date END FUNCTION '-------------------------------------------------------------------------------- '-------------------------------------------------------------------------------- ' Function JulianDayOfWeek returns day of the week (Mon=1..Sun=7) '-------------------------------------------------------------------------------- FUNCTION JulianDayOfWeek(JDN AS LONG) AS BYTE FUNCTION = JDN MOD 7 + 1 END FUNCTION '-------------------------------------------------------------------------------- '-------------------------------------------------------------------------------- ' Function DayOfWeek same than above with different input format '-------------------------------------------------------------------------------- FUNCTION DayOfWeek(BYVAL year AS LONG, _ BYVAL month AS LONG, _ BYVAL day AS LONG) AS BYTE LOCAL JD AS LONG JD = Julian(year, month, day) FUNCTION = JulianDayOfWeek(JD) END FUNCTION '-------------------------------------------------------------------------------- '-------------------------------------------------------------------------------- ' Function WeekOne returns first day of first week for the given year ' Note: This is only a helper function for WeekNbStr '-------------------------------------------------------------------------------- FUNCTION WeekOne(BYVAL year AS LONG) AS LONG LOCAL temp AS LONG, Thursday AS BYTE Thursday = 4 temp = Julian(year,1,1) - 1 ' Dec. 31 of prev. year DO INCR temp LOOP UNTIL JulianDayOfWeek(temp) = Thursday ' until first Thursday of year is found FUNCTION = temp - 3 ' first day of first week is a Monday END FUNCTION '-------------------------------------------------------------------------------- '-------------------------------------------------------------------------------- ' Function WeekNb returns ISO-proof weeknumber for a date '-------------------------------------------------------------------------------- FUNCTION WeekNb(BYVAL year AS LONG, _ BYVAL month AS LONG, _ BYVAL day AS LONG) AS BYTE LOCAL FirstDay AS LONG, FinalDay AS LONG, ToDay AS LONG FirstDay = WeekOne(year) FinalDay = WeekOne(year + 1) - 1 ToDay = Julian(year, month, day) SELECT CASE ToDay CASE < FirstDay ' it is week 52 or 53, but which one? ' therefore we need week one of previous year as a starting point FirstDay = WeekOne(year - 1) CASE > FinalDay ' there is only one possibility: week nbr 1 FUNCTION = 1 EXIT FUNCTION END SELECT FUNCTION = ((ToDay - FirstDay) \ 7) + 1 END FUNCTION '--------------------------------------------------------------------------------