Date()-Functions with Millisecond Precision [Win only]

Share your advanced PureBasic knowledge/code with the community.
Post Reply
PureLust
Enthusiast
Enthusiast
Posts: 477
Joined: Mon Apr 16, 2007 3:57 am
Location: Germany, NRW

Date()-Functions with Millisecond Precision [Win only]

Post by PureLust »

I needed some TimeStamp-Functions with millisecond Precision and found some inspiration in this thread.
So I made a few Date()-equivalent Functions for this purpose.

The advantage over native Functions using PBs Date()-Format:
- millisecond Precision
- does support Year < 1970 and >2037
- additional Functions to get Weekday (Sunday, Monday, ...)
- additional Token-Support in msFormatDate() - %ms = milliseconds, %wday = Weekday (long Version), %wd = Weekday (short Version)

Included Functions:

Code: Select all

msDate([Year, Month, Day, Hour, Minute, Second, Millisecond])  -  returns the Millisecond-TimeStamp for the actual or the given date/time   -  equivalent To PBs Date()
	
msYear(msDate)           - returns the Year        of the given msDate()-TimeStamp   -  equivalent To PBs Year(Date)
msMonth(msDate)          - returns the Month       of the given msDate()-TimeStamp   -  equivalent To PBs Month(Date)
msDay(msDate)            - returns the Day         of the given msDate()-TimeStamp   -  equivalent To PBs Day(Date)
msHour(msDate)           - returns the Hour        of the given msDate()-TimeStamp   -  equivalent To PBs Hour(Date)
msMinute(msDate)         - returns the Minute      of the given msDate()-TimeStamp   -  equivalent To PBs Minute(Date)
msSecond(msDate)         - returns the Second      of the given msDate()-TimeStamp   -  equivalent To PBs Second(Date)
msMilliSeconds(msDate)   - returns the Millisecond of the given msDate()-TimeStamp

msDate_to_Date(msDate)         - konverts msDate()-TimeStamp into   Date()-Format
Date_to_msDate(Date)           - converts   Date()-Format    into msDate()-TimeStamp

msDayOfWeek(msDate)            - returns Day of the Week   -  equivalent To PBs DayOfWeek(Date)
msDayOfYear(msDate)            - returns Day of the Year   -  equivalent To PBs DayOfYear(Date)

msWeekday(msDate)              - returns the Weekday in short form (first 3 characters - e.g. Sun, Mon, Thu, ...)
msWeekdayLong(msDate)          - returns the Weekday in long  form (e.g. Sunday, Monday, Thuesday, ...)
msWeekdayGER(msDate)           - returns short Weekday in german language (first 2 characters - e.g. So, Mo, Di, ...)
msWeekdayGERLong(msDate)       - returns long  Weekday in german language (e.g. Sonntag, Montag, Dienstag, ...)

msFormatDate(Mask$, msDate)    - equivalent To PBs FormatDate(), but With additional Tokens:
                                 %ms    - milliseconds With 3 digits
                                 %wday  - Weekday  (long  Version)
                                 %wd    - Weekday  (short Version)
Code:

Code: Select all

Enumeration    msDate_Parts
   #msDate_MilliSeconds
   #msDate_Seconds
   #msDate_Minutes
   #msDate_Hours
   #msDate_Day
   #msDate_Month
   #msDate_Year
EndEnumeration

CompilerIf   #False   ; Procedure msDate()
   Procedure.q msDate([Year, Month, Day, Hour, Minute, Second, Millisecond])            ; Dummy-Declaration to get a better Help-Text in Status-Line for this Procedure
CompilerElse   ;}
   Procedure.q msDate(_Year=#PB_Ignore, _Month=#PB_Ignore, _Day=#PB_Ignore, _Hour=#PB_Ignore, _Minute=#PB_Ignore, _Second=#PB_Ignore, _MilliSecond=#PB_Ignore)
CompilerEndIf

   Protected d.SYSTEMTIME
   GetLocalTime_(@d)
   
   Protected mMilliseconds   =   1
   Protected mSecond         =   mMilliseconds   * 1000
   Protected mMinute         =   mSecond         * 60
   Protected mHour           =   mMinute         * 60
   Protected mDay            =   mHour           * 24
   Protected mMonth          =   mDay            * 32
   Protected mYear           =   mMonth          * 13
   
   Protected msTimeSTamp
   
   If _Year          = #PB_Ignore   : msTimeSTamp   +   d\wYear           * mYear    : Else : msTimeSTamp   +   _Year          * mYear    : EndIf
   If _Month         = #PB_Ignore   : msTimeSTamp   +   d\wMonth          * mMonth   : Else : msTimeSTamp   +   _Month         * mMonth   : EndIf
   If _Day           = #PB_Ignore   : msTimeSTamp   +   d\wDay            * mDay     : Else : msTimeSTamp   +   _Day           * mDay     : EndIf
   If _Hour          = #PB_Ignore   : msTimeSTamp   +   d\wHour           * mHour    : Else : msTimeSTamp   +   _Hour          * mHour    : EndIf
   If _Minute        = #PB_Ignore   : msTimeSTamp   +   d\wMinute         * mMinute  : Else : msTimeSTamp   +   _Minute        * mMinute  : EndIf
   If _Second        = #PB_Ignore   : msTimeSTamp   +   d\wSecond         * mSecond  : Else : msTimeSTamp   +   _Second        * mSecond  : EndIf
   If _MilliSecond   = #PB_Ignore   : msTimeSTamp   +   d\wMilliseconds              : Else : msTimeSTamp   +   _MilliSecond              : EndIf
   
   ProcedureReturn msTimeSTamp
   
EndProcedure
Procedure   GetmsDatePart(msDate.q, msDate_Part)
   
   Protected mMilliseconds   =   1
   Protected mSecond         =   mMilliseconds   * 1000
   Protected mMinute         =   mSecond         * 60
   Protected mHour           =   mMinute         * 60
   Protected mDay            =   mHour           * 24
   Protected mMonth          =   mDay            * 32
   Protected mYear           =   mMonth          * 13
   
   Protected TimeStamp       =   msDate
   
   Protected _Year           =   Int(TimeStamp   / mYear)     : TimeStamp - mYear        * _Year      : If msDate_Part   = #msDate_Year          : ProcedureReturn _Year          : EndIf
   Protected _Month          =   Int(TimeStamp   / mMonth)    : TimeStamp - mMonth       * _Month     : If msDate_Part   = #msDate_Month         : ProcedureReturn _Month         : EndIf
   Protected _Day            =   Int(TimeStamp   / mDay)      : TimeStamp - mDay         * _Day       : If msDate_Part   = #msDate_Day           : ProcedureReturn _Day           : EndIf
   Protected _Hour           =   Int(TimeStamp   / mHour)     : TimeStamp - mHour        * _Hour      : If msDate_Part   = #msDate_Hours         : ProcedureReturn _Hour          : EndIf
   Protected _Minute         =   Int(TimeStamp   / mMinute)   : TimeStamp - mMinute      * _Minute    : If msDate_Part   = #msDate_Minutes       : ProcedureReturn _Minute        : EndIf
   Protected _Second         =   Int(TimeStamp   / mSecond)   : TimeStamp - mSecond      * _Second    : If msDate_Part   = #msDate_Seconds       : ProcedureReturn _Second        : EndIf
   Protected _MilliSeconds   =   TimeStamp                                                            : If msDate_Part   = #msDate_MilliSeconds  : ProcedureReturn _MilliSeconds  : EndIf
   
EndProcedure

Procedure     msMilliSeconds(msDate.q)    :   ProcedureReturn GetmsDatePart(msDate, #msDate_MilliSeconds)    : EndProcedure
Procedure     msSecond(msDate.q)          :   ProcedureReturn GetmsDatePart(msDate, #msDate_Seconds)         : EndProcedure
Procedure     msMinute(msDate.q)          :   ProcedureReturn GetmsDatePart(msDate, #msDate_Minutes)         : EndProcedure
Procedure     msHour(msDate.q)            :   ProcedureReturn GetmsDatePart(msDate, #msDate_Hours)           : EndProcedure
Procedure     msDay(msDate.q)             :   ProcedureReturn GetmsDatePart(msDate, #msDate_Day)             : EndProcedure
Procedure     msMonth(msDate.q)           :   ProcedureReturn GetmsDatePart(msDate, #msDate_Month)           : EndProcedure
Procedure     msYear(msDate.q)            :   ProcedureReturn GetmsDatePart(msDate, #msDate_Year)            : EndProcedure

Procedure     msDate_to_Date(msDate.q)    :   ProcedureReturn Date(msYear(msDate) , msMonth(msDate)  , msDay(msDate)   , msHour(msDate)  , msMinute(msDate)  , msSecond(msDate))  : EndProcedure
Procedure.q   Date_to_msDate(Date)        :   ProcedureReturn msDate(Year(Date)   , Month(Date)      , Day(Date)       , Hour(Date)      , Minute(Date)      , Second(Date))      : EndProcedure

Procedure     msDayOfWeek(msDate.q)       :   ProcedureReturn DayOfWeek(msDate_to_Date(msDate))                                                        : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure     msDayOfYear(msDate.q)       :   ProcedureReturn DayOfYear(msDate_to_Date(msDate))                                                        : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekdayLong(msDate.q)     :   ProcedureReturn StringField("Sun|Mon|Tues|Wednes|Thurs|Fri|Satur", msDayOfWeek(msDate.q)+1, "|")+"day"   : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekday(msDate.q)         :   ProcedureReturn Left(msWeekdayLong(msDate),3)                                                            : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekdayGERLong(msDate.q)  :   ProcedureReturn StringField("Sonntag|Montag|Dienstag|Mittwoch|Donnerstag|Freitag|Samstag", msDayOfWeek(msDate.q)+1, "|")  : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekdayGER(msDate.q)      :   ProcedureReturn Left(msWeekdayGERLong(msDate),2)                                                         : EndProcedure     ; only supports years >= 1970 and <= 2037

Procedure.s   msFormatDate(Mask$, msDate.q, GermanWeekday=#False)
   
   ; Equivalent to FormatDate() for Date()-Values, but does support Years < 1970 and > 2037
   ; further it supports additional Tokens:
   ;   -  %ms    -  milliseconds with 3 digits
   ;   -  %wday  -  weekday - in long  form
   ;   -  %wd    -  weekday - in short form (3 Chars)
   
   Protected   msMask$   = ReplaceString(Mask$        , "%yyyy"   , Right(Str(msYear( msDate)+10000),4)         , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%yy"     , Right(Str(msYear( msDate)+10000),2)         , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%mm"     , Right(Str(msMonth(msDate)+100),2)           , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%dd"     , Right(Str(msDay(  msDate)+100),2)           , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%ms"     , Right(Str(msMilliSeconds(msDate)+1000),3)   , #PB_String_NoCase)
               If GermanWeekday = #True
                  msMask$   = ReplaceString(msMask$   , "%wday"   , msWeekdayGERLong(msDate.q)                  , #PB_String_NoCase)
                  msMask$   = ReplaceString(msMask$   , "%wd"     , msWeekdayGER(msDate.q)                      , #PB_String_NoCase)
               Else
                  msMask$   = ReplaceString(msMask$   , "%wday"   , msWeekdayLong(msDate.q)                    , #PB_String_NoCase)
                  msMask$   = ReplaceString(msMask$   , "%wd"     , msWeekday(msDate.q)                        , #PB_String_NoCase)
               EndIf
               If msYear(msDate) * msMonth(msDate) * msDay(msDate) <= 0 : Debug "msFormatDate()-Warning: Year, Month or Date is zero or negative - maybe wrong calculated msDate-Value?" : EndIf
               msMask$   = FormatDate(msMask$, Date(2000, 01, 01, msHour(msDate), msMinute(msDate), msSecond(msDate)))  ; use orig. FormatDate to replace Times only
   ProcedureReturn msMask$
EndProcedure


; --- msDate() Examples

CompilerIf #PB_Compiler_IsMainFile
   
   Define Act_Date.q         =   msDate()
   Define Custom_Date.q      =   msDate(2035,05,24,12,00,37,347)
   Define Future_Date.q      =   msDate(2158,09,11,08,52,00,120)
   
   Debug msFormatDate("Actual Date/Time"+#TAB$+":   %dd.%MM.%yyyy   -   %hh:%ii:%ss.%ms   -  %wd / %wday", Act_Date)
   Debug ""
   Debug msFormatDate("Custom Date/Time"+#TAB$+":   %dd.%mm.%yyyy   -   %hh:%ii:%ss.%ms   -  %wd / %wday", Custom_Date)
   Debug msFormatDate("German Date/Time"+#TAB$+":   %dd.%mm.%yyyy   -   %hh:%ii:%ss.%ms   -  %wd / %wday", Custom_Date, #True)
   Debug ""
   Debug msFormatDate("Future Date/Time"+#TAB$+":   %dd.%mm.%yyyy   -   %hh:%ii:%ss.%ms", Future_Date)                     ;  WeekDay not supported, because Year > 2037
   
CompilerEndIf
Maybe someone else can get some use out of it. :wink:


[Edit] Added Functions msWeekdayGER() and msWeekdayGERLong() as well as an optional Parameter in msFormatDate() to support Weekdays in german language.

[Edit2] Added support for year "0" / zero and added Debug-warning if Date-Value is to low or negative.
Last edited by PureLust on Wed Apr 29, 2020 4:53 pm, edited 2 times in total.
[Dynamic-Dialogs] - create complex GUIs the easy way
[DeFlicker] - easily deflicker your resizeable Windows
[WinFX] - Window Effects (incl. 'click-through' Window)
Top
User avatar
cabaptista
User
User
Posts: 86
Joined: Sun Nov 30, 2003 11:42 pm
Location: Lisboa, Portugal

Re: Date()-Functions with Millisecond Precision [Win only]

Post by cabaptista »

Thanks for your code
Top
infratec
Always Here
Always Here
Posts: 6866
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Date()-Functions with Millisecond Precision [Win only]

Post by infratec »

Hi,

strange results (Win10 64 with PB 5.61 x86)
Actual Date/Time : 00.00.0001 - 00:00:00.117 - Sun / Sunday

Custom Date/Time : 00.00.9999 - 00:00:00.915 - Sun / Sunday
German Date/Time : 00.00.9999 - 00:00:00.915 - So / Sonntag

Future Date/Time : 00.00.0000 - 00:00:00.880
And the starting variables:
Act_Date 2040850529
Custom_Date -1748082717
Future_date 980517880
But the structure d is filled correct.
wYear 2017
wMonth 9
wDayOfWeek 4
wDay 21
wHour 12
wMinute 36
wSecond 25
wMilliseconds 785
Bernd
Top
infratec
Always Here
Always Here
Posts: 6866
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Date()-Functions with Millisecond Precision [Win only]

Post by infratec »

Bugfix:

You have to declare all variables with .q in msDate() and GetmsDatePart()

Code: Select all

Protected mMilliseconds.q   =   1
Protected mSecond.q         =   mMilliseconds   * 1000
Protected mMinute.q         =   mSecond         * 60
Protected mHour.q           =   mMinute         * 60
Protected mDay.q            =   mHour           * 24
Protected mMonth.q          =   mDay            * 32
Protected mYear.q           =   mMonth          * 13

Protected msTimeSTamp.q
Also the procedures should be defined as procedure.q

Bernd
Top
infratec
Always Here
Always Here
Posts: 6866
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Date()-Functions with Millisecond Precision [Win only]

Post by infratec »

Small speed optimization :wink:

Code: Select all

#mMilliseconds = 1
#mSecond       = #mMilliseconds * 1000
#mMinute       = #mSecond       * 60
#mHour         = #mMinute       * 60
#mDay          = #mHour         * 24
#mMonth        = #mDay          * 32
#mYear         = #mMonth        * 13
Bernd
Top
infratec
Always Here
Always Here
Posts: 6866
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Date()-Functions with Millisecond Precision [Win only]

Post by infratec »

Hi,

DayOfWeek by the methode of Sakomoto:

Code: Select all

Procedure.i SakomotoDayOfWeek(y.i, m.i, d.i)  ; 1 <= m <= 12,  y > 1752 (in the U.K.) */
  
  ; Methode by Tomohiko Sakamoto
  ; ISO 8601 Mon = 1 ... Sun = 7
  
  Protected CalcDay.i
  
  DataSection
    SakomotoTable:
    Data.a 0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4
  EndDataSection
  
  If m < 3
    y - 1
  EndIf
  
  ; ISO8601
  CalcDay = (y + y/4 - y/100 + y/400 + PeekA(?SakomotoTable + m - 1) + d) % 7
  
  ; convert to PB Day
  If CalcDay = 7
    CalcDay = 0
  EndIf
  
  ProcedureReturn CalcDay
  
EndProcedure
Bernd
Top
PureLust
Enthusiast
Enthusiast
Posts: 477
Joined: Mon Apr 16, 2007 3:57 am
Location: Germany, NRW

Re: Date()-Functions with Millisecond Precision [Win only]

Post by PureLust »

infratec wrote:Hi,

strange results (Win10 64 with PB 5.61 x86)
Hi Bernd,

sorry for the late replay - I didn't realize that someone has replied to this Thread.

As far as I can see, there is nothing wrong with calculation or variable-types.
You did get the strange results, because you used invalid (or let's say 'not supported') values for msData.

I'm not sure where you get your test-datevalues from, but if they were created by PBs Date() function, you have to convert them first by using the Date_to_msDate() function to get a valid msDate Value.

Your positive Test-Values refer to a date in the year "zero" in msDate format.
Because year zero was not supported so far, I added support for this year.
But to make sure this was not done by a mistake, I now output a debug-warning if msDate Values refer to year zero.

Negative Date-Values are still not supported, so you will also get a warning now.

Relating to your 'Small speed optimization' and 'SakomotoDayOfWeek' ... feel free to implement it. :wink:

If someone needs "WeekDay" Information for years above 2037, implementing 'SakomotoDayOfWeek' method may be of some use.

Nevertheless, thanks for your reply and sorry again for the 'small delay' on mine. :mrgreen:
[Dynamic-Dialogs] - create complex GUIs the easy way
[DeFlicker] - easily deflicker your resizeable Windows
[WinFX] - Window Effects (incl. 'click-through' Window)
Top
Post Reply

Return to “Tricks 'n' Tips”