Aktuelle Zeit: 12.07.2020 02:46

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 5 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Date()-Funktionen mit Millisekunden-Präzision [Win only]
BeitragVerfasst: 28.08.2017 18:41 
Offline
Benutzeravatar

Registriert: 21.07.2005 00:02
Wohnort: am schönen Niederrhein
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:
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:
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.

_________________
[Dynamic-Dialogs] - komplexe dynamische GUIs einfach erstellen
[DeFlicker] - Fenster flimmerfrei resizen
[WinFX] - Window Effekte (inkl. 'durchklickbares' Window)


Zuletzt geändert von PureLust am 29.04.2020 18:27, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]
BeitragVerfasst: 29.04.2020 10:02 
Offline

Registriert: 22.12.2018 16:07
Wohnort: Viseu de Jos, Rumänien
Du hast noch die Bugfixes vergessen:

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

Code:
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]
BeitragVerfasst: 29.04.2020 18:41 
Offline
Benutzeravatar

Registriert: 21.07.2005 00:02
Wohnort: am schönen Niederrhein
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)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]
BeitragVerfasst: 01.05.2020 11:42 
Offline
Benutzeravatar

Registriert: 22.12.2016 12:49
Wohnort: :D_üsseldorf-Wersten
Hallo PureLust,

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

Gruß

_________________
PB Spickzettel

Erkenntnisapparat einschalten entscheidet über das einzig bekannte Leben im sichtbaren Universum.
Bitte Frage fragen.
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]
BeitragVerfasst: 01.05.2020 11:48 
Offline
Benutzeravatar

Registriert: 21.07.2005 00:02
Wohnort: am schönen Niederrhein
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)


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 5 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 7 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye