PureBoard

Code: Alles auswählen

; Umrechungskonstanten

#MinuteSeconds = 60
#HourMinutes = 60
#DayHours = 24
#YearDays = 365

#HourSeconds = #HourMinutes*#MinuteSeconds
#DaySeconds = #DayHours*#HourSeconds

#StartYear = 1970



; Proceduren

Procedure DayOfYearQ(Time.q)
 Protected TempDays.q = Time / #DaySeconds
 Protected TempYear.q = TempDays / #YearDays
 ; Schaltjahre
 Protected SD = ((TempYear+1)/4)-((TempYear+69)/100)+((TempYear+369)/400)
 Protected TempDayOfYear = (TempDays - SD) % #YearDays +1
 Protected Year = (TempDays - SD) / #YearDays + #StartYear
 Protected AddDay
 If #YearDays-TempDayOfYear < SD
  If Not Year % 4   : AddDay + 1 : EndIf
  If Not Year % 100 : AddDay - 1 : EndIf
  If Not Year % 400 : AddDay + 1 : EndIf
 EndIf
 ProcedureReturn TempDayOfYear+AddDay
EndProcedure

Procedure DayOfWeekQ(Time.q)
 Protected TempDays.q = Time / #DaySeconds
 Protected DayOfWeek = (TempDays+4) % 7
 ProcedureReturn DayOfWeek
EndProcedure
   

Procedure YearQ(Time.q)
 Protected TempDays = Time / #DaySeconds
 Protected TempYear = TempDays / #YearDays
 Protected SD = ((TempYear+1)/4)-((TempYear+69)/100)+((TempYear+369)/400)
 Protected Year = (TempDays - SD) / #YearDays + #StartYear
 ProcedureReturn Year
EndProcedure

Procedure MonthQ(Time.q)
 Protected Year = YearQ(Time)
 Protected DayOfYear = DayOfYearQ(Time)
 Protected AddDay
 If DayOfYear > 31+28
  If Not Year % 4   : AddDay + 1 : EndIf
  If Not Year % 100 : AddDay - 1 : EndIf
  If Not Year % 400 : AddDay + 1 : EndIf
 EndIf
 Restore MonthDays
 Protected n
 For n = 1 To 12
  Read MonthDays
  If n = 2 : MonthDays+AddDay : EndIf
  If DayOfYear < MonthDays+1
   ProcedureReturn n
  EndIf
  DayOfYear - MonthDays
 Next 
EndProcedure

Procedure DayQ(Time.q)
 Protected Year = YearQ(Time)
 Protected DayOfYear = DayOfYearQ(Time)
 Protected AddDay
 If DayOfYear > 31+28
  If Not Year % 4   : AddDay + 1 : EndIf
  If Not Year % 100 : AddDay - 1 : EndIf
  If Not Year % 400 : AddDay + 1 : EndIf
 EndIf
 Restore MonthDays
 Protected n
 For n = 1 To 12
  Read MonthDays
  If n = 2 : MonthDays+AddDay : EndIf
  If DayOfYear < MonthDays+1
   ProcedureReturn DayOfYear
  EndIf
  DayOfYear - MonthDays
 Next 
EndProcedure

Procedure HourQ(Time.q)
 Protected Hour = (Time / #HourSeconds) % #DayHours
 ProcedureReturn Hour
EndProcedure

Procedure MinuteQ(Time.q)
 Protected Minute = (Time / #MinuteSeconds) % #HourMinutes
 ProcedureReturn Minute
EndProcedure

Procedure SecondQ(Time.q)
 Protected Second = (Time) % #MinuteSeconds 
 ProcedureReturn Second
EndProcedure



Procedure.q DateQ(Year,Month,Day,Hour,Minute,Second)
 Protected Time.q
 Protected TempYear = Year-#StartYear
 Time + TempYear*365*#DaySeconds
 Protected SD = ((TempYear+1)/4)-((TempYear+69)/100)+((TempYear+369)/400)
 Time + #DaySeconds*SD
 If Month > 2 :
  If Not Year % 4   : Time + #DaySeconds : EndIf
  If Not Year % 100 : Time - #DaySeconds : EndIf
  If Not Year % 400 : Time + #DaySeconds : EndIf
 EndIf
 Restore MonthDays
 Protected n
 For n = 1 To Month-1
  Read MonthDays
  Time + #DaySeconds*MonthDays
 Next 
 Time + (Day-1)*#DaySeconds
 Time + Hour*#HourSeconds
 Time + Minute*#MinuteSeconds
 Time + Second
 ProcedureReturn Time
EndProcedure



Procedure.s FormatDateQ(Maske$, Time.q)
 Maske$ = ReplaceString(Maske$, "%yyyy", StrQ(YearQ(Time)))
 Maske$ = ReplaceString(Maske$, "%yy", Right(StrQ(YearQ(Time)  ), 2)     )
 Maske$ = ReplaceString(Maske$, "%mm",  RSet(StrQ(MonthQ(Time) ), 2, "0"))
 Maske$ = ReplaceString(Maske$, "%dd",  RSet(StrQ(DayQ(Time)   ), 2, "0"))
 Maske$ = ReplaceString(Maske$, "%hh", RSet(StrQ(HourQ(Time)  ), 2, "0"))
 Maske$ = ReplaceString(Maske$, "%ii",  RSet(StrQ(MinuteQ(Time)), 2, "0"))
 Maske$ = ReplaceString(Maske$, "%ss",  RSet(StrQ(SecondQ(Time)), 2, "0"))
 ProcedureReturn Maske$
EndProcedure



DataSection
 MonthDays:
 Data.l 31,28,31,30,31,30,31,31,30,31,30,31
EndDataSection

Code: Alles auswählen

Time = Date(2008,2,29,12,00,00) 
Debug "Long: "+Str(Time) 
TimeQ.q = DateQ(2008,2,29,12,00,00) 
Debug "Quad: "+StrQ(TimeQ) 
Debug "Long: "+FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", Time)
Debug "Quad: "+FormatDateQ("%dd.%mm.%yyyy %hh:%ii:%ss", Time)
TimeQ.q = DateQ(3333,3,3,3,33,33) 
Debug "NEU: "+StrQ(TimeQ) 
Debug "NEU: "+FormatDateQ("%dd.%mm.%yyyy %hh:%ii:%ss", TimeQ)

Code: Alles auswählen

refDate.q = 0
y.l = 1970
m.l = 1
d.l = 1
dy.l = 1
dw.l = 4
cerrors.l = 0
Repeat
  error.s = ""
  date.q = DateQ(y, m, d, 0, 0, 0)
  If date <> refDate : error + "ref" : EndIf
  If DayOfYearQ(date) <> dy : error + " dy" : EndIf
  If DayOfWeekQ(date) <> dw : error + " dw" : EndIf
  If YearQ(date) <> y : error + " y" : EndIf
  If MonthQ(date) <> m : error + " m" : EndIf
  If DayQ(date) <> d : error + " d" : EndIf
  
  If m = 12 And d = 31 ;letzter Tag im Jahr
    dy = 1
    m = 1
    d = 1
    y + 1
  Else
    dy + 1
    Select m
      Case 1, 3, 5, 7, 8, 10, 12 : md.l = 31
      Case 4, 6, 9, 11 : md.l = 30
      Case 2 : If ((Not (y % 4)) And (y % 100)) Or Not (y % 400) : md = 29 : Else : md = 28 : EndIf
    EndSelect
    If d = md ;letzter Tag im Monat
      m + 1
      d = 1
    Else
      d + 1
    EndIf
  EndIf
  dw = (dw + 1) % 7
  refDate + 86400
  
  If error
    Debug "Errors: " + error + " - " + Str(d) + "." + Str(m) + "." + Str(y)
    cerrors + 1
  EndIf
Until y = 4000
Debug "Errors: " + Str(cerrors)