Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Datum: Feiertagsberechnung
PRFellow-Vorlage
Autor: Thomas Hölzer
Berechnung wichtiger Feiertage in Deutschland
Die Prozedur erwartet eine Jahreszahl als Parameter
und wurde zum besseren Verständnis üppiger mit Variablen bestückt als nötig.
Das ganze läßt sich wesentlich eleganter lösen, ist dann aber
schwieriger zu durchschauen.
Achtung: Bei den Hilfsprozeduren Wochentag und Ostern sollten zusätzlich
die übergebenen Parameter geprüft werden, wenn User-Eingaben verarbeitet werden!
Die Osterberechnung gilt für den Gregorianischen Kalender (ab 1582)
Proc Feiertage
Parameters jahr%
Declare schaltjahr%,osterzahl%
Declare rosenmontag$,aschermittwoch$,karfreitag$
Declare ostersonntag$,ostermontag$,himmelfahrt$,muttertag$
Declare pfingstsonnntag$,pfingstmontag$,fronleichnam$
Declare volkstrauer$,bussbettag$,totensonntag$,1advent$
Prüft auf Schaltjahr (1=Ja, 0 = Nein)
Def IsLeapYear(1) If(Or(And(Equ(Mod(%(1),4),0),Neq(Mod(%(1),100),0)),
Equ(Mod(%(1),400),0)),1,0)
Proc WochenTag
Berechnet den Wochentag eines Datums im Format 24 12 1998
Rückgabe (Integer): Sonntag =0, Montag=1 ...
Parameters t%,m%,j%
Declare k%,l%,o%,p!
Declare z%,z1%,z2%,z3%,z4%,z5%
Let k%=Int(Add(0.6,Div(1,m%)))
Let l%=Sub(j%,k%)
Let o%=Add(m%,Mul(12,k%))
Let p!=Div(l%,100)
Let z1%=Int(Div(p!,4))
Let z2%=Int(p!)
Let z3%=Int(Div(Mul(5,l%),4))
Let z4%=Int(Div(Mul(13,Add(o%,1)),5))
Let z%=Add(z4%,z3%)
Sub z%,z2%
Add z%,z1%
Add z%,t%
Dec z%
Let z5%=Mul(7,Int(Div(z%,7)))
Sub z%,z5%
Return z%
EndProc
Proc Ostern
Berechnet den Ostersonntag
gültig von 1582 bis ultimo
Declare a%,b%,c%,d%,e%,f%,g%,h%,h1%,h2%,i%,
k%,l%,L1%,L2%,m%,m1%,m2%,n%,n1%,n2%,p%
Declare kartag%,karmonat%,ostermontag%,ostermonat%
Let a%=Mod(jahr%,19)
Let b%=Div(jahr%,100)
Let c%=Mod(jahr%,100)
Let d%=Div(b%,4)
Let e%=Mod(b%,4)
Let f%=Div(Add(b%,8),25)
Let g%=Sub(b%,f%)
Inc g%
Let g%=Div(g%,3)
Let h1%=Mul(19,a%)
Let h2%=Sub(b%,d%)
Sub h2%,g%
Add h2%,15
Let h%=Add(h1%,h2%)
Let h%=Mod(h%,30)
Let i%=Div(c%,4)
Let k%=Mod(c%,4)
Let L1%=Mul(2,e%)
Add L1%,32
Let L2%=Mul(2,i%)
Add L1%,L2%
Let L2%=Add(h%,k%)
Let l%=Sub(L1%,L2%)
Let l%=Mod(l%,7)
Let m1%=Mul(11,h%)
Let m2%=Mul(22,l%)
Let m%=Add(a%,m1%)
Add m%,m2%
Let m%=Div(m%,451)
Let n1%=Mul(7,m%)
Let n%=Add(h%,l%)
Sub n%,n1%
Let n2%=Add(n%,114)
Let n%=Div(n2%,31) n% ist der Monat des Osterdatums
Let p%=Mod(n2%,31)
Inc p% p% ist der Tag des Osterdatums
Let ostersonntag$=p%;.0;n%;. Ostersonntag
*** Karfreitag
Let kartag%=Sub(p%,2)
Let karmonat%=n%
If Equ(p%,1)
Let kartag%=30
Let karmonat%=3
ElseIf Equ(p%,2)
Let kartag%=31
Let karmonat%=3
EndIf
Let karfreitag$=Str$(kartag%);.0;Str$(karmonat%);. Karfreitag
*** Ostermontag ***
If Equ(p%,31)
Let ostermontag%=1
Let ostermonat%=4
Else
Let ostermontag%=Add(p%,1)
Let ostermonat%=n%
EndIf
Let ostermontag$=Str$(ostermontag%);.0;Str$(ostermonat%);. Ostermontag
Nummer des Tages im Jahr, auf den Ostern fällt erleichtert
Berechnung osterabhängiger Feiertage
Let osterzahl%=Add(59,p%)
Case Equ(n%,4):Let osterzahl%=Add(osterzahl%,31)
EndProc
Proc Vorostern
*** Rosenmontag und Aschermittwoch
Declare rostag%,rosmon%,aschetag%,aschemonat%
Let rostag%=Sub(osterzahl%,48)
Let schaltjahr%=IsLeapYear(jahr%)
Let rosmon%=2
If And(Equ(schaltjahr%,1),Equ(rostag%,59))
Let rostag%=29
ElseIf And(Equ(schaltjahr%,1),Lt(rostag%,59))
Sub rostag%,30
Else
If Lt(rostag%,60)
Sub rostag%,31
Else
Sub rostag%,59
Inc rosmon%
EndIf
EndIf
Let rosenmontag$=Str$(rostag%);.0;Str$(rosmon%);. Rosenmontag
Let aschetag%=Add(rostag%,2)
Let aschemonat%=rosmon%
If Gt(aschetag%,28)
*** Schaltjahr: aschetag% kann max. 31 sein
If Equ(schaltjahr%,1)
If Equ(aschetag%,29)
Let aschemonat%=2
ElseIf Equ(aschetag%,30)
Let aschetag%=1
Let aschemonat%=3
Else
Let aschetag%=2
Let aschemonat%=3
EndIf
Else
*** Kein Schaltjahr: aschetag% kann max. 30 sein
If Equ(aschetag%,29)
Let aschetag%=1
Let aschemonat%=3
Else
Let aschetag%=2
Let aschemonat%=3
EndIf
EndIf
EndIf
Let aschermittwoch$=Str$(aschetag%);.0;Str$(aschemonat%);. Aschermittwoch
EndProc
Proc Nachostern
Declare hi%,himon%,pfi%,pfimonat%,pfimo%,frolei%,fromon%,muta%
Himmelfahrt
Let hi%=Add(osterzahl%,39)
If Gt(hi%,151)
Let himon%=6
Let hi%=Sub(hi%,151)
Else
Let himon%=5
Let hi%=Sub(hi%,120)
EndIf
Let himmelfahrt$=Str$(hi%);.0;Str$(himon%);. Himmelfahrt
Pfingsten
Let pfi%=Add(osterzahl%,49)
If Gt(pfi%,151)
Let pfimonat%=6
Let pfi%=Sub(pfi%,151)
Else
Let pfimonat%=5
Let pfi%=Sub(pfi%,120)
EndIf
Let pfingstsonnntag$=Str$(pfi%);.0;Str$(pfimonat%);. Pfingstsonntag
*** Pfingstmontag ***
If Equ(pfi%,31)
Let pfimo%=1
Let pfimonat%=6
Else
Let pfimo%=Add(pfi%,1)
EndIf
Let pfingstmontag$=Str$(pfimo%);.0;Str$(pfimonat%);. Pfingstmontag
*** Fronleichnam ***
Let frolei%=Add(osterzahl%,60)
If gt(frolei%,151)
Let frolei%=Sub(frolei%,151)
Let fromon%=6
Else
Let fromon%=5
Let frolei%=Sub(frolei%,120)
EndIf
Let fronleichnam$=Str$(frolei%);.0;Str$(fromon%);. Fronleichnam
*** Muttertag = 2.So im Mai; falls zugleich Pfingsten, dann 1 Woche früher
*** Spätester Termin: 14.5.
WochenTag 1,5,jahr%
Let muta%=8
Case %(0): Let muta%=Sub(15,%(0))
*** Wenn Pfingsten und Muttertag auf den gleichen Sonntag fallen würden...
Case Equ(pfi%,muta%):Let muta%=Sub(muta%,7)
Let muttertag$=Str$(muta%);.05. Muttertag
EndProc
Proc Advent
Declare 1adv%
WochenTag 31,12,jahr%
Let 1adv%=Sub(33,%(0))
If Gt(1adv%,30)
Let 1advent$=Str$(Int(Sub(1adv%,30)));.12. 1. Advent
Else
Let 1advent$=Str$(1adv%);.11. 1. Advent
EndIf
Decimals 0
Let bussbettag$=Str$(Sub(22,%(0)));.11. Buß-und Bettag
Let volkstrauer$=Str$(Sub(19,%(0)));.11. Volkstrauertag
Let totensonntag$=Str$(Sub(26,%(0)));.11. Totensonntag
Decimals 6 Profan-Vorgabe wiederherstellen
EndProc
Proc TextAusgabe
Hier kann man natürlich auch eine Liste bestücken
DrawText 26,26,1.01. Neujahr
DrawText 26,50,6.01. Dreikönigstag
DrawText 26,74,14.02. Valentinstag
DrawText 26,98,rosenmontag$
DrawText 26,122,aschermittwoch$
DrawText 26,146,karfreitag$
DrawText 26,170,ostersonntag$
DrawText 26,194,ostermontag$
DrawText 26,218,1.05. Tag der Arbeit
DrawText 26,242,muttertag$
DrawText 26,266,himmelfahrt$
DrawText 26,290,pfingstsonnntag$
DrawText 26,314,pfingstmontag$
DrawText 423,26,fronleichnam$
DrawText 423,50,15.08. Mariä Himmelfahrt
If And(Lt(jahr%,1990),Gt(jahr%,1953))
DrawText 423,74,17.06. Tag der dt. Einheit
ElseIf Gt(jahr%,1989)
DrawText 423,74,03.10. Tag der dt. Einheit
Else
DrawText 423,74,Kein Tag der dt. Einheit
EndIf
DrawText 423,98,31.10. Reformationstag
DrawText 423,122,1.11. Allerheiligen
DrawText 423,146,volkstrauer$
DrawText 423,170,bussbettag$
DrawText 423,194,totensonntag$
DrawText 423,218,1advent$
DrawText 423,242,24.12. Heiligabend
DrawText 423,266,25.12. 1. Weihnachtstag
DrawText 423,290,26.12. 2. Weihnachtstag
DrawText 423,314,31.12. Silvester
EndProc
Ostern
Vorostern
Nachostern
Advent
TextAusgabe
EndProc
Beispiel
title
Feiertage 2006
Cls
Feiertage 2001
WaitInput
(1.130)
Deutsch
English
Français
Español
Italia