Some date functions supporting also dates prior to 1970

Lord · Post by **Lord** » Sun Aug 18, 2013 10:38 am

Hello wilbert!

Thank you for this nice piece of code.

One thing I have to mention:
You assume, that 15.10.1582 was a friday.
But this is not allways true as the gregorian calendar took
place on this date only in roman catholic parts of europe.
(after Thursday 04.10.1582 followed Friday 15.10.1582)
In other parts the "new" calendar was introduced
Thursday 18.02.1700 followed Friday 01.03.1700 in protestant parts of europe,
Saturday 02.09.1752 followed Sunday 14.09.1752 in Great Britain,
Saturday 17.02.1753 followed Sunday 01.03.1753 in Sweden
in Russia after October Revolution in November 1917
in Greece in 1923

So users should take caution in using a datum in these times.

wilbert · Post by **wilbert** » Sun Aug 18, 2013 11:16 am

Lord wrote:You assume, that 15.10.1582 was a friday.
But this is not allways true as the gregorian calendar took
place on this date only in roman catholic parts of europe.

Thanks for all the background information . Nice to know

PrietoM · Post by **PrietoM** » Sat Aug 30, 2014 6:03 pm

I am a newcomer to PureBasic from Python and I just wanted to let you know that dates prior to Epoch were holding a project I wanted to bring to PureBasic. Thanks for the DateQ program. It is fast and works like a charm!!

davido · Post by **davido** » Sat Aug 30, 2014 7:45 pm

@wilbert,

I tried to convert this to a module.
Unfortunately it kept giving errors.
Never did succeed in getting it to work.

Anyhow your original works very well. Thanks again.

wilbert · Post by **wilbert** » Sun Aug 31, 2014 5:35 am

Nice to hear it is useful

davido wrote:I tried to convert this to a module.
Unfortunately it kept giving errors.

Can you tell me what went wrong ?

davido · Post by **davido** » Sun Aug 31, 2014 6:30 am

wilbert wrote: Can you tell me what went wrong ?

I've added quite a few ASM examples to Modules before, without any apparent problem.
Using the same MO with your code I get these errors on Mac:

PureBasic - Assembler error

purebasic.asm:954 error: undefined symbol ‘a_dateQ_LUT’ (first use)
purebasic.asm:954 error: (Each undefined symbol is reported only once.)
purebasic.asm:1496 error: undefined symbol ‘a_dateQ_LUT2’ (first use)

I get similar errors on Windows 7. Using 64bit PureBasic 5.30 on 64 bit OS

It is probably something very simple that I don't understand about Modules. I list your now 'mangled code' below:

Code: Select all

; http://www.purebasic.fr/english/viewtopic.php?p=421612#p421612
By: wilbert


DeclareModule QDate
  
Structure DateQInfo
  yday.w    ; offset 0    : days since Jan 1 [1-366]
  year.w    ; offset 2    : year [1600-9999]   
  month.b   ; offset 4    : months [1-12]
  day.b     ; offset 5    : day of the month [1-31]
  hour.b    ; offset 6    : hours [0-23]
  min.b     ; offset 7    : minutes [0-59]
  sec.b     ; offset 8    : seconds [0-59]
  wday.b    ; offset 9    : days since Sunday [0-6]
EndStructure

Structure DateQ_CharArray
  c.c[0]
EndStructure 

  Declare.q DateQ(year, month = 1, day = 1, hour = 0, min = 0, sec = 0)
  Declare DateQInfo(*Info.DateQInfo, DateQ.q)
  Declare IsLeapYear(Year) 
  Declare YearQ(DateQ.q) 
  Declare MonthQ(DateQ.q) 
  Declare DayQ(DateQ.q)
  Declare HourQ(DateQ.q)
  Declare MinuteQ(DateQ.q)
  Declare SecondQ(DateQ.q)
  Declare DayOfWeekQ(DateQ.q)
  Declare DayOfYearQ(DateQ.q)
  Declare.q AddDateQ(DateQ.q, Type, Value)
EndDeclareModule

Module QDate
; 
; 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 :
; DateQ(year, month, day, hour, min, sec)
; DateQInfo(*Info.DateQInfo, DateQ.q)
; 
; AddDateQ(DateQ.q, Type, Value)
; DayFromYMW(Year, Month, Weekday, n)
; DayOfWeekQ(DateQ.q)
; DayOfYearQ(DateQ.q)
; DayQ(DateQ.q)
; FormatDateQ(Mask$, DateQ.q)
; HourQ(DateQ.q)
; IsLeapYear(Year)
; MinuteQ(DateQ.q)
; MonthQ(DateQ.q)
; SecondQ(DateQ.q)
; WeekISO(DateQ.q)
; YearQ(DateQ.q)

Code:
; *** DateQ.pbi   v 1.03 2013/08/18 ***


; *** Structures ***




; *** Create lookup tables (about 65 KiB) ***

Global Dim DateQ_LUT.l(16384)
Global Dim DateQ_LUT2.w(2024)

Procedure DateQ_LUT_Init()
  Protected.i y, y_, d, d_, w, m
  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
    DateQ_LUT(y - 1) |  y_ << 4
    DateQ_LUT(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
        DateQ_LUT2(y) = w : y + 1
        DateQ_LUT2(y_) = w : y_ + 1
      Next
      DateQ_LUT2(y_) = 2 | 29 << 8 : y_ + 1
    Else
      d_ = 30 + (m & 1) ! (m >> 3)
      For d = 1 To d_
        w = m | d << 8
        DateQ_LUT2(y) = w : y + 1
        DateQ_LUT2(y_) = w : y_ + 1
      Next
    EndIf
  Next
EndProcedure

DateQ_LUT_Init()


; *** ASM procedures ***

Procedure.q DateQ(year, month = 1, day = 1, hour = 0, min = 0, sec = 0)
  !mov ecx, [p.v_year]
  !and ecx, 16383
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov rdx, [a_DateQ_LUT]
    !mov eax, [rdx + rcx * 4]
    !mov rcx, [p.v_month]
    !or rcx, rax
    !and rcx, 31
    !lea rdx, [dateq_oday_table]
    !movsx rcx, word [rdx + rcx * 2]
    !shr rax, 8
    !add rax, rcx
    !add rax, [p.v_day]
    !sub rax, 0xafaa9
    !imul rax, 86400
    !mov rcx, [p.v_hour]
    !lea rcx, [rcx + rcx * 4]; *5
    !lea rcx, [rcx + rcx * 2]; *3
    !sal rcx, 2; *4
    !add rcx, [p.v_min]
    !lea rcx, [rcx + rcx * 4]; *5
    !lea rcx, [rcx + rcx * 2]; *3
    !sal rcx, 2; *4
    !add rcx, [p.v_sec]
    !add rax, rcx
  CompilerElse
    !mov edx, [a_DateQ_LUT]
    !mov eax, [edx + ecx * 4]
    !mov ecx, [p.v_month]
    !or ecx, eax
    !and ecx, 31
    !movsx ecx, word [dateq_oday_table + ecx * 2]
    !shr eax, 8
    !add eax, ecx
    !add eax, [p.v_day]
    !sub eax, 0xafaa9
    !mov ecx, 86400
    !imul ecx
    !mov ecx, [p.v_hour]
    !lea ecx, [ecx + ecx * 4]; *5
    !lea ecx, [ecx + ecx * 2]; *3
    !sal ecx, 2; *4
    !add ecx, [p.v_min]
    !lea ecx, [ecx + ecx * 4]; *5
    !lea ecx, [ecx + ecx * 2]; *3
    !sal ecx, 2; *4
    !add ecx, [p.v_sec]
    !add eax, ecx
    !adc edx, 0
    !sar ecx, 31
    !add edx, ecx
  CompilerEndIf  
  ProcedureReturn
  !dateq_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 DateQInfo(*Info.DateQInfo, DateQ.q)
  !mov eax, [p.v_DateQ]
  !mov edx, [p.v_DateQ + 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_Info]
    !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, [a_DateQ_LUT]
    !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, [a_DateQ_LUT2]
    !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; wday
  CompilerElse
    !mov ecx, [p.p_Info]
    !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, [a_DateQ_LUT]
    !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, [a_DateQ_LUT2]
    !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; wday
    !pop ebx
    !pop edi
  CompilerEndIf
EndProcedure


; *** Non ASM procedures ***

Procedure IsLeapYear(Year)
  ProcedureReturn DateQ_LUT(Year) >> 4 & 1
EndProcedure

Procedure YearQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\year
EndProcedure

Procedure MonthQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\month
EndProcedure

Procedure DayQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\day
EndProcedure

Procedure HourQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\hour
EndProcedure

Procedure MinuteQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\min
EndProcedure

Procedure SecondQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\sec
EndProcedure

Procedure DayOfWeekQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\wday
EndProcedure

Procedure DayOfYearQ(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ) : ProcedureReturn I\yday
EndProcedure

Procedure.q AddDateQ(DateQ.q, Type, Value)
  Protected I.DateQInfo, D.q
  Select Type
    Case #PB_Date_Year
      DateQInfo(@I, DateQ) : I\year + Value
      If I\month = 2 And I\yday = 60
        If IsLeapYear(I\year) = 0 : I\day = 28 : EndIf  
      EndIf
      DateQ = DateQ(I\year, I\month, I\day, I\hour, I\min, I\sec)
    Case #PB_Date_Month
      DateQInfo(@I, DateQ) : I\month + Value
      While I\month < 1 : I\year - 1 : I\month + 12 : Wend 
      While I\month > 12 : I\year + 1 : I\month - 12 : Wend 
      DateQ = DateQ(I\year, I\month, I\day, I\hour, I\min, I\sec)
      D = DateQ(I\year, I\month + 1, 0, I\hour, I\min, I\sec)
      If DateQ > D : DateQ = D : EndIf
    Case #PB_Date_Week : DateQ + Value * 604800
    Case #PB_Date_Day : DateQ + Value * 86400
    Case #PB_Date_Hour : DateQ + Value * 3600
    Case #PB_Date_Minute : DateQ + Value * 60
    Case #PB_Date_Second : DateQ + Value
  EndSelect
  ProcedureReturn DateQ
EndProcedure

Procedure FormatDateQ_Set(*addr.DateQ_CharArray, value, size = 2)
  While size
    size - 1 : *addr\c[size] = $30 | value % 10 : value / 10 
  Wend
EndProcedure

Procedure.s FormatDateQ(Mask$, DateQ.q)
  Protected *a.DateQ_CharArray = @Mask$ 
  Protected.i r, w, l, I.DateQInfo, c1.c, c2.c, c.c = *a\c[0]
  DateQInfo(@I, DateQ)
  While c
    If c = 37; %
      c1 = *a\c[r + 1]
      If c1
        c1 | 32 : c2 = *a\c[r + 2] | 32
        If c1 = c2
          Select c1
            Case 121; yy
              l = 2 : c1 = *a\c[r + 3]
              If c1
                c1 | 32 : c2 = *a\c[r + 4] | 32
                If c1 = 121 And c2 = 121 : l = 4 : EndIf
              EndIf
              FormatDateQ_Set(@*a\c[w], I\year, l) : w + l : r + l + 1
            Case 109; mm
              FormatDateQ_Set(@*a\c[w], I\month) : w + 2 : r + 3
            Case 100; dd
              FormatDateQ_Set(@*a\c[w], I\day) : w + 2 : r + 3
            Case 104; hh
              FormatDateQ_Set(@*a\c[w], I\hour) : w + 2 : r + 3
            Case 105; ii
              FormatDateQ_Set(@*a\c[w], I\min) : w + 2 : r + 3
            Case 115; ss
              FormatDateQ_Set(@*a\c[w], I\sec) : w + 2 : r + 3
            Default
              *a\c[w] = c : w + 1 : r + 1
          EndSelect
        EndIf
      EndIf
    Else
      *a\c[w] = c : w + 1 : r + 1
    EndIf
    c = *a\c[r]
  Wend
  *a\c[w] = 0
  ProcedureReturn Mask$
EndProcedure

Procedure WeekISO(DateQ.q)
  Protected.i week1_prev, week1_this, week1_next, y = YearQ(DateQ)
  Protected.i d = DateQ / 86400 + $afaa8
  week1_prev = DateQ_LUT(y - 1)
  week1_prev = (week1_prev >> 8) + 3 - (week1_prev >> 5 & 7 + 2) % 7
  week1_this = DateQ_LUT(y)
  week1_this = (week1_this >> 8) + 3 - (week1_this >> 5 & 7 + 2) % 7
  week1_next = DateQ_LUT(y + 1)
  week1_next = (week1_next >> 8) + 3 - (week1_next >> 5 & 7 + 2) % 7
  If d < week1_this
    ProcedureReturn (d - week1_prev) / 7 + 1
  ElseIf d >= week1_next
    ProcedureReturn 1
  Else  
    ProcedureReturn (d - week1_this) / 7 + 1
  EndIf
EndProcedure

Procedure DayFromYMW(Year, Month, Weekday, n = 1)
  Protected I.DateQInfo, D.q = DateQ(Year, Month)
  DateQInfo(@I, D)
  D = DateQ(I\year, I\month, I\day + (Weekday - I\wday + 7) % 7 + n * 7 - 7)
  DateQInfo(@I, D)
  If I\month = Month
    ProcedureReturn I\day
  Else
    ProcedureReturn -1
  EndIf
EndProcedure
EndModule


QDate::YearQ(Date())

wilbert · Post by **wilbert** » Sun Aug 31, 2014 7:16 am

@Davido,
If you wrap it into a module named QDate, do a search and replace.
Search for a_DateQ_LUT and replace with qdate.a_DateQ_LUT
That should make it work.

davido · Post by **davido** » Sun Aug 31, 2014 8:49 am

@wilbert,

Magic!
Works perfectly, now.

Not sure what you have done or why it works. I guess the penny will drop after a while.

Thank you very much.

wilbert · Post by **wilbert** » Sun Aug 31, 2014 11:21 am

davido wrote:Not sure what you have done or why it works.

The ASM procedures use two lookup tables which are in this case global arrays that are initialized by the DateQ_LUT_Init() procedure.
On the ASM level, global arrays inside a module have a different name compared to those not inside a module. That's why the change is required.

Kurzer · Post by **Kurzer** » Fri Dec 18, 2015 6:09 pm

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.
Many thanks goes also to Davido for converting it to a module.

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.

Some of the comments may not written in good english (as well as this post

), feel free to point me to mistakes.

Greeting Kurzer

Edited on 2017/07/30: Updated my version of Wilberts code. For changes see changelog in the comments.

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

nicolaus · Post by **nicolaus** » Wed Aug 10, 2016 3:47 pm

Hi,

first of all i must say that this one is very nice and mutch better that the native PB date library!
I miss only the ParseDate() function as ParseDate64().
I will be nice if you can add this as well.

Thanks and br,
Nico

wilbert · Post by **wilbert** » Fri Aug 12, 2016 6:41 am

nicolaus wrote:I miss only the ParseDate() function as ParseDate64().
I will be nice if you can add this as well.

I could probably add something similar to ParseDate.
If you need to parse timestamps in the format of yyyymmddhhmmss it would be faster to create a custom procedure for that.

Maybe this helps
http://www.purebasic.fr/english/viewtop ... 35&t=66420

Michael Vogel · Post by **Michael Vogel** » Sun Aug 21, 2016 4:24 pm

Maybe a function 'DaysInMonth' could be added which does something like the following...

Code: Select all

Procedure.i MonthLen(date)

	date=Date(Year(date),Month(date),28,0,0,0)+864000
	ProcedureReturn Day(Date(Year(date),Month(date),1,0,0,0)-86400)

EndProcedure


For i=1 To 12
	Debug MonthLen(Date(2016,i,i,0,0,0))
Next i

wilbert · Post by **wilbert** » Wed Aug 24, 2016 6:45 am

Michael Vogel wrote:Maybe a function 'DaysInMonth' could be added

This should work.

Code: Select all

Procedure DaysInMonth(DateQ.q)
  Protected I.DateQInfo : DateQInfo(@I, DateQ)
  If I\month < 8
    If I\month = 2
      ProcedureReturn 28 + IsLeapYear(I\year)
    Else
      ProcedureReturn 30 + I\month & 1  
    EndIf
  Else
    ProcedureReturn 31 - I\month & 1 
  EndIf
EndProcedure

Michael Vogel · Post by **Michael Vogel** » Thu Aug 25, 2016 8:12 am

wilbert wrote: This should work.

...
Thanks...

Code: Select all

Procedure DaysInMonth(DateQ.q)
	
	Protected I.DateQInfo : DateQInfo(@I, DateQ)
	
	If I\month = 2
		ProcedureReturn 28 + IsLeapYear(I\year)
	Else
		ProcedureReturn (30 + I\month & 1) ! (I\month>>3)
	EndIf

EndProcedure

PureBasic Forums - English

Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970

Re: Some date functions supporting also dates prior to 1970