Code
' Kalendertest
' Autor: Michael Wodrich
' Kalenderwochen korrekt fortlaufend zählen
' Strukturarrays zum Datensammeln verwenden
' Feiertage aller Bundesländer berücksichtigen
set("errorlevel",2)
var string dies_ist_mein_Bundesland = "SH" // "BB|BE|BW|BY|HB|HE|HH|MV|NI|NW|RP|SH|SL|SN|ST|TH" (ISO 3166-2:DE)
SubProc dt.BoM
Parameters float DP
Return dt("SetDay",DP,1)
EndProc
SubProc dt.EoM
Parameters float DP
Return dt("Ultimo",DP)
EndProc
SubProc dt.Ultimo
Declare float DP
If %PCount = 2
Parameters int Month,Year
DP = dt("setDate",Year,Month,1)
Else
Parameters float D1
DP = D1
EndIf
// -----
If dt("GetMonth",DP) == 12
DP = dt("SetDay",DP, 31)
Return DP
EndIf
// (01. MM + 1. YYYY) - 1
DP = dt("SetDay",DP, 1)
DP = dt("SetMonth",DP, dt("GetMonth",DP) + 1)
DP = dt("incDay",DP, -1)
Return DP
EndProc
SubProc dt.Advent4
Declare float Tag2512, int Jahr
If PType$(1) = "!"
Parameters float DP
Jahr = dt("getYear",DP)
Else
Parameters int Y
Jahr = Y
EndIf
Tag2512 = dt("SetDate", Jahr, 12, 25 )
Return ( Tag2512 - dt("GetDoW",Tag2512) )
EndProc
SubProc dt.Easter
Declare int Y
If PType$(1) = "!"
Parameters float DP
Y = dt("getYear",DP)
Else
Parameters int Jahr
Y = Jahr
EndIf
Declare int D,Mo, Century, r19, r30, x,x1,x2,x3,x4,x5
Century = Y \ 100
r19 = Y mod 19
x = ((Century - 15) >> 1) + 202 - r19 * 11
Select Century
CaseOf 21,24,25,27,28,29,30,31,32,34,35,38
Dec x
CaseOf 33,36,37,39,40
Dec x, 2
EndSelect
r30 = x mod 30
x1 = r30 + 21
Case r30 == 29 : Dec x1
Case (r30 == 28) and (r19 > 10) : Dec x1
x2 = (x1 - 19) mod 7
x3 = (40 - Century) mod 4
Case x3 == 3 : Inc x3
Case x3 > 1 : Inc x3
x = Y mod 100
x4 = (x + x / 4) mod 7
x5 = ((20 - x2 - x3 - x4) mod 7) + 1
D = x1 + x5
Mo = 3
If D > 31
Dec D,31
Inc Mo
EndIf
Return dt("SetDate", Y,Mo,D)
EndProc
SubProc dt.WeekdayStep
Parameters float D, string Modus
Declare int Mode, WD, W, string WDay
Modus = Lower$(Modus) : WDay = Right$(Modus,2) : WD = 1
Case InStr("first",Modus) : Mode = 0
Case InStr("prev",Modus) : Mode = 1
Case InStr("next",Modus) : Mode = 2
Case InStr("last",Modus) : Mode = 3
WhileLoop 1,14
If SubStr$("mo,di,mi,do,fr,sa,so,mo,tu,we,th,fr,sa,su", &Loop, ",") = WDay
Case &Loop <= 7 : WD = &Loop - 1
Case &Loop > 7 : WD = &Loop - 8
BREAK
EndIf
EndWhile
// Korrektur des Tages
Case Mode = 0 : D = dt("BoM",D) // First
Case Mode = 3 : D = dt("EoM",D) // Last
While WD < 0 : Inc WD,7 : EndWhile : WD = WD mod 7 : Inc WD
W = dt("getDoW",D)
Select Mode
CaseOf 0 // First
While W <> WD
D = D + 1
Inc W
Case W > 7 : W = 1
EndWhile
CaseOf 1 // Prev
Repeat
D = D - 1
Dec W
Case W < 1 : W = 7
Until W = WD
CaseOf 2 // Next
Repeat
D = D + 1
Inc W
Case W > 7 : W = 1
Until W = WD
CaseOf 3 // Last
While W <> WD
D = D - 1
Dec W
Case W < 1 : W = 7
EndWhile
EndSelect
Return D
EndProc
SubProc dt.FirstMo : Parameters float D : Return dt("WeekdayStep",D,"FirstMo") : EndProc
SubProc dt.FirstDi : Parameters float D : Return dt("WeekdayStep",D,"FirstDi") : EndProc
SubProc dt.FirstMi : Parameters float D : Return dt("WeekdayStep",D,"FirstMi") : EndProc
SubProc dt.FirstDo : Parameters float D : Return dt("WeekdayStep",D,"FirstDo") : EndProc
SubProc dt.FirstFr : Parameters float D : Return dt("WeekdayStep",D,"FirstFr") : EndProc
SubProc dt.FirstSa : Parameters float D : Return dt("WeekdayStep",D,"FirstSa") : EndProc
SubProc dt.FirstSo : Parameters float D : Return dt("WeekdayStep",D,"FirstSo") : EndProc
SubProc dt.FirstTu : Parameters float D : Return dt("WeekdayStep",D,"FirstTu") : EndProc
SubProc dt.FirstWe : Parameters float D : Return dt("WeekdayStep",D,"FirstWe") : EndProc
SubProc dt.FirstTh : Parameters float D : Return dt("WeekdayStep",D,"FirstTh") : EndProc
SubProc dt.FirstSu : Parameters float D : Return dt("WeekdayStep",D,"FirstSu") : EndProc
SubProc dt.PrevMo : Parameters float D : Return dt("WeekdayStep",D,"PrevMo") : EndProc
SubProc dt.PrevDi : Parameters float D : Return dt("WeekdayStep",D,"PrevDi") : EndProc
SubProc dt.PrevMi : Parameters float D : Return dt("WeekdayStep",D,"PrevMi") : EndProc
SubProc dt.PrevDo : Parameters float D : Return dt("WeekdayStep",D,"PrevDo") : EndProc
SubProc dt.PrevFr : Parameters float D : Return dt("WeekdayStep",D,"PrevFr") : EndProc
SubProc dt.PrevSa : Parameters float D : Return dt("WeekdayStep",D,"PrevSa") : EndProc
SubProc dt.PrevSo : Parameters float D : Return dt("WeekdayStep",D,"PrevSo") : EndProc
SubProc dt.PrevTu : Parameters float D : Return dt("WeekdayStep",D,"PrevTu") : EndProc
SubProc dt.PrevWe : Parameters float D : Return dt("WeekdayStep",D,"PrevWe") : EndProc
SubProc dt.PrevTh : Parameters float D : Return dt("WeekdayStep",D,"PrevTh") : EndProc
SubProc dt.PrevSu : Parameters float D : Return dt("WeekdayStep",D,"PrevSu") : EndProc
SubProc dt.NextMo : Parameters float D : Return dt("WeekdayStep",D,"NextMo") : EndProc
SubProc dt.NextDi : Parameters float D : Return dt("WeekdayStep",D,"NextDi") : EndProc
SubProc dt.NextMi : Parameters float D : Return dt("WeekdayStep",D,"NextMi") : EndProc
SubProc dt.NextDo : Parameters float D : Return dt("WeekdayStep",D,"NextDo") : EndProc
SubProc dt.NextFr : Parameters float D : Return dt("WeekdayStep",D,"NextFr") : EndProc
SubProc dt.NextSa : Parameters float D : Return dt("WeekdayStep",D,"NextSa") : EndProc
SubProc dt.NextSo : Parameters float D : Return dt("WeekdayStep",D,"NextSo") : EndProc
SubProc dt.NextTu : Parameters float D : Return dt("WeekdayStep",D,"NextTu") : EndProc
SubProc dt.NextWe : Parameters float D : Return dt("WeekdayStep",D,"NextWe") : EndProc
SubProc dt.NextTh : Parameters float D : Return dt("WeekdayStep",D,"NextTh") : EndProc
SubProc dt.NextSu : Parameters float D : Return dt("WeekdayStep",D,"NextSu") : EndProc
SubProc dt.LastMo : Parameters float D : Return dt("WeekdayStep",D,"LastMo") : EndProc
SubProc dt.LastDi : Parameters float D : Return dt("WeekdayStep",D,"LastDi") : EndProc
SubProc dt.LastMi : Parameters float D : Return dt("WeekdayStep",D,"LastMi") : EndProc
SubProc dt.LastDo : Parameters float D : Return dt("WeekdayStep",D,"LastDo") : EndProc
SubProc dt.LastFr : Parameters float D : Return dt("WeekdayStep",D,"LastFr") : EndProc
SubProc dt.LastSa : Parameters float D : Return dt("WeekdayStep",D,"LastSa") : EndProc
SubProc dt.LastSo : Parameters float D : Return dt("WeekdayStep",D,"LastSo") : EndProc
SubProc dt.LastTu : Parameters float D : Return dt("WeekdayStep",D,"LastTu") : EndProc
SubProc dt.LastWe : Parameters float D : Return dt("WeekdayStep",D,"LastWe") : EndProc
SubProc dt.LastTh : Parameters float D : Return dt("WeekdayStep",D,"LastTh") : EndProc
SubProc dt.LastSu : Parameters float D : Return dt("WeekdayStep",D,"LastSu") : EndProc
Struct sDayInfo = dDay%,dMonth%,dYear%, dDP!, dDayno%, dWeekNo%, dWeekday%, dIsWorkday%, dIsHoliday%, dIsWorkHoliday%
'dDay% [1 - 31] Tag
'dMonth% [1 - 12] Monat
'dYear% [1583-3999] Jahr
'dDP! [...] XProfan-Datum
'dDayno% [1 - 366] Tagesnummer
'dWeekNo% [1 - 53] Wochennummer (kann im Vor- o. Folgejahr liegen)
'dWeekday% [1 - 7] (Mo - So)
'dIsWorkday% [0 - 1] Ist es ein Werktag? (Mo..Fr; kein Feiertag)
'dIsHoliday% [0 - 1] Ist es ein Feiertag?
'dIsWorkHoliday% [0 - 1] Ist es ein Feiertag, der auf einen Werktag fällt?
Struct sMonthInfo = mMonth%, mYear%, mNoOfDays%, mNoOfWorkdays%, mNoOfWeekend%, mNoOfHolidays%, mNoOfWorkHolidays%
'mMonth% [1 - 12] Monat
'mYear% [1583-3999] Jahr
'mNoOfDays% [28 - 31] Wieviele Tage hat der Monat? (Ultimo)
'mNoOfWorkdays% [0 - 31] Wieviele Tage davon sind Arbeitstage?
'mNoOfWeekend% [0 - 31] Summe der Wochenend-Tage dieses Monats.
'mNoOfHolidays% [0 - 31] Summe der Feiertage.
'mNoOfWorkHolidays% [0 - 31] Summe der Feiertage, die auf Werktage fallen.
Struct sYearInfo = yYear%, yNoOfDays%, yNoOfWorkdays%, yNoOfWeekend%, yNoOfHolidays%, yNoOfWorkHolidays%, yFirstWeek%, yNoOfWeeks%, yLastWeek%, yIsLeap%
'yYear% [1583-3999] Jahr
'yNoOfDays% [365 - 366] Wieviele Tage hat das Jahr?
'yNoOfWorkdays% [0 - 366] Wieviele Tage davon sind Arbeitstage?
'yNoOfWeekend% [0 - 366] Summe der Wochenend-Tage dieses Jahres.
'yNoOfHolidays% [0 - 366] Summe der Feiertage.
'yNoOfWorkHolidays% [0 - 366] Summe der Feiertage, die auf Werktage fallen.
'yFirstWeek% [1 - 53] Nr der ersten Woche des Jahres (kann auch 53 sein; Vorjahr)
'yNoOfWeeks% [51 - 53] Anzahl der Wochen des Jahres
'yLastWeek% [1 - 53] Nr der letzten Woche des Jahres (kann auch 1 sein; Folgejahr)
'yIsLeap% [0 - 1] Schaltjahr?
Alles anzeigen