It is currently Sat Dec 16, 2017 7:34 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 28 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Some date functions supporting also dates prior to 1970
PostPosted: Sat Aug 17, 2013 5:45 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3009
Location: Netherlands
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)
DaysInMonth(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.05 2016/08/24 ***


; *** Structures ***

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


; *** 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]
    !imul rcx, 60
    !add rcx, [p.v_min]
    !imul rcx, 60
    !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]
    !imul ecx, 60
    !add ecx, [p.v_min]
    !imul ecx, 60
    !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 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

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)
  Static Months.s = "JanFebMarAprMayJunJulAugSepOctNovDec"
  Static Weekdays.s = "SunMonTueWedThuFriSat"
  Protected *a.DateQ_CharArray = @Mask$
  Protected.i p, f, r, w, l, I.DateQInfo, c1.c, c2.c, c.c = *a\c[0]
  DateQInfo(@I, DateQ)
  While c
    p = w
    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 / yyyy
              l = 2
              If *a\c[r + 3] | 32 = c1
                If *a\c[r + 4] | 32 = c1 : l = 4 : EndIf
              EndIf
              FormatDateQ_Set(@*a\c[w], I\year, l) : w + l : r + l + 1
            Case 109; mm / mmm
              If *a\c[r + 3] | 32 = c1
                PokeS(@*a\c[w], Mid(Months, I\month * 3 - 2, 3)) : w + 3 : r + 4
              Else
                FormatDateQ_Set(@*a\c[w], I\month) : w + 2 : r + 3
              EndIf
            Case 100; dd / ddd
              If *a\c[r + 3] | 32 = c1
                PokeS(@*a\c[w], Mid(Weekdays, I\wday * 3 + 1, 3)) : w + 3 : r + 4
              Else
                FormatDateQ_Set(@*a\c[w], I\day) : w + 2 : r + 3
              EndIf
            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
          EndSelect
        EndIf
      EndIf
    EndIf
    If p = w
      *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

_________________
MacOS 10.13.1 High Sierra, PB 5.60 x64


Last edited by wilbert on Thu Aug 25, 2016 11:27 am, edited 8 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sat Aug 17, 2013 11:29 pm 
Offline
Addict
Addict
User avatar

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3228
Location: New Zealand
Quote:
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:


Wouldn't have it any other way, after all examples are much easier to learn from!

Thanks

_________________
Got winter blues?
Enjoy a Caravan Trip into, "The Land of Grey and Pink", wine and punk weed optional!
https://www.youtube.com/watch?v=D5iX9YhCCp8


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 18, 2013 12:14 am 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2736
Location: Southwest OH - USA
Nice (and fast.)
Many thanks for sharing :D

cheers


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 18, 2013 6:41 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3009
Location: Netherlands
Thanks :)

I added another procedure named DayFromYMW .
Code:
Debug DayFromYMW(2013, 9, 1, 5)

The line of code above will return 30 (the 5th monday of september 2013).
The procedure allows you to find out on what day for example the second sunday of a month is.

_________________
MacOS 10.13.1 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 18, 2013 6:49 am 
Online
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1465
Location: Uttoxeter, UK
Very nice!
Thank you for sharing.

Thanks also for another ASM tutorial! :D

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 18, 2013 10:38 am 
Offline
Enthusiast
Enthusiast

Joined: Tue May 26, 2009 2:11 pm
Posts: 454
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.

_________________
I'm an official dummy!
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 18, 2013 11:16 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3009
Location: Netherlands
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 :D

_________________
MacOS 10.13.1 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sat Aug 30, 2014 6:03 pm 
Offline
New User
New User

Joined: Sun Oct 04, 2009 10:58 pm
Posts: 9
Location: Trying to jump the border into USA
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!!


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sat Aug 30, 2014 7:45 pm 
Online
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1465
Location: Uttoxeter, UK
@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. :D

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 31, 2014 5:35 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3009
Location: Netherlands
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 ?

_________________
MacOS 10.13.1 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 31, 2014 6:30 am 
Online
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1465
Location: Uttoxeter, UK
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:

Quote:
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:
; 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())

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 31, 2014 7:16 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3009
Location: Netherlands
@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.

_________________
MacOS 10.13.1 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 31, 2014 8:49 am 
Online
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1465
Location: Uttoxeter, UK
@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. :D

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Sun Aug 31, 2014 11:21 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3009
Location: Netherlands
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.

_________________
MacOS 10.13.1 High Sierra, PB 5.60 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Some date functions supporting also dates prior to 1970
PostPosted: Fri Dec 18, 2015 6:09 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jun 11, 2006 12:07 am
Posts: 355
Location: Germany / one of the fishheads
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:
;
;  *************************************************************************
;  * 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

_________________
Sorry, my english knowledge is limited, but I hope it is adequate to understand what is meant.
PB 5.60, OS: Windows 7 Pro x64, CPU: I7 6500, RAM: 8 GB, GPU: Intel Graphics HD 520
"Happiness is a pet, not a road or destination" ;-)


Last edited by kurzer on Sun Jul 30, 2017 10:34 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 28 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: davido and 9 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  
cron

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye