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: 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
[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.