XProfan

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
Windowtitle Feiertage 2006
Cls
Feiertage 2001
WaitInput