The functions in this module are cross-platform and compatible with PureBasic's built-in Date functions. They are using Quad values for representing the date.
The module provides
- Replacements for functions of PureBasic's Date library. These functions have the same names as the original ones, with "Q" appended to the name.
Besides extended date range, some of the functions in this module are more flexible or powerful than the original ones:- DateQ() can be called without any parameter of course, but it can also be called e.g. like this:
Debug DateQ(year, month, day)
while with the original PB function we have to write in this case
Debug Date(year, month, day, 0, 0, 0) - DayOfWeekQ() provides an optional parameter that allows you to get a result according to the ISO standard.
- In all functions that take a weekday as parameter, Sunday can be given as 0 (compliant with PB's date functions) or as 7 (according to ISO).
- FormatDateQ() supports additional tokens in the mask string, and also will show the current date and time when it's called without any parameter.
- DateQ() can be called without any parameter of course, but it can also be called e.g. like this:
- Additional functions and macros such as WeekNumber(), LocalizedDayName(), Easter() etc. that are useful for date calculations (see lower part of the 'DeclareModule' section)
- dates of the proleptic Julian calendar: from 0001-01-01 00:00:00 to 32767-12-31 23:59:59;
default range is from 0001-01-01 00:00:00 to 1582-10-04 23:59:59
(see <https://en.wikipedia.org/wiki/Proleptic_Julian_calendar>) - dates of the Gregorian calendar*: from 1582-10-15 00:00:00 to 32767-12-31 23:59:59
- Julian dates (not to be confused with the Julian calendar)
*) Only a few catholic countries such as Spain and Portugal actually adopted the Gregorian calendar on Thursday, October 4, 1582 (it was then followed by Friday, October 15, 1582). Most of the catholic countries of Europe followed in the next few years, while many non-catholic countries initially rejected the new calendar. Handling the dates when the Gregorian calendar was introduced in which country is beyond the scope of this contribution. However, in the date range from 1582-10-15 00:00:00 to 32767-12-31 23:59:59, you can choose yourself whether you use the Julian or the Gregorian calendar for your calculations.
Code: Select all
; -- A module with extended date functions
; <https://www.purebasic.fr/english/viewtopic.php?t=81956>
; Version 2.01, 2024-03-03
; cross-platform, successfully tested with
; [v] PB 5.73 LTS (x64) on Windows 11 – ASM backend
; [v] PB 6.04 LTS (x64) on Linux Mint 20.3 – both ASM and C backend (with and without code optimization)
; [v] PB 6.04 LTS (x64) on Windows 11 – both ASM and C backend (with and without code optimization)
; [v] PB 6.04 LTS (x86) on Windows 11 – both ASM and C backend (with and without code optimization)
; The functions in this module are compatible with PureBasic's built-in Date
; functions. They are using Quad values for representing the date.
; The module provides
; - replacements for functions of PureBasic's Date library. These functions
; have the same names as the original ones, with "Q" appended to the name.
; - additional functions such as WeekNumber(), LocalizedDayName(), Easter() etc.
;
; The module can handle
; - dates of the proleptic Julian calendar: from 0001-01-01 00:00:00 to 32767-12-31 23:59:59;
; default range is from 0001-01-01 00:00:00 to 1582-10-04 23:59:59
; (see <https://en.wikipedia.org/wiki/Proleptic_Julian_calendar>)
; - dates of the Gregorian calendar: from 1582-10-15 00:00:00 to 32767-12-31 23:59:59
; - Julian dates (not to be confused with the Julian calendar)
; Note: For the Assert() macro to work, the file "PureUnit.res" in PureBasic's
; "Sdk\PureUnit" subdirectory must be moved to the "Residents" subdirectory.
; ------------------------------------------------------------------------------
; MIT License
;
; Copyright (c) 2024 Jürgen Lüthje <https://luethje.eu/>
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
; ------------------------------------------------------------------------------
CompilerIf #PB_Compiler_Version = 573 And #PB_Compiler_Processor = #PB_Processor_x86
CompilerError "Bug in PB 5.73 LTS. With this version, use the x64 compiler"
CompilerEndIf
CompilerIf #PB_Compiler_Version >= 600 And #PB_Compiler_Version <= 602
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86 And #PB_Compiler_Backend = #PB_Backend_C
CompilerError "Bug e.g. in PB 6.02 LTS. With the x86 compiler, use the ASM backend"
CompilerEndIf
CompilerEndIf
DeclareModule DateEx
;-- Constants
#SECONDS_PER_MINUTE = 60
#SECONDS_PER_HOUR = 3600
#SECONDS_PER_DAY = 86400
#SECONDS_PER_WEEK = 604800
; Weekdays
Enumeration
#SundayPB
#Monday
#Tuesday
#Wednesday
#Thursday
#Friday
#Saturday
#SundayISO
EndEnumeration
; Calendar systems
Enumeration
#Default
#Julian
#Gregorian
EndEnumeration
; Constants for Period2Str()
#PS_en$ = " year,s, month,s, week,s, day,s, hour,s, minute,s, second,s"
#PS_de$ = " Jahr,e, Monat,e, Woche,n, Tag,e, Stunde,n, Minute,n, Sekunde,n"
; Codes returned by DateError()
Enumeration 1
#Err_SplitDate
#Err_LocalTime
#Err_OutdatedPBversion
#Err_DateOutOfBounds
#Err_CalendarSystem
#Err_DateType
#Err_ParseDate
#Err_YearOutOfBounds
#Err_LeapDay
#Err_DaysInMonth
#Err_DayName
#Err_MonthName
#Err_NullPointer
#Err_NegativePeriod
#Err_DateDiff
#Err_TimeUnits
#Err_NegativeTime
#Err_WeekDay
#Err_WeekDayInMonth
#Err_Easter
#Err_JulianDateOutOfBounds
EndEnumeration
#NODATE = -70000000000 ; impossible date value (for internal use only)
;-- Structures
Structure Period
years.q
months.q
weeks.q
days.q
hours.q
minutes.q
seconds.q
EndStructure
;-- Replacements for built-in PureBasic functions
Declare.q DateQ (year.i=-1, month.i=1, day.i=1, hour.i=0, min.i=0, sec.i=0, calendar.i=#Default)
Declare.q AddDateQ (date.q, type.i, value.q, calendar.i=#Default)
Declare.i DayOfWeekQ (date.q, ISO.i=#False)
Declare.i DayOfYearQ (date.q, calendar.i=#Default)
Declare.i YearQ (date.q, calendar.i=#Default)
Declare.i MonthQ (date.q, calendar.i=#Default)
Declare.i DayQ (date.q, calendar.i=#Default)
Declare.i HourQ (date.q)
Declare.i MinuteQ (date.q)
Declare.i SecondQ (date.q)
Declare.s FormatDateQ (mask$="%yyyy-%mm-%dd %hh:%ii:%ss", date.q=#NODATE, calendar.i=#Default)
Declare.q ParseDateQ (mask$, date$, calendar.i=#Default, strict=#False)
;-- Additional macros and functions
Macro Today ()
; out: current local date at time 00:00:00 in PureBasic format
(IntQ(DateEx::DateQ() / DateEx::#SECONDS_PER_DAY) * DateEx::#SECONDS_PER_DAY)
EndMacro
Macro LastDayInMonth (_year_, _month_, _calendar_=#Default)
; out: corresponding date in PureBasic format
DateEx::AddDateQ(DateEx::DateQ(_year_,_month_,1, 0,0,0, _calendar_), #PB_Date_Day, DateEx::DaysInMonth(_year_, _month_, _calendar_)-1, _calendar_)
EndMacro
Declare.i LeapDay (year.i, calendar.i=#Default)
Declare.i DaysInMonth (year.i, month.i, calendar.i=#Default)
Declare.i WeekNumber (date.q)
Declare.s LocalizedDayName (weekday.i, short.i=#False)
Declare.s LocalizedMonthName (MonthOfYear.i, short.i=#False)
Declare.q UTC ()
Declare.i TimeZone ()
Declare.s TimeZoneStr ()
Declare.q DateDiff (startTime.q, endTime.q, *p.Period, calendar.i=#Default)
Declare.s Period2Str (*p.Period, units$=#PS_en$)
Declare.q nth_WeekDay (weekday.i, dayNo.i, date.q)
Declare.q nth_WeekDay_InMonth (weekday.i, dayNo.i, year.i, month.i, calendar.i=#Default)
Declare.q Easter (year.i, calendar.i=#Default)
Declare.q BlackFriday (year.i)
Declare.q Advent (year.i)
Declare.d PureDate2Julian (date.q)
Declare.q Julian2PureDate (juDate.d)
Declare.i DateError ()
EndDeclareModule
Module DateEx
EnableExplicit
; -- Constants
#SOC = SizeOf(Character)
#DAYS_UNTIL_1970_01_01 = 719163 ; 1970-01-01, 00:00:00
#DAYS1 = 365 ; days in 1 year
#DAYS4 = #DAYS1 * 4 + 1 ; days in 4 years ( 1461)
#DAYS100 = #DAYS4 *25 - 1 ; days in 100 years ( 36524) // Gregorian calendar
#DAYS400 = #DAYS100*4 + 1 ; days in 400 years (146097) // Gregorian calendar
; -- Structures
Structure DateTime
year.w
month.b
day.b
hour.b
min.b
sec.b
EndStructure
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
Structure tm
tm_sec.l
tm_min.l
tm_hour.l
tm_mday.l
tm_mon.l
tm_year.l
tm_wday.l
tm_yday.l
tm_isdst.l
EndStructure
CompilerEndIf
ImportC ""
time(*tm=#Null)
localtime(*t.Quad)
EndImport
; -- Global and Shared variables
Global g_Error.i = 0
Define s_PrevDate.q = #NODATE
Define s_PrevCalendar.i = -1
Define s_DateQ.DateTime
;-- Utility functions
Macro _AscM (_string_, _posn_)
; -- fast version of Asc(Mid(_string_, _posn_, 1))
; _string_ must not equal "".
PeekC(@_string_ + ((_posn_)-1)*#SOC)
EndMacro
Macro _ModInt (_x_, _n_)
; -- True modulo function
; in : x,n: whole number
; out: the integer in the range [0,n[ that is congruent to x modulo n;
; The sign of the result is always the same as the sign of _n_.
;
; ModInt(x,n) = x - Floor(x/n) * n
(((_n_) + ((_x_)%(_n_))) % (_n_))
EndMacro
Procedure _YearDate (year.i, dayOfYear.i, *dt.DateTime, calendar.i)
; in : year
; dayOfYear: >= 1 and <= last day of the respective year
; (e.g. 32 for first February)
; calendar : #Default, #Julian, or #Gregorian
; out: *dt: pointer to DateTime structure, filled with calculated values
Protected days.i
If year < 1 Or year > 32767
g_Error = #Err_YearOutOfBounds
ProcedureReturn
EndIf
*dt\year = year
*dt\month = 1
days = 31
While dayOfYear > days
dayOfYear - days
*dt\month + 1
days = DaysInMonth(*dt\year, *dt\month, calendar)
Wend
*dt\day = dayOfYear
EndProcedure
Procedure.i _DayOfYearYMD (year.i, month.i, day.i, calendar.i)
; in : valid date
; calendar: #Default, #Julian, or #Gregorian
; out: return value: number of given day in given year
; (e.g. 32 for the first February),
; or -1 on error
Protected ret.i
ret = (month-1)*31 + day
If month >= 3
ret + LeapDay(year, calendar) - Int(0.4*month + 2.3)
If g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
EndIf
ProcedureReturn ret
EndProcedure
Procedure _SplitDate (date.q, *dt.DateTime, calendar.i)
; in : date : date in PureBasic format
; calendar: #Default, #Julian, or #Gregorian
; out: *dt: pointer to DateTime structure, filled with calculated values
Protected numDays.q, count.q, year.i, minutes.i
; -- calculate year
numDays = Round(date / #SECONDS_PER_DAY, #PB_Round_Down) - 1 + #DAYS_UNTIL_1970_01_01
If calendar = #Julian Or (calendar = #Default And numDays <= 577734) ; 1582-10-04
; proleptic Julian calendar
numDays + 2
ElseIf (calendar = #Gregorian Or calendar = #Default) And numDays > 577734
; Gregorian calendar
count = IntQ(numDays / #DAYS400)
numDays % #DAYS400
year = count*400
count = IntQ(numDays / #DAYS100)
numDays % #DAYS100
If count = 4 ; 4*100 years are 1 leapday
count - 1 ; less than 400 years
numDays = #DAYS100
EndIf ; 0 <= numDays <= DAYS100 (36524)
year + count*100
Else
g_Error = #Err_SplitDate
ProcedureReturn
EndIf
year + IntQ(numDays / #DAYS4) * 4 + 1
numDays % #DAYS4 ; 0 <= numDays <= DAYS1*4 (1460)
count = IntQ(numDays / #DAYS1)
numDays % #DAYS1
If count = 4 ; 4*1 year are 1 leapday
count - 1 ; less than 4 years
numDays = #DAYS1
EndIf ; 0 <= numDays <= 365
year + count
; -- calculate month and day
_YearDate(year, numDays+1, *dt, calendar)
If g_Error = #Err_YearOutOfBounds
ProcedureReturn
EndIf
; -- calculate time
date = _ModInt(date, #SECONDS_PER_DAY)
*dt\sec = date % 60
minutes = Int(date / 60)
*dt\min = minutes % 60
*dt\hour = Int(minutes / 60)
EndProcedure
; ========================================================================================
;-- Public functions
Procedure.q DateQ (year.i=-1, month.i=1, day.i=1, hour.i=0, min.i=0, sec.i=0, calendar.i=#Default)
; in : date between 0001-01-01 00:00:00 and 32767-12-31 23:59:59
; (There is no year 0 in the civil calendar).
; If no parameter is passed, then the current local date and time is returned.
; calendar: #Default, #Julian, or Gregorian
; out: return value: given date and time in PureBasic format (number of seconds since 1970-01-01 00:00:00);
; when using calendar = #Default:
; 0001-01-01 00:00:00 to 1582-10-04 23:59:59 -> proleptic Julian calendar,
; 1582-10-15 00:00:00 to 32767-12-31 23:59:59 -> Gregorian calendar,
; or -1 on error (see function DateError())
Protected numDays.i
If year = -1
; return current local time
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Protected t.SystemTime
GetLocalTime_(@t)
With t
year = \wYear
month = \wMonth
day = \wDay
hour = \wHour
min = \wMinute
sec = \wSecond
EndWith
CompilerCase #PB_OS_Linux
; https://stackoverflow.com/questions/1442116/how-to-get-the-date-and-time-values-in-a-c-program
Protected utc.q, *t.tm
utc = time()
*t = localtime(@utc)
If *t = #Null
g_Error = #Err_LocalTime
ProcedureReturn -1
EndIf
With *t
year = \tm_year + 1900
month = \tm_mon + 1
day = \tm_mday
hour = \tm_hour
min = \tm_min
sec = \tm_sec
EndWith
CompilerDefault
Protected d.q
d = Date()
If d = -1
g_Error = #Err_OutdatedPBversion
EndIf
ProcedureReturn d
CompilerEndSelect
ElseIf year < 1 Or year > 32767 Or month < 0 Or month > 12 Or day < 0 Or day > DaysInMonth(year, month, calendar) Or
hour < 0 Or hour > 23 Or min < 0 Or min > 59 Or sec < 0 Or sec > 59
g_Error = #Err_DateOutOfBounds
ProcedureReturn -1
EndIf
numDays = _DayOfYearYMD(year, month, day, calendar)
year - 1
numDays + year*365 + Int(year/4)
If calendar = #Default
If (year < 1581) Or
(year = 1581 And month < 10) Or
(year = 1581 And month = 10 And day <= 4)
calendar = #Julian
ElseIf year = 1581 And month = 10 And day < 15
g_Error = #Err_CalendarSystem
ProcedureReturn -1
Else
calendar = #Gregorian
EndIf
EndIf
Select calendar
Case #Julian
numDays - 2
Case #Gregorian
numDays - Int(year/100) + Int(year/400)
EndSelect
numDays - #DAYS_UNTIL_1970_01_01
ProcedureReturn numDays*#SECONDS_PER_DAY + (hour*60 + min)*60 + sec
EndProcedure
Procedure.q AddDateQ (date.q, type.i, value.q, calendar.i=#Default)
; in : date : date in PureBasic format
; type : #PB_Date_Year, #PB_Date_Month, #PB_Date_Week, #PB_Date_Day,
; #PB_Date_Hour, #PB_Date_Minute, or #PB_Date_Second
; value : how much of <type> is to be added/subtracted to <date>;
; Only whole numbers are allowed (if you want e.g. to pass
; half an hour, pass 30 minutes instead).
; calendar: #Default, #Julian, or Gregorian
; out: return value: calculated new date,
; or -1 on error (see procedure DateError())
Protected dt.DateTime, maxDay.i
If calendar = #Default And date <= -12219292801 ; 1582-10-04 23:59:59
calendar = #Julian
EndIf
Select type
Case #PB_Date_Year
_SplitDate(date, @dt, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
dt\year + value
maxDay = DaysInMonth(dt\year, dt\month, calendar)
If g_Error = #Err_YearOutOfBounds Or g_Error = #Err_DaysInMonth Or g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
With dt
If \day > maxDay
\day = maxDay
EndIf
ProcedureReturn DateQ(\year, \month, \day, \hour, \min, \sec, calendar)
EndWith
Case #PB_Date_Month
_SplitDate(date, @dt, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
dt\month + value
dt\year + Int(Round(dt\month / 12, #PB_Round_Down))
dt\month = _ModInt(dt\month, 12)
If dt\month = 0
dt\year - 1
dt\month = 12
EndIf
Assert(dt\month >= 1 And dt\month <= 12, "dt\month = " + dt\month)
maxDay = DaysInMonth(dt\year, dt\month, calendar)
If g_Error = #Err_YearOutOfBounds Or g_Error = #Err_DaysInMonth Or g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
With dt
If \day > maxDay
\day = maxDay
EndIf
ProcedureReturn DateQ(\year, \month, \day, \hour, \min, \sec, calendar)
EndWith
Case #PB_Date_Week
ProcedureReturn date + value*#SECONDS_PER_DAY*7
Case #PB_Date_Day
ProcedureReturn date + value*#SECONDS_PER_DAY
Case #PB_Date_Hour
ProcedureReturn date + value*3600
Case #PB_Date_Minute
ProcedureReturn date + value*60
Case #PB_Date_Second
ProcedureReturn date + value
Default
g_Error = #Err_DateType
ProcedureReturn -1
EndSelect
EndProcedure
Procedure.i DayOfWeekQ (date.q, ISO.i=#False)
; in : date: date in PureBasic format
; ISO : #True/#False
; out: return value: - Monday=1, ..., Saturday=6
; - Sunday=0 if ISO is False (compatible with PureBasic); default
; - Sunday=7 if ISO is True (according to ISO standard)
Protected ret.i
ret = IntQ(date/#SECONDS_PER_DAY + #DAYS_UNTIL_1970_01_01 + 7) % 7
If ret = 0 And ISO <> #False
ret = 7
EndIf
ProcedureReturn ret
EndProcedure
Procedure.i DayOfYearQ (date.q, calendar.i=#Default)
; in : date : date in PureBasic format
; calendar: #Default, #Julian, or #Gregorian
; out: return value: number of given day in given year
; (e.g. 32 for the first February),
; or -1 on error
Protected d.DateTime
_SplitDate(date, @d, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
Else
ProcedureReturn _DayOfYearYMD(d\year, d\month, d\day, calendar)
EndIf
EndProcedure
Procedure.i YearQ (date.q, calendar.i=#Default)
; in : date : date in PureBasic format
; calendar: #Default, #Julian, or #Gregorian
; out: return value: year value of 'date',
; or -1 on error
Shared s_PrevDate, s_PrevCalendar, s_DateQ
If s_PrevDate <> date Or s_PrevCalendar <> calendar
s_PrevDate = date
s_PrevCalendar = calendar
_SplitDate(date, @s_DateQ, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
EndIf
ProcedureReturn s_DateQ\year
EndProcedure
Procedure.i MonthQ (date.q, calendar.i=#Default)
; in : date : date in PureBasic format
; calendar: #Default, #Julian, or #Gregorian
; out: return value: month value of 'date',
; or -1 on error
Shared s_PrevDate, s_PrevCalendar, s_DateQ
If s_PrevDate <> date Or s_PrevCalendar <> calendar
s_PrevDate = date
s_PrevCalendar = calendar
_SplitDate(date, @s_DateQ, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
EndIf
ProcedureReturn s_DateQ\month
EndProcedure
Procedure.i DayQ (date.q, calendar.i=#Default)
; in : date : date in PureBasic format
; calendar: #Default, #Julian, or #Gregorian
; out: return value: day value of 'date',
; or -1 on error
Shared s_PrevDate, s_PrevCalendar, s_DateQ
If s_PrevDate <> date Or s_PrevCalendar <> calendar
s_PrevDate = date
s_PrevCalendar = calendar
_SplitDate(date, @s_DateQ, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
EndIf
ProcedureReturn s_DateQ\day
EndProcedure
Procedure.i HourQ (date.q)
; in : date in PureBasic format
; out: return value: hour value of 'date'
Shared s_PrevDate, s_DateQ
If s_PrevDate <> date
s_PrevDate = date
_SplitDate(date, @s_DateQ, #Default)
EndIf
ProcedureReturn s_DateQ\hour
EndProcedure
Procedure.i MinuteQ (date.q)
; in : date in PureBasic format
; out: return value: minute value of 'date'
Shared s_PrevDate, s_DateQ
If s_PrevDate <> date
s_PrevDate = date
_SplitDate(date, @s_DateQ, #Default)
EndIf
ProcedureReturn s_DateQ\min
EndProcedure
Procedure.i SecondQ (date.q)
; in : date in PureBasic format
; out: return value: second value of 'date'
Shared s_PrevDate, s_DateQ
If s_PrevDate <> date
s_PrevDate = date
_SplitDate(date, @s_DateQ, #Default)
EndIf
ProcedureReturn s_DateQ\sec
EndProcedure
Procedure.s FormatDateQ (mask$="%yyyy-%mm-%dd %hh:%ii:%ss", date.q=#NODATE, calendar.i=#Default)
; in : mask$ : can contain the same tokens as used with PB's FormatDate(),
; plus the following ones (all case-insensitive):
; - %ww --> full localized name of given weekday
; - %w --> short localized name of given weekday
; - %mmmm --> full localized name of given month
; - %mmm --> short localized name of given month
; - %m --> month number without leading "0"
; - %d --> day number without leading "0"
; - %h --> hours without leading "0"
; - %i --> minutes without leading "0"
; - %s --> seconds without leading "0"
; date : date in PureBasic format; #NODATE for current local date and time
; calendar: #Default, #Julian, or #Gregorian
; out: return value: mask string with all tokens replaced by the respective date values,
; or "" on error
Protected dt.DateTime, year$
If date = #NODATE
date = DateQ()
If g_Error = #Err_LocalTime Or g_Error = #Err_OutdatedPBversion
ProcedureReturn ""
EndIf
EndIf
_SplitDate(date, @dt, calendar)
If g_Error = #Err_SplitDate Or g_Error = #Err_YearOutOfBounds
ProcedureReturn ""
EndIf
mask$ = ReplaceString(mask$, "%ww", LocalizedDayName(DayOfWeekQ(date)), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%w", LocalizedDayName(DayOfWeekQ(date), #True), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%mmmm", LocalizedMonthName(dt\month), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%mmm", LocalizedMonthName(dt\month, #True), #PB_String_NoCase)
year$ = Str(dt\year)
If Len(year$) < 4
year$ = RSet(year$, 4, "0")
EndIf
mask$ = ReplaceString(mask$, "%yyyy", year$, #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%yy", Right(year$, 2), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%mm", RSet(Str(dt\month), 2, "0"), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%dd", RSet(Str(dt\day), 2, "0"), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%hh", RSet(Str(dt\hour), 2, "0"), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%ii", RSet(Str(dt\min), 2, "0"), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%ss", RSet(Str(dt\sec), 2, "0"), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%m", Str(dt\month), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%d", Str(dt\day), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%h", Str(dt\hour), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%i", Str(dt\min), #PB_String_NoCase)
mask$ = ReplaceString(mask$, "%s", Str(dt\sec), #PB_String_NoCase)
ProcedureReturn mask$
EndProcedure
Macro _AdjustPointer()
a = _AscM(date$, datePosn + 1)
If strict = #False And (a < '0' Or '9' < a)
*m + #SOC
EndIf
EndMacro
Procedure.q ParseDateQ (mask$, date$, calendar.i=#Default, strict=#False)
; in : mask$ : defines the format of date$ (e.g. "%yyyy-%mm-%dd %hh:%ii:%ss"),
; case-insensitive
; date$ : string with date to be parsed (e.g. "2023-06-27 15:58:07")
; calendar: #Default, #Julian, or #Gregorian
; strict : #True/#False;
; If strict = #False (default), no leading zeros are required.
; That's how PB's built-in function ParseDate() works.
; out: return value: value of date$ in PureBasic format,
; or -1 on error (see procedure DateError())
Protected *m.Character, datePosn.i=1
Protected.i year, month, day, hour, min, sec, a
mask$ = LCase(mask$)
*m = @mask$
While *m\c <> 0
If *m\c = '%'
Select PeekS(*m, 3)
Case "%yy"
If PeekS(*m + 3*#SOC, 2) = "yy"
year = Val(Mid(date$, datePosn, 5))
If year > 9999
datePosn + 1
EndIf
Else
year = Val(Mid(date$, datePosn, 4))
If year <= 99
year + Int(YearQ(DateQ()) / 100) * 100
Else
year = 0
EndIf
_AdjustPointer()
EndIf
Case "%mm"
month = Val(Mid(date$, datePosn, 2))
_AdjustPointer()
Case "%dd"
day = Val(Mid(date$, datePosn, 2))
_AdjustPointer()
Case "%hh"
hour = Val(Mid(date$, datePosn, 2))
_AdjustPointer()
Case "%ii"
min = Val(Mid(date$, datePosn, 2))
_AdjustPointer()
Case "%ss"
sec = Val(Mid(date$, datePosn, 2))
_AdjustPointer()
EndSelect
Else
a = _AscM(date$, datePosn)
If (a < '0' Or '9' < a) And a <> *m\c
g_Error = #Err_ParseDate
ProcedureReturn -1
EndIf
datePosn + 1
EndIf
*m + #SOC
Wend
ProcedureReturn DateQ(year, month, day, hour, min, sec, calendar)
EndProcedure
Procedure.i LeapDay (year.i, calendar.i=#Default)
; in : valid year
; calendar: #Default, #Julian, or #Gregorian
; out: return value: 1 if year has a leap day, 0 if not,
; or -1 on error
If year < 1 Or year > 32767
g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
If calendar = #Julian Or (calendar = #Default And year < 1582) Or year = 1582
ProcedureReturn Bool(year % 4 = 0)
ElseIf (calendar = #Gregorian Or calendar = #Default) And year > 1582
ProcedureReturn Bool((year % 4 = 0 And year % 100 <> 0) Or year % 400 = 0)
Else
g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
EndProcedure
Procedure.i DaysInMonth (year.i, month.i, calendar.i=#Default)
; in : valid year and month
; calendar: #Default, #Julian, or #Gregorian
; out: return value: number of days in given month of given year,
; or -1 on error
Protected ret
If year < 1 Or year > 32767
g_Error = #Err_YearOutOfBounds
ProcedureReturn -1
EndIf
Select month
Case 1, 3, 5, 7, 8, 10, 12
ret = 31
Case 4, 6, 9, 11
ret = 30
Case 2
ret = 28 + LeapDay(year, calendar)
If g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
Default
g_Error = #Err_DaysInMonth
ret = -1
EndSelect
ProcedureReturn ret
EndProcedure
Procedure.i WeekNumber (date.q)
; in : date of the Gregorian calendar in PureBasic format
; out: return value: no. of ISO calendar week for the given date
;
; According to ISO 8601, the week that contains January 4 is week 1.
; ISO weeks start on Monday.
; <https://en.wikipedia.org/wiki/ISO_8601>
; based on code by wilbert, <https://www.purebasic.fr/english/viewtopic.php?p=420708#p420708>
Protected.i week1_prev, week1_this, week1_next
Protected.i year=YearQ(date)
week1_prev = DateQ(year-1, 1, 4)
week1_prev - ((DayOfWeekQ(week1_prev) + 6) % 7) * #SECONDS_PER_DAY
week1_this = DateQ(year, 1, 4)
week1_this - ((DayOfWeekQ(week1_this) + 6) % 7) * #SECONDS_PER_DAY
week1_next = DateQ(year+1, 1, 4)
week1_next - ((DayOfWeekQ(week1_next) + 6) % 7) * #SECONDS_PER_DAY
If date < week1_this
; still in last week of previous year
ProcedureReturn (date - week1_prev) / #SECONDS_PER_WEEK + 1 ; can be 52 or 53
ElseIf date < week1_next
ProcedureReturn (date - week1_this) / #SECONDS_PER_WEEK + 1
Else
; already in week 1 of next year
ProcedureReturn 1
EndIf
EndProcedure
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
; <https://www.purebasic.fr/english/viewtopic.php?p=377844#p377844>
; <https://learn.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getlocaleinfoa>
; tested on German Windows 10 and 11
Procedure.s LocalizedDayName (weekday.i, short.i=#False)
; in : weekday: Monday=1, ..., Saturday=6
; (Sunday can be coded as 0 or 7)
; short : #True/#False
; out: return value: short or full localized name of given weekday,
; or "" on error
Protected fmt.i, bufferSize.i=80, buffer$=Space(bufferSize)
If weekday < 0 Or weekday > 7
g_Error = #Err_DayName
ProcedureReturn ""
EndIf
If weekday = 0
weekday = 7
EndIf
If short
fmt = #LOCALE_SABBREVDAYNAME1
Else
fmt = #LOCALE_SDAYNAME1
EndIf
If GetLocaleInfo_(#LOCALE_USER_DEFAULT, fmt + weekday - 1, @buffer$, bufferSize) > 0
ProcedureReturn buffer$
Else
g_Error = #Err_DayName
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s LocalizedMonthName (MonthOfYear.i, short.i=#False)
; in : MonthOfYear: January=1, ..., December=12
; (compliant with PureBasic's Month() function)
; short : #True/#False
; out: return value: short or full localized name of given month
; or "" on error
Protected fmt.i, bufferSize.i=80, buffer$=Space(bufferSize)
If MonthOfYear < 1 Or MonthOfYear > 12
g_Error = #Err_MonthName
ProcedureReturn ""
EndIf
If short
fmt = #LOCALE_SABBREVMONTHNAME1
Else
fmt = #LOCALE_SMONTHNAME1
EndIf
If GetLocaleInfo_(#LOCALE_USER_DEFAULT, fmt + MonthOfYear - 1, @buffer$, bufferSize) > 0
ProcedureReturn buffer$
Else
g_Error = #Err_MonthName
ProcedureReturn ""
EndIf
EndProcedure
CompilerElse
; <https://www.purebasic.fr/english/viewtopic.php?p=489699#p489699>
; <https://man7.org/linux/man-pages/man3/strftime.3.html>
; tested on German Linux Mint 20.3 and on Mac
Procedure.s LocalizedDayName (weekday.i, short.i=#False)
; in : weekday: Monday=1, ..., Saturday=6
; (Sunday can be coded as 0 or 7)
; short : #True/#False
; out: return value: short or full localized name of given weekday,
; or "" on error
Protected tm.tm, fmt.i, numBytes.i, bufferSize.i=80, buffer$=Space(bufferSize)
If weekday < 0 Or weekday > 7
g_Error = #Err_DayName
ProcedureReturn ""
EndIf
If weekday = 7
weekday = 0
EndIf
If short
fmt = $6125 ; "%a"
Else
fmt = $4125 ; "%A"
EndIf
tm\tm_wday = weekday
numBytes = strftime_(@buffer$, bufferSize * #SOC, @fmt, @tm)
If numBytes > 0
ProcedureReturn PeekS(@buffer$, numBytes, #PB_UTF8|#PB_ByteLength)
Else
g_Error = #Err_DayName
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s LocalizedMonthName (MonthOfYear.i, short.i=#False)
; in : MonthOfYear: January=1, ..., December=12
; (compliant with PureBasic's Month() function)
; short : #True/#False
; out: return value: short or full localized name of given month,
; or "" on error
Protected tm.tm, fmt.i, numBytes.i, bufferSize.i=80, buffer$=Space(bufferSize)
If MonthOfYear < 1 Or MonthOfYear > 12
g_Error = #Err_MonthName
ProcedureReturn ""
EndIf
If short
fmt = $6225 ; "%b"
Else
fmt = $4225 ; "%B"
EndIf
tm\tm_mon = MonthOfYear - 1
numBytes = strftime_(@buffer$, bufferSize * #SOC, @fmt, @tm)
If numBytes > 0
ProcedureReturn PeekS(@buffer$, numBytes, #PB_UTF8|#PB_ByteLength)
Else
g_Error = #Err_MonthName
ProcedureReturn ""
EndIf
EndProcedure
CompilerEndIf
Procedure.q UTC ()
; out: return value: current UTC in PureBasic format (seconds since 1970-01-01)
ProcedureReturn time()
EndProcedure
Procedure.i TimeZone ()
; out: return value: current difference local time - UTC (in seconds),
; e.g. 3600 for CET and 7200 for CEST
ProcedureReturn DateQ() - time()
EndProcedure
Procedure.s TimeZoneStr ()
; out: return value: current time zone as formatted string,
; e.g. +0100 for CET and +0200 for CEST
Protected sign$, m.i, h.i, tz.i=TimeZone()
If tz < 0 : sign$ = "-" : Else : sign$ = "+" : EndIf
m = Abs(tz/60)
h = Int(m/60)
ProcedureReturn sign$ + RSet(Str(h), 2, "0") + RSet(Str(m % 60), 2, "0")
EndProcedure
Procedure.q DateDiff (startTime.q, endTime.q, *p.Period, calendar.i=#Default)
; in : startTime: point in time in PureBasic format
; endTime : point in time in PureBasic format
; *p : set field values to -1 for units that shall be ignored
; calendar : #Default, #Julian, or #Gregorian
; out: *p : period from startTime to endTime expressed in wanted units;
; The values are compatible with PB's built-in AddDate() function.
; return value: period in seconds (>= 0) on success,
; or -1 on error
Protected.i y, m=0
Protected.q rest, tmp=startTime
If *p = #Null
g_Error = #Err_NullPointer
ProcedureReturn -1
ElseIf startTime > endTime
g_Error = #Err_NegativePeriod
ProcedureReturn -1
EndIf
If calendar = #Default And startTime <= -12219292801 ; 1582-10-04 23:59:59
calendar = #Julian
EndIf
With *p
If \years < 0 And \months < 0 And \weeks < 0 And \days < 0 And
\hours < 0 And \minutes < 0 And \seconds < 0
g_Error = #Err_DateDiff
ProcedureReturn -1
EndIf
y = YearQ(endTime, calendar) - YearQ(startTime, calendar)
If AddDateQ(tmp, #PB_Date_Year, y, calendar) > endTime
y - 1
EndIf
If \years > -1
tmp = AddDateQ(tmp, #PB_Date_Year, y, calendar)
If g_Error = #Err_YearOutOfBounds Or g_Error = #Err_DaysInMonth Or
g_Error = #Err_SplitDate Or g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
\years = y
Else
\years = 0
m = 12 * y
EndIf
If \months > -1
\months = m + MonthQ(endTime, calendar) - MonthQ(startTime, calendar)
If \months <= 0
\months + 12
EndIf
While AddDateQ(tmp, #PB_Date_Month, \months, calendar) > endTime
\months - 1
Wend
tmp = AddDateQ(tmp, #PB_Date_Month, \months, calendar)
If g_Error = #Err_YearOutOfBounds Or g_Error = #Err_DaysInMonth Or
g_Error = #Err_SplitDate Or g_Error = #Err_LeapDay
ProcedureReturn -1
EndIf
Else
\months = 0
EndIf
rest = endTime - tmp
Assert(rest >= 0, "startTime = " + startTime + ", endTime = " + endTime + ", calendar = " + calendar)
If \weeks > -1
\weeks = IntQ(rest / #SECONDS_PER_WEEK)
rest % #SECONDS_PER_WEEK
Else
\weeks = 0
EndIf
If \days > -1
\days = IntQ(rest / #SECONDS_PER_DAY)
rest % #SECONDS_PER_DAY
Else
\days = 0
EndIf
If \hours > -1
\hours = IntQ(rest / #SECONDS_PER_HOUR)
rest % #SECONDS_PER_HOUR
Else
\hours = 0
EndIf
If \minutes > -1
\minutes = IntQ(rest / #SECONDS_PER_MINUTE)
rest % #SECONDS_PER_MINUTE
Else
\minutes = 0
EndIf
If \seconds > -1
\seconds = rest
Else
\seconds = 0
EndIf
EndWith
ProcedureReturn endTime - startTime ; success
EndProcedure
Procedure.s Period2Str (*p.Period, units$=#PS_en$)
; in : *p : period of time expressed in appropriate units
; units$: time units in the language of your choice (default: English)
; out: return value: given time span expressed in given units as a string,
; or "" on error
Protected ret$=""
If *p = #Null
g_Error = #Err_NullPointer
ProcedureReturn ""
ElseIf CountString(units$, ",") <> 13
g_Error = #Err_TimeUnits
ProcedureReturn ""
EndIf
With *p
If \years < 0 Or \months < 0 Or \weeks < 0 Or \days < 0 Or
\hours < 0 Or \minutes < 0 Or \seconds < 0
g_Error = #Err_NegativeTime
ProcedureReturn ""
EndIf
If \years > 0
ret$ + ", " + \years + StringField(units$, 1, ",")
If \years > 1
ret$ + StringField(units$, 2, ",")
EndIf
EndIf
If \months > 0
ret$ + ", " + \months + StringField(units$, 3, ",")
If \months > 1
ret$ + StringField(units$, 4, ",")
EndIf
EndIf
If \weeks > 0
ret$ + ", " + \weeks + StringField(units$, 5, ",")
If \weeks > 1
ret$ + StringField(units$, 6, ",")
EndIf
EndIf
If \days > 0
ret$ + ", " + \days + StringField(units$, 7, ",")
If \days > 1
ret$ + StringField(units$, 8, ",")
EndIf
EndIf
If \hours > 0
ret$ + ", " + \hours + StringField(units$, 9, ",")
If \hours > 1
ret$ + StringField(units$, 10, ",")
EndIf
EndIf
If \minutes > 0
ret$ + ", " + \minutes + StringField(units$, 11, ",")
If \minutes > 1
ret$ + StringField(units$, 12, ",")
EndIf
EndIf
If \seconds > 0 Or Asc(ret$) = 0
ret$ + ", " + \seconds + StringField(units$, 13, ",")
If \seconds <> 1
ret$ + StringField(units$, 14, ",")
EndIf
EndIf
EndWith
ProcedureReturn Mid(ret$, 3)
EndProcedure
Procedure.q nth_WeekDay (weekday.i, dayNo.i, date.q)
; returns
; - the next (or next but one etc.) day after 'date' or
; - the last (or last but one etc.) day specified by 'weekday'
; before 'date' or
; - 'date' itself, if this day falls on 'weekday'
;
; in : weekday: Monday=1, ..., Saturday=6
; (Sunday can be coded as 0 or 7)
; dayNo : 1=next, 2=next but one etc. weekday AFTER 'date'
; -1=last, -2=last but one etc. weekday BEFORE 'date'
; date : date in PureBasic format
; out: return value: searched day (+ time) in PureBasic format,
; or -1 on error (see procedure DateError())
Protected days.i
If weekday < 0 Or weekday > 7 Or dayNo = 0
g_Error = #Err_WeekDay
ProcedureReturn -1
EndIf
If dayNo > 0
days = (weekday - DayOfWeekQ(date) + 7) % 7 ; nearest subsequent weekday
days + 7*(dayNo-1) ; n-th subsequent weekday
ElseIf dayNo < 0
days = (weekday - DayOfWeekQ(date) - 7) % 7 ; nearest previous weekday
days + 7*(dayNo+1) ; n-th previous weekday
EndIf
ProcedureReturn date + days * #SECONDS_PER_DAY
EndProcedure
Procedure.q nth_WeekDay_InMonth (weekday.i, dayNo.i, year.i, month.i, calendar.i=#Default)
; -- returns the n-th weekday of a month
; in : weekday : Monday=1, ..., Saturday=6
; (Sunday can be coded as 0 or 7)
; dayNo : 1=first, 2=second etc. weekday of given month
; -1=last, -2=last but one etc. weekday of given month
; year, month: wanted year and month of Julian or Gregorian calendar
; calendar : #Default, #Julian, or #Gregorian
; out: return value: searched day (+ time) in PureBasic format,
; or -1 on error (see procedure DateError())
Protected date.q, ret.i
If dayNo > 0
date = DateQ(year, month, 1, calendar)
ElseIf dayNo < 0
date = LastDayInMonth(year, month, calendar)
EndIf
ret = nth_WeekDay(weekday, dayNo, date)
If ret = -1 Or MonthQ(ret, calendar) <> month
g_Error = #Err_WeekDayInMonth
ret = -1
EndIf
ProcedureReturn ret
EndProcedure
Procedure.q Easter (year.i, calendar.i=#Default)
; -- Calculation of Easter Sunday
; in : year : year
; calendar: #Default, #Julian, or #Gregorian
; out: return value: date in PureBasic format,
; or -1 on error
;
; Note: The outermost dates on which Easter Sunday can fall
; are March 22 and April 25.
Protected.i b, c, e
Protected.i k, m, s, a, d, r, og, sz, oe
Protected.i month, day
If calendar = #Julian Or (calendar = #Default And year <= 1582)
; Easter algorithm by Carl Friedrich Gauss
; [after Heinrich Hemme (2009):
; Das Buch der Ziffern, Zahlen, Maße und Symbole.
; Anaconda, Köln; S. 78]
a = year % 19
b = year % 4
c = year % 7
d = (19*a + 15) % 30
e = (2*b + 4*c + 6*d + 6) % 7
day = 22 + d + e
ElseIf (calendar = #Gregorian Or calendar = #Default) And year > 1582
; Easter algorithm by Heiner Lichtenberg (1997);
; <https://www.ptb.de/cms/index.php?id=957>, 2023-07-04
k = Int(year/100)
m = 15 + Int((3*k+3)/4) - Int((8*k+13)/25)
s = 2 - Int((3*k+3)/4)
a = year % 19
d = (19*a+m) % 30
r = Int(d/29) + (Int(d/28)-Int(d/ 29)) * Int(a/11)
og = 21 + d - r
sz = 7 - (year+Int(year/4)+s) % 7
oe = 7 - (og-sz) % 7
day = og + oe
Else
g_Error = #Err_Easter
ProcedureReturn -1
EndIf
If day <= 31
month = 3
Else
day - 31
month = 4
EndIf
ProcedureReturn DateQ(year, month, day, 0, 0, 0, calendar)
EndProcedure
Procedure.q BlackFriday (year.i)
; in : year
; out: return value: the day following Thanksgiving in the USA, i.e. Friday
; after the 4th Thursday of November (e.g. Nov. 29 in 2004);
; range [Nov. 23; Nov. 29] (Wikipedia)
; Note: This is not always the same as the 4th Friday of November (e.g. Nov. 22 in 2004).
ProcedureReturn AddDateQ(nth_WeekDay_InMonth(#Thursday, 4, year, 11), #PB_Date_Day, 1)
EndProcedure
Procedure.q Advent (year.i)
; in : year
; out: return value: 1st Advent Sunday for given year of the Gregorian calendar;
; range [Nov. 27; Dec. 3]
; Note: If December 24 is a Sunday, then it is the 4th Advent Sunday;
; otherwise, the 4th Advent Sunday is the Sunday before December 24.
ProcedureReturn nth_WeekDay(#SundayISO, -4, DateQ(year, 12, 24))
EndProcedure
Procedure.d PureDate2Julian (date.q)
; in : date in PureBasic format (seconds since 1970-01-01 00:00:00)
; out: return value: Julian date (used primarily in astronomy)
; = number of days that have elapsed since 1 January 4713 BC,
; 12 o'clock Universal Time
; (hours, minutes, and seconds are expressed as fraction of a day)
ProcedureReturn date / #SECONDS_PER_DAY + 2440587.5
EndProcedure
Procedure.q Julian2PureDate (juDate.d)
; in : Julian date
; out: return value: date in PureBasic format (seconds since 1970-01-01 00:00:00),
; or -1 on error (see procedure DateError())
If juDate < 1721423.5 Or juDate > 13689325.499988426 ; < 0001-01-01 00:00:00 Or > 32767-12-31 23:59:59
g_Error = #Err_JulianDateOutOfBounds
ProcedureReturn -1
Else
ProcedureReturn Round((juDate - 2440587.5) * #SECONDS_PER_DAY, #PB_Round_Nearest)
EndIf
EndProcedure
Procedure.i DateError ()
; out: return value: code of the most recent error,
; or 0 for no error
; Note: For compatibility with PureBasic, many functions in this library return -1 on error.
; However, for some functtions a return value of -1 can also represent a valid date
; in PureBasic format, meaning 1969-12-31 23:59:59 (on the Gregorian calendar).
; So don't always rely on a return value of -1 as error indicator.
; Often it's better to use code like this for error checking:
; v = DateEx::<function>
; e = DateEx::DateError()
; If e <> 0
; Debug "Error " + e
; Else
; ; OK
; EndIf
Protected temp.i=0
Swap temp, g_Error ; set g_Error to 0
ProcedureReturn temp
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
;-- Demo
EnableExplicit
UseModule DateEx
Define check.q, d.q, birthday.q, i.i, year.i, jd.d, out$, age.Period
check = DateQ(2023, 5, 31)
; -- DateQ()
Assert(DateQ(1970,1,1) = 0)
Assert(DateQ(1970,1,1) = Date(1970,1,1, 0,0,0))
Assert(DateQ() = Date())
; -- AddDateQ()
Assert(AddDateQ(check, #PB_Date_Year, 2) = AddDate(check, #PB_Date_Year, 2))
Assert(AddDateQ(check, #PB_Date_Month, -5) = AddDate(check, #PB_Date_Month, -5))
Assert(AddDateQ(check, #PB_Date_Week, -3) = AddDate(check, #PB_Date_Week, -3))
Assert(AddDateQ(check, #PB_Date_Minute, 6) = AddDate(check, #PB_Date_Minute, 6))
; -- YearQ(), MonthQ(), DayQ() etc.
d = DateQ(1582, 10, 4)
Assert(Str(YearQ(d)) + "-" + MonthQ(d) + "-" + RSet(Str(DayQ(d)),2,"0") = "1582-10-04")
Assert(DayOfWeekQ(d) = #Thursday)
d = AddDateQ(d, #PB_Date_Day, 1)
Assert(Str(YearQ(d)) + "-" + MonthQ(d) + "-" + RSet(Str(DayQ(d)),2,"0") = "1582-10-15")
Assert(DayOfWeekQ(d) = #Friday)
Assert(YearQ(check) = Year(check))
Assert(MonthQ(check) = Month(check))
Assert(DayQ(check) = Day(check))
Assert(HourQ(check) = Hour(check))
Assert(MinuteQ(check) = Minute(check))
Assert(SecondQ(check) = Second(check))
d = DateQ(2023, 12, 24, 0, 0, 0, #Julian)
Assert(Str(YearQ(d)) + "-" + MonthQ(d) + "-" + DayQ(d) = "2024-1-6")
d = DateQ(2024, 1, 6)
Assert(Str(YearQ(d, #Julian)) + "-" + MonthQ(d, #Julian) + "-" + DayQ(d, #Julian) = "2023-12-24")
; -- DayOfWeekQ(...)
For i = 5 To 11 ; Monday, ..., Sunday
d = DateQ(2023, 6, i)
Assert(DayOfWeekQ(d) = DayOfWeek(d))
Next
Assert(DayOfWeekQ(DateQ(1958, 2, 21)) = 5) ; Friday
; -- DayOfWeekQ(..., #True)
For i = 5 To 11 ; Monday, ..., Sunday
d = DateQ(2023, 6, i)
Assert(DayOfWeekQ(d, #True) = i-4)
Next
Assert(DayOfWeekQ(DateQ(1958, 2, 21), #True) = 5) ; Friday
; -- DayOfYearQ()
Assert(DayOfYearQ(check) = DayOfYear(check))
; -- FormatDateQ()
Assert(FormatDate ("%yyyy-%mm-%dd %hh:%ii:%ss", check) = "2023-05-31 00:00:00")
Assert(FormatDateQ("%yyyy-%mm-%dd %hh:%ii:%ss", check) = "2023-05-31 00:00:00")
Assert(FormatDate ("%YYYY-%MM-%DD %HH:%II:%SS", check) = "2023-05-31 00:00:00")
Assert(FormatDateQ("%YYYY-%MM-%DD %HH:%II:%SS", check) = "2023-05-31 00:00:00")
Assert(FormatDateQ("%yyyy-%mm-%dd", DateQ(32767, 12, 31)) = "32767-12-31")
Assert(FormatDate ("The date is %yyyy-%mm-%dd.", check) = "The date is 2023-05-31.")
Assert(FormatDateQ("The date is %yyyy-%mm-%dd.", check) = "The date is 2023-05-31.")
Debug "Now: " + FormatDateQ("%ww, %d. %mmmm %yyyy %hh:%ii:%ss")
Debug "Now: " + FormatDateQ() + " " + TimeZoneStr()
Debug ""
; -- ParseDateQ()
Assert(ParseDateQ("%yy-%mm-%dd %hh:%ii:%ss", "23-06-27 08:27:14") = 1687854434)
Assert(ParseDateQ("%yyyy-%mm-%dd", "32767-12-31") = DateQ(32767, 12, 31))
Assert(ParseDateQ("%yyyy-%mm-%dd", "2023-6-27") = 1687824000)
Assert(ParseDateQ("%yyyy-%mm-%dd", "2023-6-27", #Default, #True) = -1)
Assert(DateError() = #Err_ParseDate)
Assert(ParseDateQ("%yyyy-%mm-%dd", "") = -1)
Assert(DateError() = #Err_ParseDate)
Assert(ParseDateQ("%yyyy-%mm-%dd", "2023/06/27") = -1)
Assert(DateError() = #Err_ParseDate)
Assert(ParseDateQ("The date is %yyyy-%mm-%dd", "2023-12-31") = -1)
Assert(DateError() = #Err_ParseDate)
; -- LastDayInMonth()
Assert(LastDayInMonth(2016, 2) = DateQ(2016, 2, 29))
Assert(LastDayInMonth(2017, 2) = DateQ(2017, 2, 28))
; -- DaysInMonth()
Assert(DaysInMonth(2018, 2) = 28)
Assert(DaysInMonth(2020, 2) = 29)
; -- WeekNumber()
Assert(WeekNumber(DateQ(2010, 1, 3)) = 53)
Assert(WeekNumber(DateQ(2010, 1, 4)) = 1)
Debug "-- LocalizedDayName()"
out$ = ""
For i = 1 To 7
out$ + ", " + LocalizedDayName(i)
Next
Debug Mid(out$, 3)
Debug ""
Debug "-- LocalizedMonthName()"
out$ = ""
For i = 1 To 12
out$ + ", " + LocalizedMonthName(i)
Next
Debug Mid(out$, 3)
Debug ""
Debug "-- DateDiff() and Period2Str()"
birthday = DateQ(1958, 2, 21)
; Ignore hours, minutes and seconds:
With age
\hours = -1
\minutes = -1
\seconds = -1
EndWith
If DateDiff(birthday, DateQ(), @age) > -1
Debug "Current age: " + Period2Str(age)
Else
Debug "DateError() = " + DateError()
EndIf
; -- nth_WeekDay()
Assert(nth_WeekDay(#Friday, 1, DateQ(2018,3,1)) = DateQ(2018, 3, 2))
Assert(nth_WeekDay(#Saturday, -2, DateQ(2018,3,31)) = DateQ(2018, 3, 24))
; -- nth_WeekDay_InMonth()
Assert(nth_WeekDay_InMonth(#Friday, 1, 2018, 3) = DateQ(2018, 3, 2))
Assert(nth_WeekDay_InMonth(#Saturday, -2, 2018, 3) = DateQ(2018, 3, 24))
; -- Easter()
Assert(Easter(1818) = DateQ(1818, 3, 22))
Assert(Easter(1943) = DateQ(1943, 4, 25))
; -- BlackFriday()
Assert(nth_WeekDay_InMonth(#Friday, 4, 2024, 11) = DateQ(2024, 11, 22))
Assert(BlackFriday(2024) = DateQ(2024, 11, 29))
; -- Advent()
Assert(Advent(2024) = DateQ(2024, 12, 1))
; -- Julian date
jd = PureDate2Julian(-62135769600) ; DateQ(1,1,1)
Assert(jd = 1721423.5)
jd = PureDate2Julian(971890963199) ; DateQ(32767,12,31, 23,59,59)
Assert(jd = 13689325.499988426)
d = Julian2PureDate(jd)
Assert(FormatDateQ("%yyyy-%mm-%dd %hh:%ii:%ss", d) = "32767-12-31 23:59:59")
CompilerEndIf
See also demo program how to easily create an annual overview calendar.
-------------------------------------------------
My best tricks & tips from 15+ years
Create arrays elegantly
Extended date library
Save JSON data with object members well-arranged
Evaluate and process math expressions
Functions for sets
Statistics with R
Thue-Morse sequence
Natural sorting
Sort array indexes and parallel arrays
Time profiling
VectorIcons
