Wilbert, thank you very much for sharing this date routines! It is exactly what I need for my project and so your code is very helpful for me.
I took the liberty to occupy your code and made some adjustments so it fits to my personal needs.
To better understand the code, I have provided it with additional comments and renamed many variables. Furthermore, I added two procedures to deal with 64 bit date/time values in relation to the DateGadget (64 bit set and get procedures). Because of limitation of the PureBasics Date library the DateGadget() and CalendarGadget() does not produce change events if the selected date is outde of the supported range (1970 till 2038). Therefore there is now a CallBack procedure that generates these events and inject them into the PureBasic event queue. These functions can be enabled and disabled using the EnableDateGadgetEvent64() and DisableDateGadgetEvent64() commands. Because of API calls these commands are working only on Windows systems, maybe someone have a solution for Linux and Mac OS?
Below you will find the source code. If this code is executed as the main file, then the example at the end is compiled. In this case you see a window with CalendarGadget, DateGadget a Button and some date output in an editor gadget. If the code is used as includefile (Include File "..."), then the example code is not compiled.
At this point, I want also say thanks to edel, RSBasic and ts-soft from the german forum, who have answered me many of my questions.
Code: Select all
;
; *************************************************************************
; * Date64 written by Wilbert (http://www.purebasic.fr/english/viewtopic.php?p=421612#p421612)
; *************************************************************************
; *
; * Programname : Date64
; * Filename : mod_Date64.pbi
; * Filetype : Module [App, Main, Includefile, Module, Datafile]
; * Programming lang. : Purebasic 5.xx
; * String-Format : All [Ascii, Unicode]
; * Platform : ??? [Windows, Mac, Linux]
; * Processor : All [x86, x64]
; * Version : 1.06
; * Date : 30.07.2017
; * Autor : Wilbert
; * -----------------------------------------------------------------------
; * DESCRIPTION:
; *
; * Wilbert says:
; * Please don't blame me for using ASM. I know it can easily be done without but that's just the fun part For me :wink:
; * You can use these procedures if you need to support dates prior To 1970 Or if you need the speed as they same to be faster compared to the built in routines.
; * Dates have to be between 1582/10/15 (-12219292800) and 9999/12/31 (253402300799)
; *
; * Supported procedures:
; * --------------------
; * Date64 (iYear.i = -1, iMonth.i = 1, iDay.i = 1, iHour.i = 0, iMinute.i = 0, iSecond.i = 0)
; * AddDate64 (Date64.q, iType.i, iValue.i)
; * Year64 (qDate64.q)
; * Month64 (qDate64.q)
; * Day64 (qDate64.q)
; * Hour64 (qDate64.q)
; * Minute64 (Date64.q)
; * Second64 (qDate64.q)
; * DayOfYear64 (Date64.q)
; * DayOfWeek64 (qDate64.q)
; * DaysInMonth(qDate64.q)
; * DayFromYMW64 (iYear.i, iMonth.i, iWeekday.i, iWeek.i)
; * WeekOfYear64 (qDate64.q)
; * IsLeapYear64 (iYear.i)
; * FormatDate64 (sMask.s, Date64.q)
; * GetDateGadget64 (iGadget.i) Windows only!
; * SetDateGadget64 (iGadget.i, qDate64.q) Windows only!
; * EnableDateGadgetEvent64() Windows only!
; * DisableDateGadgetEvent64() Windows only!
; *
; * Kurzer says:
; * I have to say thank you to...
; * -> Wilbert for this piece of code. It is exactly what I need for my project and so your code is very helpful for me.
; * -> edel, RSBasic and ts-soft from the german forum: Thank you for your endless patience and for all the answers to my questions.
; *
; * -----------------------------------------------------------------------
; * Changelog:
; * 1.06 - rel 30.07.17 (Kurzer):
; * add - DaysInMonth(): Returns the number of days of a month from a given date/time (thanks to Wilbert)
; * chg - Generating a #PB_EventType_Calendar_Change event for the DateGadget() has been removed, because
; * the DateGadget() natively sends the #PB_EventType_Change event when the date/time was changed
; * chg - Generating the userdefined event #PB_EventType_Calendar_Change for the CalendarGadget() has been removed
; * Instaed the #PB_EventType_Change event is generated to be conform to the DatGadget()
; * fix - Date64Callback(): The method to determine the PB Gadget-ID for the DateGadget() was wrong
; * fix - Minor fixes in the example code
; *
; * 1.05 - rel 19.12.15 (Kurzer):
; * chg - Renaming the module, procedures and variables to my personal needs
; * chg - Return values of the procedures have been explicitly defined
; * chg - It is no longer necessary to call Init() befor using the module
; * add - Added some comments (I did that in order to even better understand the workflow of the code)
; * add - Date64() now behaves like Date(), that means if no parameters are given
; * the procedure returns the current date/time as 64 bit value
; * (Attention: This is limited to the date/time range supported by PureBasics built in Date() command)
; * add - Win only: GetDateGadget64() and SetDateGadget64() procedures for getting/setting a 64 bit date/time value from/to a DateGadget
; * add - Win only: EnableDateGadgetEvent64() and DisableDateGadgetEvent64() procedures for generating #PB_EventType_Calendar_Change
; * events if a date/time was selected in a DateGadget or CalendarGadget which are out of the range supported by PureBasics Date library
; *
; * 1.04 - rel 16.12.15 (Davido):
; * Takover of Wilberts code which was converted to a module by Davido
; * http://www.purebasic.fr/english/viewtopic.php?p=452019#p452019
; *
; * 1.03 - rel 18.08.2013 (Wilbert):
; * Wilberts release of the "DateQ.pbi"
; *
; *************************************************************************
;- *************************************************************************
;- Module declaration
;- *************************************************************************
DeclareModule Date64
Structure stDate64Info
wYDay.w ; offset 0 : days since Jan 1 [1-366]
wYear.w ; offset 2 : year [1600-9999]
bMonth.b ; offset 4 : months [1-12]
bDay.b ; offset 5 : day of the month [1-31]
bHour.b ; offset 6 : hours [0-23]
bMinutes.b ; offset 7 : minutes [0-59]
bSeconds.b ; offset 8 : bSecondsonds [0-59]
bWeekDay.b ; offset 9 : days since Sunday [0-6]
EndStructure
Structure arrDate64_CharArray
c.c[0]
EndStructure
Declare.q Date64(iYear.i = -1, iMonth.i = 1, iDay.i = 1, iHour.i = 0, iMinute.i = 0, iSecond.i = 0)
Declare.q AddDate64(Date64.q, iType.i, iValue.i)
Declare.i Year64(qDate64.q)
Declare.i Month64(qDate64.q)
Declare.i Day64(qDate64.q)
Declare.i Hour64(qDate64.q)
Declare.i Minute64(Date64.q)
Declare.i Second64(qDate64.q)
Declare.i DayOfYear64(Date64.q)
Declare.i DayOfWeek64(qDate64.q)
Declare.i DaysInMonth(qDate64.q)
Declare.i DayFromYMW64(iYear.i, iMonth.i, iWeekday.i, iWeek.i)
Declare.i WeekOfYear64(qDate64.q)
Declare.i IsLeapYear64(iYear.i)
Declare.s FormatDate64(sMask.s, qDate64.q)
Declare.q GetDateGadget64(iGadget.i)
Declare.i SetDateGadget64(iGadget.i, qDate64.q)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Declare EnableDateGadgetEvent64()
Declare DisableDateGadgetEvent64()
CompilerEndIf
EndDeclareModule
;- *************************************************************************
;- Module implementation
;- *************************************************************************
Module Date64
;- *************************************************************************
;- Compiler directives
;- *************************************************************************
EnableExplicit
;- *************************************************************************
;- Global variables
;- *************************************************************************
Global Dim Date64_LookupTable.l(16384)
Global Dim Date64_LookupTable2.w(2024)
Global bIsInitialized = #False
;- *************************************************************************
;- Private procedures
;- *************************************************************************
Procedure Init()
; +-----------------------------------------------------------------
; |Description : Creates the lookup tables (about 65 KiB)
; |Arguments : -
; |Results : -
; |Remarks : -
; +-----------------------------------------------------------------
Protected.i y, y_, d, d_, w, m
If bIsInitialized = #False
While y < 16384
d = y >> 2 : y_ = d / 25 : d - y_ : y_ >> 2 : d + y_
y + 1
y_ = d - d_ : w + 1 + y_ : d_ = d
If w > 6 : w - 7 : EndIf
Date64_LookupTable(y - 1) | y_ << 4
Date64_LookupTable(y) = (d + y * 365 + 1) << 8 | w << 5
Wend
y = 0 : y_ = 512
For m = 1 To 12
If m = 2
For d = 1 To 28
w = m | d << 8
Date64_LookupTable2(y) = w : y + 1
Date64_LookupTable2(y_) = w : y_ + 1
Next
Date64_LookupTable2(y_) = 2 | 29 << 8 : y_ + 1
Else
d_ = 30 + (m & 1) ! (m >> 3)
For d = 1 To d_
w = m | d << 8
Date64_LookupTable2(y) = w : y + 1
Date64_LookupTable2(y_) = w : y_ + 1
Next
EndIf
Next
bIsInitialized = #True
EndIf
EndProcedure
Procedure Date64Info(*Date64Info.stDate64Info, qDate64.q)
; +-----------------------------------------------------------------
; |Description : Fills up the Date64Info structure variable with a given date/time
; |Arguments : *Date64Info: Pointer to the Date64Info structure variable
; | : qDate64 : 64 Bit date/time value to pass on the Date64Info structure variable
; |Results : -
; |Remarks : -
; +-----------------------------------------------------------------
!mov eax, [p.v_qDate64]
!mov edx, [p.v_qDate64 + 4]
; split into date and time
!add eax, 0x79747c00
!adc edx, 0xe
!and edx, 0x7f
!mov ecx, 86400
!div ecx
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov r8, [p.p_Date64Info]
!mov r9, rax
; process the time part
!mov eax, edx
!xor edx, edx
!mov ecx, 60
!div ecx
!mov [r8 + 8], dl
!div cl
!mov [r8 + 6], ax
; process the date part
!mov rax, r9
; guess the year
!mov ecx, 0xb36d83
!mul ecx
!and rdx, 16383
; correct it if wrong
!mov rcx, [date64.a_Date64_LookupTable]
!mov eax, [rcx + rdx * 4 + 4]
!shr rax, 8
!cmp r9, rax
!cmc
!adc rdx, 0
!mov [r8 + 2], dx; year
!mov eax, [rcx + rdx * 4]
; get the other info
!movzx rcx, al
!shr rax, 8
!sub r9, rax
!and r9, 511
!lea rdx, [r9 + 1]
!mov [r8], dx; yday
!mov rdx, rcx
!shl rdx, 5
!and rdx, 512
!or rdx, r9
!mov rax, [date64.a_Date64_LookupTable2]
!mov dx, [rax + rdx * 2]
!mov [r8 + 4], dx; day and month
!mov rax, r9
!shr rcx, 5
!add rax, rcx
!mov cl, 7
!div cl
!mov al, ah
!mov [r8 + 9], al; bWeekDay
CompilerElse
!mov ecx, [p.p_Date64Info]
!push edi
!push ebx
!mov edi, ecx
!mov ebx, eax
; process the time part
!mov eax, edx
!xor edx, edx
!mov ecx, 60
!div ecx
!mov [edi + 8], dl
!div cl
!mov [edi + 6], ax
; process the date part
!mov eax, ebx
; guess the year
!mov ecx, 0xb36d83
!mul ecx
!and edx, 16383
; correct it if wrong
!mov ecx, [date64.a_Date64_LookupTable]
!mov eax, [ecx + edx * 4 + 4]
!shr eax, 8
!cmp ebx, eax
!cmc
!adc edx, 0
!mov [edi + 2], dx; year
!mov eax, [ecx + edx * 4]
; get the other info
!movzx ecx, al
!shr eax, 8
!sub ebx, eax
!and ebx, 511
!lea edx, [ebx + 1]
!mov [edi], dx; yday
!mov edx, ecx
!shl edx, 5
!and edx, 512
!or edx, ebx
!mov eax, [date64.a_Date64_LookupTable2]
!mov dx, [eax + edx * 2]
!mov [edi + 4], dx; day and month
!mov eax, ebx
!shr ecx, 5
!add eax, ecx
!mov cl, 7
!div cl
!mov [edi + 9], ah; bWeekDay
!pop ebx
!pop edi
CompilerEndIf
EndProcedure
Procedure FormatDate64_Set(*Date64_CharArray.arrDate64_CharArray, iValue.i, iSize.i = 2)
; +-----------------------------------------------------------------
; |Description : Helper procedure for FormatDate64()
; |Arguments : *Date64_CharArray: Pointer to the format mask chararray
; | : iValue : The numeric value that replaces the masks token, e.g. '%yyyy" will result in '2015' if iValue is 2015
; | : iSize : Length of the value in iValue in digits, e.g. 2015 = 4 or 12 = 2
; |Results : -
; |Remarks : -
; +-----------------------------------------------------------------
While iSize
iSize - 1 : *Date64_CharArray\c[iSize] = $30 | iValue % 10 : iValue / 10
Wend
EndProcedure
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure.l Date64Callback(iWindowHandle.i, iMessage.i, wParam.i, lParam.l)
; +-----------------------------------------------------------------
; |Description : Callback procedure for generating #PB_EventType_Change event at date changes
; |Arguments : The usual callback parameters of a MS Windows callback proc
; |Results : #PB_ProcessPureBasicEvents (in accordance with the PureBasic rules for SetWindowCallback())
; |Remarks : This procedure generates the #PB_EventType_Change event on Windows OS because
; | : outside of the date/time range (1970 ~ 2038) which is supported by PureBasic, no more change events
; | : are generated by the DateGadget() and CalendarGadget()
; | : For e.g. if you select the Date 1st Mar 2040 in the CalendarGadget you will receive no event
; | : about this action unless you use EnableDateGadgetEvent64().
; | : Please note: This callback will generate the #PB_EventType_Change in every case. So you may
; | : receive the event twice, if the date is in the date/time range which is supported by PureBasic
; +-----------------------------------------------------------------
Protected *NMHDR.NMHDR
If iMessage = #WM_NOTIFY
*NMHDR = lParam
If GadgetType(*NMHDR\idFrom) = #PB_GadgetType_Calendar And *NMHDR\code = #MCN_FIRST + 1 ; = #MCN_SELCHANGE
PostEvent(#PB_Event_Gadget, GetProp_(GetParent_(*NMHDR\hwndFrom), "PB_WINDOWID")-1, GetProp_(*NMHDR\hwndFrom, "PB_ID"), #PB_EventType_Change)
ElseIf GadgetType(*NMHDR\idFrom) = #PB_GadgetType_Date And *NMHDR\code = #DTN_DATETIMECHANGE
PostEvent(#PB_Event_Gadget, GetProp_(GetParent_(*NMHDR\hwndFrom), "PB_WINDOWID")-1, GetProp_(*NMHDR\hwndFrom, "PB_ID"), #PB_EventType_Change)
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
CompilerEndIf
;- *************************************************************************
;- Public procedures
;- *************************************************************************
Procedure.q Date64(iYear.i = -1, iMonth.i = 1, iDay.i = 1, iHour.i = 0, iMinute.i = 0, iSecond.i = 0)
; +-----------------------------------------------------------------
; |Description : Generates a 64 bit date/time value from seperately given date and time parts
; |Arguments : iYear : The year part of the date
; | : iMonth : The month part of the date
; | : iDay : The day part of the date
; | : iHour : The hour part of the time
; | : iMinute: The minute part of the date
; | : iSecond: The second part of the date
; |Results : The calculated 64 bit date/time value, representing the given date/time
; |Remarks : If you call the procedure without parameters it returns the 64 bit date/time value of the current date/time
; +-----------------------------------------------------------------
Protected.i iCurrentDate
Init()
If iYear = -1
iCurrentDate = Date()
iYear = Year(iCurrentDate)
iMonth = Month(iCurrentDate)
iDay = Day(iCurrentDate)
iHour = Hour(iCurrentDate)
iMinute = Minute(iCurrentDate)
iSecond = Second(iCurrentDate)
EndIf
!mov ecx, [p.v_iYear]
!and ecx, 16383
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rdx, [date64.a_Date64_LookupTable]
!mov eax, [rdx + rcx * 4]
!mov rcx, [p.v_iMonth]
!or rcx, rax
!and rcx, 31
!lea rdx, [Date64_oday_table]
!movsx rcx, word [rdx + rcx * 2]
!shr rax, 8
!add rax, rcx
!add rax, [p.v_iDay]
!sub rax, 0xafaa9
!imul rax, 86400
!mov rcx, [p.v_iHour]
!lea rcx, [rcx + rcx * 4]; *5
!lea rcx, [rcx + rcx * 2]; *3
!sal rcx, 2; *4
!add rcx, [p.v_iMinute]
!lea rcx, [rcx + rcx * 4]; *5
!lea rcx, [rcx + rcx * 2]; *3
!sal rcx, 2; *4
!add rcx, [p.v_iSecond]
!add rax, rcx
CompilerElse
!mov edx, [date64.a_Date64_LookupTable]
!mov eax, [edx + ecx * 4]
!mov ecx, [p.v_iMonth]
!or ecx, eax
!and ecx, 31
!movsx ecx, word [Date64_oday_table + ecx * 2]
!shr eax, 8
!add eax, ecx
!add eax, [p.v_iDay]
!sub eax, 0xafaa9
!mov ecx, 86400
!imul ecx
!mov ecx, [p.v_iHour]
!lea ecx, [ecx + ecx * 4]; *5
!lea ecx, [ecx + ecx * 2]; *3
!sal ecx, 2; *4
!add ecx, [p.v_iMinute]
!lea ecx, [ecx + ecx * 4]; *5
!lea ecx, [ecx + ecx * 2]; *3
!sal ecx, 2; *4
!add ecx, [p.v_iSecond]
!add eax, ecx
!adc edx, 0
!sar ecx, 31
!add edx, ecx
CompilerEndIf
ProcedureReturn
!Date64_oday_table:
!dw -31,0,31,59,90,120,151,181,212,243,273,304,334,365,396,-61 ; normal year
!dw -31,0,31,60,91,121,152,182,213,244,274,305,335,366,397,-61 ; leap year
EndProcedure
Procedure.q AddDate64(qDate64.q, iType.i, iValue.i)
; +-----------------------------------------------------------------
; |Description : Adds date parts to a date
; |Arguments : qDate64: The 64 bit date/time value on which the date part is to be added
; | : iType : Constant which defines the date part which have to be added, e.g. #PB_Date_Day
; | : (see PureBasic help for detailed informations)
; | : iValue : The value of the date part which have to be added, e.g. 13 for thirteen days (if you use #PB_Date_Day)
; |Results : The new calculated 64 bit date/time value
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info, D.q
Init()
Select iType
Case #PB_Date_Year
Date64Info(@stvDate64Info, qDate64) : stvDate64Info\wYear + iValue
If stvDate64Info\bMonth = 2 And stvDate64Info\wYDay = 60
If IsLeapYear64(stvDate64Info\wYear) = 0 : stvDate64Info\bDay = 28 : EndIf
EndIf
qDate64 = Date64(stvDate64Info\wYear, stvDate64Info\bMonth, stvDate64Info\bDay, stvDate64Info\bHour, stvDate64Info\bMinutes, stvDate64Info\bSeconds)
Case #PB_Date_Month
Date64Info(@stvDate64Info, qDate64) : stvDate64Info\bMonth + iValue
While stvDate64Info\bMonth < 1 : stvDate64Info\wYear - 1 : stvDate64Info\bMonth + 12 : Wend
While stvDate64Info\bMonth > 12 : stvDate64Info\wYear + 1 : stvDate64Info\bMonth - 12 : Wend
qDate64 = Date64(stvDate64Info\wYear, stvDate64Info\bMonth, stvDate64Info\bDay, stvDate64Info\bHour, stvDate64Info\bMinutes, stvDate64Info\bSeconds)
D = Date64(stvDate64Info\wYear, stvDate64Info\bMonth + 1, 0, stvDate64Info\bHour, stvDate64Info\bMinutes, stvDate64Info\bSeconds)
If qDate64 > D : qDate64 = D : EndIf
Case #PB_Date_Week : qDate64 + iValue * 604800
Case #PB_Date_Day : qDate64 + iValue * 86400
Case #PB_Date_Hour : qDate64 + iValue * 3600
Case #PB_Date_Minute : qDate64 + iValue * 60
Case #PB_Date_Second : qDate64 + iValue
EndSelect
ProcedureReturn qDate64
EndProcedure
Procedure.i Year64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Extracts the year from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The year part of the date/time
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\wYear
EndProcedure
Procedure.i Month64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Extracts the month from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The month part of the date/time
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\bMonth
EndProcedure
Procedure.i Day64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Extracts the month from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The month part of the date/time
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\bDay
EndProcedure
Procedure.i Hour64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Extracts the hour from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The hour part of the date/time
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\bHour
EndProcedure
Procedure.i Minute64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Extracts the minute from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The minute part of the date/time
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\bMinutes
EndProcedure
Procedure.i Second64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Extracts the second from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The second part of the date/time
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\bSeconds
EndProcedure
Procedure.i DayOfYear64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Returns the number of the day of a year from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The number of the day
; |Remarks : 1st Jan. = 1, 2nd Jan. = 2 ... 5th Feb. = 36 and so on
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\wYDay
EndProcedure
Procedure.i DayOfWeek64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Returns the number of the day of a week from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The number of the day
; |Remarks : Sunday = 0, Monday = 1 ... Saturday = 6
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
ProcedureReturn stvDate64Info\bWeekDay
EndProcedure
Procedure.i DaysInMonth(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Returns the number of days of a month from a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : Number of days in the given month
; |Remarks : -
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info
Init()
Date64Info(@stvDate64Info, qDate64)
If stvDate64Info\bMonth = 2
ProcedureReturn 28 + IsLeapYear64(stvDate64Info\wYear)
Else
ProcedureReturn (30 + stvDate64Info\bMonth & 1) ! (stvDate64Info\bMonth >> 3)
EndIf
EndProcedure
Procedure.i DayFromYMW64(iYear.i, iMonth.i, iWeekday.i, iWeekInMonth.i)
; +-----------------------------------------------------------------
; |Description : Returns the day of a month, specified by year, month, weekday and no. of week in the month
; |Arguments : iYear : The year of a specific date
; | : iMonth : The month of a specific date
; | : iWeekday : The numbr of the weekday of a specific date (sunday = 0, monday = 1, tuesday = 2 and so on)
; | : iWeekInMonth: The weeknumber within the month of a specific date (weeknumber = 1, 2, 3, 4 or 5)
; |Results : The day of the month in a specified date
; |Remarks : Returns -1 if the parameters result in a invalid day (e.g. 2015, 12, 7, 5)
; +-----------------------------------------------------------------
; | Example for the 17th Dec. 2015:
; |
; | .-------------.
; | |December 2015|
; | |-------+----+----+----+----+----+----+----.
; | |Weekday| 1 | 2 | 3 |*4**| 5 | 6 | 7 |
; | |-------+----+----+----+----+----+----+----|
; | | Week |Mon |Tue |Wed |Thu |Fri |Sat |Sun |
; | |-------+----+----+----+----+----+----+----|
; | | 1 | | 1 | 2 | 3 | 4 | 5 | 6 |
; | | 2 | 7 | 8 | 9 | 10 | 11 | 12 | 13 |
; | |**3****| 14 | 15 | 16 |*17*| 18 | 19 | 20 |
; | | 4 | 21 | 22 | 23 | 24 | 25 | 26 | 27 |
; | | 5 | 28 | 29 | 30 | 31 | | | |
; | '-------+----+----+----+----+----+----+----'
; |
; | The 17th Dec. 2015 is represented by:
; | Year = 2015
; | Month = 12
; | Weekday = 4
; | Week in month = 3
; |
; | So DayFromYMW(2015, 12, 4, 3) will return 17
; +-----------------------------------------------------------------
Protected stvDate64Info.stDate64Info, qDate.q = Date64(iYear, iMonth)
Init()
Date64Info(@stvDate64Info, qDate)
qDate = Date64(stvDate64Info\wYear, stvDate64Info\bMonth, stvDate64Info\bDay + (iWeekday - stvDate64Info\bWeekDay + 7) % 7 + iWeekInMonth * 7 - 7)
Date64Info(@stvDate64Info, qDate)
If stvDate64Info\bMonth = iMonth
ProcedureReturn stvDate64Info\bDay
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure.i WeekOfYear64(qDate64.q)
; +-----------------------------------------------------------------
; |Description : Returns the week number of the year in a given date/time
; |Arguments : qDate64: The 64 bit date/time value
; |Results : The number of the week (1 ... 52/53 per year)
; |Remarks : This function works in accordance with the ISO standard "ISO 8601"
; +-----------------------------------------------------------------
Protected.i iWeek1_prev, iWeek1_this, iWeek1_next, iYear = Year64(qDate64)
Protected.i iDays = qDate64 / 86400 + $afaa8
Init()
iWeek1_prev = Date64_LookupTable(iYear - 1)
iWeek1_prev = (iWeek1_prev >> 8) + 3 - (iWeek1_prev >> 5 & 7 + 2) % 7
iWeek1_this = Date64_LookupTable(iYear)
iWeek1_this = (iWeek1_this >> 8) + 3 - (iWeek1_this >> 5 & 7 + 2) % 7
iWeek1_next = Date64_LookupTable(iYear + 1)
iWeek1_next = (iWeek1_next >> 8) + 3 - (iWeek1_next >> 5 & 7 + 2) % 7
If iDays < iWeek1_this
ProcedureReturn (iDays - iWeek1_prev) / 7 + 1
ElseIf iDays >= iWeek1_next
ProcedureReturn 1
Else
ProcedureReturn (iDays - iWeek1_this) / 7 + 1
EndIf
EndProcedure
Procedure.i IsLeapYear64(iYear.i)
; +-----------------------------------------------------------------
; |Description : Returns #True if a given year is a leapyear
; |Arguments : iYear: The value of the Year (e.g. 2015)
; |Results : #True if the year is a leapyear otherwise #False
; |Remarks : -
; +-----------------------------------------------------------------
Init()
ProcedureReturn Date64_LookupTable(iYear) >> 4 & 1
EndProcedure
Procedure.s FormatDate64(sMask.s, qDate64.q)
; +-----------------------------------------------------------------
; |Description : Returns a formatted date/time string
; |Arguments : sMask : The mask string that defines the formatting of the date/time (%yyyy %mm %dd / %hh %ii %ss)
; | : qDate64: The 64 bit date/time value
; |Results : The formatted date/time string
; |Remarks : This function works similar to the FormateDate() function of PureBasic
; | For more help consult the PureBasic helpfile
; +-----------------------------------------------------------------
Protected *Date64_CharArray.arrDate64_CharArray = @sMask
Protected.i iArrayReadPos, iArrayWritePos, iTokenLength, stvDate64Info.stDate64Info, c1.c, c2.c, c.c = *Date64_CharArray\c[0]
Init()
Date64Info(@stvDate64Info, qDate64)
While c
If c = 37; %
c1 = *Date64_CharArray\c[iArrayReadPos + 1]
If c1
c1 | 32 : c2 = *Date64_CharArray\c[iArrayReadPos + 2] | 32
If c1 = c2
Select c1
Case 121; yy
iTokenLength = 2 : c1 = *Date64_CharArray\c[iArrayReadPos + 3]
If c1
c1 | 32 : c2 = *Date64_CharArray\c[iArrayReadPos + 4] | 32
If c1 = 121 And c2 = 121 : iTokenLength = 4 : EndIf
EndIf
FormatDate64_Set(@*Date64_CharArray\c[iArrayWritePos], stvDate64Info\wYear, iTokenLength) : iArrayWritePos + iTokenLength : iArrayReadPos + iTokenLength + 1
Case 109; mm
FormatDate64_Set(@*Date64_CharArray\c[iArrayWritePos], stvDate64Info\bMonth) : iArrayWritePos + 2 : iArrayReadPos + 3
Case 100; dd
FormatDate64_Set(@*Date64_CharArray\c[iArrayWritePos], stvDate64Info\bDay) : iArrayWritePos + 2 : iArrayReadPos + 3
Case 104; hh
FormatDate64_Set(@*Date64_CharArray\c[iArrayWritePos], stvDate64Info\bHour) : iArrayWritePos + 2 : iArrayReadPos + 3
Case 105; ii
FormatDate64_Set(@*Date64_CharArray\c[iArrayWritePos], stvDate64Info\bMinutes) : iArrayWritePos + 2 : iArrayReadPos + 3
Case 115; ss
FormatDate64_Set(@*Date64_CharArray\c[iArrayWritePos], stvDate64Info\bSeconds) : iArrayWritePos + 2 : iArrayReadPos + 3
Default
*Date64_CharArray\c[iArrayWritePos] = c : iArrayWritePos + 1 : iArrayReadPos + 1
EndSelect
EndIf
EndIf
Else
*Date64_CharArray\c[iArrayWritePos] = c : iArrayWritePos + 1 : iArrayReadPos + 1
EndIf
c = *Date64_CharArray\c[iArrayReadPos]
Wend
*Date64_CharArray\c[iArrayWritePos] = 0
ProcedureReturn sMask
EndProcedure
;-
Procedure.q GetDateGadget64(iGadget.i)
; +-----------------------------------------------------------------
; |Description : Returns the 64 bit date/time value of the selected date/time of a DateGadget
; |Arguments : iGadget: Number of the DateGadget
; |Results : The 64 bit date/time value of the gadget
; |Remarks : This procedure only works on Windows, on other OS it returns -1
; +-----------------------------------------------------------------
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Protected.i iGadgetType
Protected.q qDate64
Protected stvDateTime.SYSTEMTIME
iGadgetType = GadgetType(iGadget)
If iGadgetType = #PB_GadgetType_Date
If SendMessage_(GadgetID(iGadget), #DTM_GETSYSTEMTIME, 0, @stvDateTime) = #GDT_VALID
ProcedureReturn Date64(stvDateTime\wYear, stvDateTime\wMonth, stvDateTime\wDay, stvDateTime\wHour, stvDateTime\wMinute, stvDateTime\wSecond)
EndIf
ElseIf iGadgetType = #PB_GadgetType_Calendar
If SendMessage_(GadgetID(iGadget), #MCM_GETCURSEL, 0, @stvDateTime) <> 0
ProcedureReturn Date64(stvDateTime\wYear, stvDateTime\wMonth, stvDateTime\wDay, 0, 0, 0)
EndIf
EndIf
ProcedureReturn -1
CompilerElse
ProcedureReturn -1
CompilerEndIf
EndProcedure
Procedure.i SetDateGadget64(iGadget.i, qDate64.q)
; +-----------------------------------------------------------------
; |Description : Returns the 64 bit date/time value of the selected date/time of a DateGadget
; |Arguments : iGadget: Number of the DateGadget
; | : qDate64: A 64 bit date/time value whose is to be set to the gadget
; |Results : #False if an error occurs, otherwise #True
; |Remarks : This procedure only works on Windows, on other OS it returns -1
; +-----------------------------------------------------------------
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Protected.i iGadgetType
Protected stvDateTime.SYSTEMTIME
stvDateTime\wYear = Year64(qDate64)
stvDateTime\wMonth = Month64(qDate64)
stvDateTime\wDay = Day64(qDate64)
stvDateTime\wHour = Hour64(qDate64)
stvDateTime\wMinute = Minute64(qDate64)
stvDateTime\wSecond = Second64(qDate64)
stvDateTime\wMilliseconds = 0
stvDateTime\wDayOfWeek = DayOfWeek64(qDate64)
iGadgetType = GadgetType(iGadget)
If iGadgetType = #PB_GadgetType_Date
If SendMessage_(GadgetID(iGadget), #DTM_SETSYSTEMTIME, 0, @stvDateTime) = #GDT_VALID
ProcedureReturn #True
EndIf
ElseIf iGadgetType = #PB_GadgetType_Calendar
If SendMessage_(GadgetID(iGadget), #MCM_SETCURSEL, 0, @stvDateTime) <> 0
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
CompilerElse
ProcedureReturn #False
CompilerEndIf
EndProcedure
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure EnableDateGadgetEvent64()
; +-----------------------------------------------------------------
; |Description : Enables a window callback procedure for generating the #PB_EventType_Calendar_Change Event on date changes
; |Arguments : -
; |Results : -
; |Remarks : This procedure only works on Windows
; +-----------------------------------------------------------------
SetWindowCallback(@Date64Callback())
EndProcedure
Procedure DisableDateGadgetEvent64()
; +-----------------------------------------------------------------
; |Description : Enables a window callback procedure for generating the #PB_EventType_Calendar_Change Event on date changes
; |Arguments : -
; |Results : -
; |Remarks : This procedure only works on Windows
; +-----------------------------------------------------------------
SetWindowCallback(0)
EndProcedure
CompilerEndIf
EndModule
;- *************************************************************************
;- Example code
;- *************************************************************************
CompilerIf #PB_Compiler_IsMainFile
UseModule Date64
Debug "PB nativ: Today is :" + FormatDate("%yyyy.%mm.%dd", Date()) + " - Day of the Week is: " + Str(DayOfWeek(Date())) + " (0 = sunday, 1 = monday, 2 = tuesday etc.)"
Debug "Date64 : Today is :" + FormatDate64("%yyyy.%mm.%dd", Date64()) + " - Day of the Week is: " + Str(DayOfWeek64(Date64())) + " (0 = sunday, 1 = monday, 2 = tuesday etc.)"
Debug ""
Debug "PB nativ: 1st January 1600 = " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", Date(1600,1,1,0,0,0))
Debug "Date64 : 1st January 1600 = " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", Date64(1600,1,1,0,0,0))
Debug "PB nativ: 5th December 2041 = " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", Date(2041,12,5,0,0,0))
Debug "Date64 : 5th December 2041 = " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", Date64(2041,12,5,0,0,0))
Debug "PB nativ: 20th August 1971 = " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", Date(1971,8,20,0,0,0))
Debug "Date64 : 20th August 1971 = " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", Date64(1971,8,20))
Procedure GetDateGadget()
SetGadgetText(6, "")
AddGadgetItem(6, -1, "--- Date Gadget ---")
AddGadgetItem(6, -1, "PB-Date: " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", GetGadgetState(1)))
AddGadgetItem(6, -1, "Date64 : " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", GetDateGadget64(1)))
AddGadgetItem(6, -1, "Days in Month: " + DaysInMonth(GetDateGadget64(1)))
EndProcedure
Procedure GetCalendarGadget()
SetGadgetText(6, "")
AddGadgetItem(6, -1, "--- Calendar Gadget ---")
AddGadgetItem(6, -1, "PB-Date: " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", GetGadgetState(0)))
AddGadgetItem(6, -1, "Date64 : " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", GetDateGadget64(0)))
AddGadgetItem(6, -1, "Days in Month: " + DaysInMonth(GetDateGadget64(0)))
EndProcedure
Procedure GetDates()
SetGadgetText(6, "")
AddGadgetItem(6, -1, "--- Date Gadget ---")
AddGadgetItem(6, -1, "PB-Date: " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", GetGadgetState(1)))
AddGadgetItem(6, -1, "Date64 : " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", GetDateGadget64(1)))
AddGadgetItem(6, -1, "Days in Month: " + DaysInMonth(GetDateGadget64(1)))
AddGadgetItem(6, -1, "")
AddGadgetItem(6, -1, "--- Calendar Gadget ---")
AddGadgetItem(6, -1, "PB-Date: " + FormatDate("%yyyy.%mm.%dd %hh:%ii:%ss", GetGadgetState(0)))
AddGadgetItem(6, -1, "Date64 : " + FormatDate64("%yyyy.%mm.%dd %hh:%ii:%ss", GetDateGadget64(0)))
AddGadgetItem(6, -1, "Days in Month: " + DaysInMonth(GetDateGadget64(0)))
EndProcedure
If OpenWindow(0, #PB_Ignore, #PB_Ignore, 550, 250, "Date64 Module by Wilbert", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
CalendarGadget(0, 10, 10, 230, 230)
DateGadget(1, 250, 10, 120, 20, "%dd %mm %yyyy", Date())
ButtonGadget(5, 250, 40, 120, 25, "Get both dates")
EditorGadget(6, 250, 80, 290, 160, #PB_Editor_ReadOnly)
SetDateGadget64(0, Date64(2037, 12 ,1 ,0 ,0 ,0))
SetDateGadget64(1, Date64(2037, 12 ,1 ,0 ,0 ,0))
EnableDateGadgetEvent64()
BindGadgetEvent(0, @GetCalendarGadget(), #PB_EventType_Change)
BindGadgetEvent(1, @GetDateGadget(), #PB_EventType_Change)
BindGadgetEvent(5, @GetDates(), #PB_EventType_LeftClick)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
UnbindGadgetEvent(0, @GetCalendarGadget(), #PB_EventType_Change)
UnbindGadgetEvent(1, @GetDateGadget(), #PB_EventType_Change)
UnbindGadgetEvent(5, @GetDates(), #PB_EventType_LeftClick)
DisableDateGadgetEvent64()
EndIf
UnuseModule Date64
CompilerEndIf
