Ich wollte für mein aktuelles Projekt unbedingt die Möglichkeit haben
Daten und Zeiten in großem Umfang zu speichern und damit zu rechnen.
Dazu habe ich Quads genommen und die entsprechenden PureBasic-
Funktionen nachprogrammiert:
Date(), Year(), Month(), Day(), Hour(), Minute(), Second(), DayOfWeek(),
DayOfYear(), FormatDate(). ParseDate() gibt es (noch) nicht.
Was leider nicht funktioniert: Man kann die Differenz zweier verschiedener
Daten nicht mehr einfach durch Subtrahieren herausbekommen.
Deswegen gibt es die neue Funktion DiffSecondsEx().
Und hier ist dann mal der Code:
Code: Alles auswählen
Macro DateEx(y = 0, m = 1, d = 1, h = 0, i = 0, s = 0)
((y) * 32140800 + ((m) - 1) * 2678400 + ((d) - 1) * 86400 + (h) * 3600 + (i) * 60 + (s))
EndMacro
Macro YearEx(dateex)
((dateex) / 32140800)
EndMacro
Macro MonthEx(dateex)
(((dateex) / 2678400) % 12 + 1)
EndMacro
Macro DayEx(dateex)
(((dateex) / 86400) % 31 + 1)
EndMacro
Macro HourEx(dateex)
(((dateex) / 3600) % 24)
EndMacro
Macro MinuteEx(dateex)
(((dateex) / 60) % 60)
EndMacro
Macro SecondEx(dateex)
((dateex) % 60)
EndMacro
Macro DateStringEx(dateex)
RSet(Str(DayEx(dateex)), 2, "0") + "." + RSet(Str(MonthEx(dateex)), 2, "0") + "." + RSet(Str(YearEx(dateex)), 4, "0")
EndMacro
Macro TimeStringEx(dateex)
RSet(Str(HourEx(dateex)), 2, "0") + ":" + RSet(Str(MinuteEx(dateex)), 2, "0") + ":" + RSet(Str(SecondEx(dateex)), 2, "0")
EndMacro
Procedure DayOfWeekEx(dateex.q) ;0=Sonntag, ..., 6=Montag
Protected dc.l, mc.l, yc.q, yhc.l, lyc.l
dc = DayEx(dateex)
mc = MonthEx(dateex)
yc = YearEx(dateex)
If ((yc & 3 = 0 And yc % 100) Or yc % 400 = 0)
If mc <= 2
lyc - 1
EndIf
EndIf
yhc = YearEx(dateex) / 100
yhc = 7 - 2 * yhc & 3
Select mc
Case 1, 10 : mc = 0
Case 5 : mc = 1
Case 8 : mc = 2
Case 2, 3, 11 : mc = 3
Case 6 : mc = 4
Case 9, 12 : mc = 5
Case 4, 7 : mc = 6
EndSelect
yc % 100
ProcedureReturn (yc + yhc + yc / 4 + 6 + lyc + mc + dc) % 7
EndProcedure
Procedure.l DayOfYearEx(dateex.q)
Protected mc.l, yc.q, doy.l
doy = DayEx(dateex)
mc = MonthEx(dateex)
yc = YearEx(dateex)
Select mc
Case 2 : doy + 31
Case 3 : doy + 59
Case 4 : doy + 90
Case 5 : doy + 120
Case 6 : doy + 151
Case 7 : doy + 181
Case 8 : doy + 212
Case 9 : doy + 243
Case 10 : doy + 273
Case 11 : doy + 304
Case 12 : doy + 334
EndSelect
If mc > 2
If (yc & 3 = 0 And yc % 100) Or yc % 400 = 0
doy + 1
EndIf
EndIf
ProcedureReturn doy
EndProcedure
Procedure.s FormatDateEx(mask.s, dateex.q) ;%yyyy, %yy, %mm, %mmm1, %mmm2, %dd, %hh, %ii, %ss, %ww, %wwww
Protected s1.s, s2.s
mask = ReplaceString(mask, "%yyy2", StrQ(YearEx(dateex)))
mask = ReplaceString(mask, "%yyyy", RSet(StrQ(YearEx(dateex)), 100, "0"))
mask = ReplaceString(mask, "%yy", RSet(StrQ(YearEx(dateex) % 100), 2, "0"))
mask = ReplaceString(mask, "%dd", RSet(Str(DayEx(dateex)), 2, "0"))
mask = ReplaceString(mask, "%hh", RSet(Str(HourEx(dateex)), 2, "0"))
mask = ReplaceString(mask, "%ii", RSet(Str(MinuteEx(dateex)), 2, "0"))
mask = ReplaceString(mask, "%ss", RSet(Str(SecondEx(dateex)), 2, "0"))
Select MonthEx(dateex)
Case 1 : s1 = "Jan" : s2 = "January"
Case 2 : s1 = "Feb" : s2 = "February"
Case 3 : s1 = "Mar" : s2 = "March"
Case 4 : s1 = "Apr" : s2 = "April"
Case 5 : s1 = "May" : s2 = "May"
Case 6 : s1 = "Jun" : s2 = "Juny"
Case 7 : s1 = "Jul" : s2 = "July"
Case 8 : s1 = "Aug" : s2 = "August"
Case 9 : s1 = "Sep" : s2 = "September"
Case 10 : s1 = "Oct" : s2 = "October"
Case 11 : s1 = "Nov" : s2 = "November"
Case 12 : s1 = "Dec" : s2 = "December"
EndSelect
mask = ReplaceString(mask, "%mmm1", s1)
mask = ReplaceString(mask, "%mmm2", s2)
mask = ReplaceString(mask, "%mm", RSet(Str(MonthEx(dateex)), 2, "0"))
Select DayOfWeekEx(dateex)
Case 0 : s1 = "Sun" : s2 = "Sunday"
Case 1 : s1 = "Mon" : s2 = "Monday"
Case 2 : s1 = "Tue" : s2 = "Tuesday"
Case 3 : s1 = "Wed" : s2 = "Wednesday"
Case 4 : s1 = "Thu" : s2 = "Thursday"
Case 5 : s1 = "Fri" : s2 = "Friday"
Case 6 : s1 = "Sat" : s2 = "Saturday"
Default : s1 = "" : s2 = ""
EndSelect
mask = ReplaceString(mask, "%wwww", s2)
mask = ReplaceString(mask, "%ww", s1)
ProcedureReturn mask
EndProcedure
Procedure.q DiffSecondsEx(date1.q, date2.q)
Protected sec1.q, sec2.q, days.q, l.l ;'l' ist Hilfsvariable wegen Bug in PB
days = YearEx(date1) - 1
l = DayOfYearEx(date1)
days = days * 365 + days / 4 - days / 100 + days / 400 + l - 1
sec1 = days * 86400 + HourEx(date1) * 3600 + MinuteEx(date1) * 60 + SecondEx(date1)
days = YearEx(date2) - 1
l = DayOfYearEx(date2)
days = days * 365 + days / 4 - days / 100 + days / 400 + l - 1
sec2 = days * 86400 + HourEx(date2) * 3600 + MinuteEx(date2) * 60 + SecondEx(date2)
ProcedureReturn (sec2 - sec1)
EndProcedure
;Schleife zum Vergleich zu den PB-Date-Funktionen
For y = 1970 To 2010
For m = 1 To 12
For d = 1 To 28
If DiffSecondsEx(DateEx(1970, 1, 1), DateEx(y, m, d)) <> Date(y, m, d, 0, 0, 0)
Debug "DiffSecondsEx: " + FormatDateEx("%dd.%mm.%yyyy", DateEx(y, m, d)) + " : " + StrQ(DiffSecondsEx(DateEx(1970, 1, 1), DateEx(y, m, d))) + " - " + Str(Date(y, m, d, 0, 0, 0))
EndIf
If DayOfWeekEx(DateEx(y, m, d)) <> DayOfWeek(Date(y, m, d, 0, 0, 0))
Debug "DayOfWeekEx: " + FormatDateEx("%dd.%mm.%yyyy", DateEx(y, m, d)) + " : " + Str(DayOfWeekEx(DateEx(y, m, d))) + " - " + Str(DayOfWeek(Date(y, m, d, 0, 0, 0)))
EndIf
If DayOfYearEx(DateEx(y, m, d)) <> DayOfYear(Date(y, m, d, 0, 0, 0))
Debug "DayOfYearEx: " + FormatDateEx("%dd.%mm.%yyyy", DateEx(y, m, d)) + " : " + Str(DayOfYearEx(DateEx(y, m, d))) + " - " + Str(DayOfYear(Date(y, m, d, 0, 0, 0)))
EndIf
Next
Next
Next
Debug FormatDateEx("%wwww, on %mmm2 the %dd. of %yyy2 at %hh:%ii:%ss", 0)
Debug FormatDateEx("%wwww, on %mmm2 the %dd. of %yyy2 at %hh:%ii:%ss", $7FFFFFFFFFFFFFFF)Fehler gibt. Würde es welche geben, würde das im Debug-Fenster
angezeigt werden. In den letzten zwei Zeilen wird der Umfang
demonstriert.
Vielleicht kann jemand etwas damit anfangen oder es sogar noch
erweitern.