Date()-Funktionen mit Millisekunden-Präzision [Win only]

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
PureLust
Beiträge: 1145
Registriert: 21.07.2005 00:02
Computerausstattung: Hab aktuell im Grunde nur noch 'nen Lenovo Yoga 2 Pro im Einsatz.
Wohnort: am schönen Niederrhein

Date()-Funktionen mit Millisekunden-Präzision [Win only]

Beitrag von PureLust »

Hi, .... da ja nicht jeder hier das englische Forum verfolgt, poste ich hier auch mal meine kleine Funktionssammlung für hochpräzise Date()-Funktionen:

Ich brauchte ein paar TimeStamp-Funktionen mit Millisekunden-Präzision und hab dazu mal ein paar Funktionen gebastelt.

Die Vorteile gegenüber den vorhandenen Funktionen, die auf das Date()-Format von PB aufsetzen, sind:
- Millisekunden Präzision
- Jahreszahlen < 1970 und >2037 werden unterstützt
- zusätzliche Funktionen zur Ermittlung des Wochentags (Sonntag, Montag, ... sowie So, Mo, ...)
- unterstützt zusätzliche Tokens in msFormatDate() - %ms = Millisekunden, %wday = Wochentag (ausgeschrieben), %wd = Wochentag (abkürzung)

Enthaltene Funktionen (Beschreibung hab ich jetzt nicht aus dem Englischen übersetzt ... sorry):

Code: Alles auswählen

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: Alles auswählen

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
Vielleicht kann's je noch jemand von Euch brauchen. :wink:


[Edit] Hab noch die Funktionen msWeekdayGER() und msWeekdayGERLong() sowie einen optionalen Parameter in msFormatDate() hinzugefügt, um Wochentage in deutscher Sprache zu unterstützen.

[Edit2] Debug-Warnung hinzugefügt, falls sehr niedrige oder negative Datumswerte übergeben wurden.
Zuletzt geändert von PureLust am 29.04.2020 18:27, insgesamt 1-mal geändert.
[Dynamic-Dialogs] - komplexe dynamische GUIs einfach erstellen
[DeFlicker] - Fenster flimmerfrei resizen
[WinFX] - Window Effekte (inkl. 'durchklickbares' Window)
Chregu
Beiträge: 16
Registriert: 22.12.2018 16:07
Wohnort: Viseu de Jos, Rumänien
Kontaktdaten:

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Beitrag von Chregu »

Du hast noch die Bugfixes vergessen:
You have to declare all variables with .q in msDate() and GetmsDatePart()

Code: Alles auswählen

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
Gruss Chregu
Benutzeravatar
PureLust
Beiträge: 1145
Registriert: 21.07.2005 00:02
Computerausstattung: Hab aktuell im Grunde nur noch 'nen Lenovo Yoga 2 Pro im Einsatz.
Wohnort: am schönen Niederrhein

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Beitrag von PureLust »

Chregu hat geschrieben:Du hast noch die Bugfixes vergessen:
Hi Chregu,
danke für den Hinweis ... hatte gar nicht mitbekommen, dass im englischen Forum jemand auf den Thread geantwortet hatte.

Bzgl. Berns Problemen mit 'strange Results' und seiner Bug-Fix Empfehlung:
Die seltsamen Resultate resultierten nicht aus falsch definierten Variablentypen (diese sind alle in Ordnung), sondern aus den Werten die Bernd übergeben hatte.

Diese zeigten (im msDate-Format) auf ein Datum im Jahr "0" oder b.C., welche bislang nicht unterstützt werden.

Einen Support für das Jahr 'Null' habe ich nun eingebaut, aber negative Datumswerte (also b.C.) werden nach wie vor nicht unterstützt.

In beiden Fällen wird aber nun eine Debug-Meldung ausgegeben, um darauf hin zu weisen, dass hier evtl. aus versehen falsche Werte übergeben wurden.

Kannst die msDate-Funktionen also nach wie vor benutzen - naja zumindest ab dem Jahr 0 nach Christus. :wink:

Grüße, PL.
[Dynamic-Dialogs] - komplexe dynamische GUIs einfach erstellen
[DeFlicker] - Fenster flimmerfrei resizen
[WinFX] - Window Effekte (inkl. 'durchklickbares' Window)
Benutzeravatar
juergenkulow
Beiträge: 188
Registriert: 22.12.2016 12:49
Wohnort: :D_üsseldorf-Wersten

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Beitrag von juergenkulow »

Hallo PureLust,

hast Du mal darüber nach gedacht, den Zeitstempel des Prozessors für noch genauere Zeitmessung zu nutzen? (RDTSC)

Gruß
Bitte stelle Deine Fragen, denn den Erkenntnisapparat einschalten entscheidet über das einzig bekannte Leben im Universum.

Jürgen Kulow Wersten :D_üsseldorf NRW D Europa Erde Sonnensystem Lokale_Flocke Lokale_Blase Orion-Arm
Milchstraße Lokale_Gruppe Virgo-Superhaufen Laniakea Sichtbares_Universum
Benutzeravatar
PureLust
Beiträge: 1145
Registriert: 21.07.2005 00:02
Computerausstattung: Hab aktuell im Grunde nur noch 'nen Lenovo Yoga 2 Pro im Einsatz.
Wohnort: am schönen Niederrhein

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Beitrag von PureLust »

Hi Jürgen,

da ich ja keine super exakte 'Zeitmessung' , sondern nur 'Zeit Stempel' für rund 20-30 Einzelereignisse pro Sekunde brauchte, war eine Genauigkeit von Millisekunden für meinen Zweck mehr als ausreichend.

Diese werden zusammen mit den Messwerten in einer Datenbank gespeichert und später unabhängig ausgewertet.

Grüße, PL
[Dynamic-Dialogs] - komplexe dynamische GUIs einfach erstellen
[DeFlicker] - Fenster flimmerfrei resizen
[WinFX] - Window Effekte (inkl. 'durchklickbares' Window)
Antworten