XProfan

' Feiertage.prf  -  Profan² Versionen 6.6, 7.6 & 8.0
'
' Autor: XPROFAN Gemeinschaft
 $I ProfAlt.inc
Def IsLeapYear(1) If(Or(And(Equ(Mod(%(1),4),0),Neq(Mod(%(1),100),0)),Equ(Mod(%(1),400),0)),1,0)
Def GSC(1) !"User32","GetSysColor"
Declare schaltjahr%,osterzahl%,rosenmontag$,aschermittwoch$,karfreitag$,\
ostersonntag$,ostermontag$,himmelfahrt$,muttertag$,pfingstsonnntag$
Declare pfingstmontag$,fronleichnam$,volkstrauer$,bussbettag$,totensonntag$,\
1advent$,Tabs#,Ende%,Liste%,Butt%,jahr%,TabTexv$[17],x%,akt_jahr%
Let akt_jahr% = @Val(@Left$(Date$(3),4))

Proc WochenTag

    Parameters t%,m%,j%
    Declare k%,l%,o%,p!,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

    Declare a%,b%,c%,d%,e%,f%,g%,h%,h1%,h2%,i%,k%,l%,L1%,L2%,m%,m1%,m2%,\
    n%,n1%,n2%,p%,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)
    Let p%=Mod(n2%,31)
    Inc p%
    Let ostersonntag$=@Add$(@Add$(@Add$(@Format$("0#",p%),"."),@Format$("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$=@Add$(@Add$(@Add$(@Format$("0#",kartag%),"."),@Format$("0#",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$=@Add$(@Add$(@Add$(@Format$("0#",ostermontag%),"."),@Format$("0#",ostermonat%)),". Ostermontag")
    Let osterzahl%=Add(59,p%)
    Case Equ(n%,4):Let osterzahl%=Add(osterzahl%,31)

EndProc

Proc Vorostern

    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$=@Add$(@Add$(@Add$(@Format$("0#",rostag%),"."),@Format$("0#",rosmon%)),". Rosenmontag")
    Let aschetag%=Add(rostag%,2)
    Let aschemonat%=rosmon%

    If Gt(aschetag%,28)

        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

            If Equ(aschetag%,29)

                Let aschetag%=1
                Let aschemonat%=3

            Else

                Let aschetag%=2
                Let aschemonat%=3

            EndIf

        EndIf

    EndIf

    Let aschermittwoch$=@Add$(@Add$(@Add$(@Format$("0#",aschetag%),"."),@Format$("0#",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$=@Add$(@Add$(@Add$(@Format$("0#",hi%),"."),@Format$("0#",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$=@Add$(@Add$(@Add$(@Format$("0#",pfi%),"."),@Format$("0#",pfimonat%)),". Pfingstsonntag")
    ' *** Pfingstmontag ***

    If Equ(pfi%,31)

        Let pfimo%=1
        Let pfimonat%=6

    Else

        Let pfimo%=Add(pfi%,1)

    EndIf

    Let pfingstmontag$=@Add$(@Add$(@Add$(@Format$("0#",pfimo%),"."),@Format$("0#",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$=@Add$(@Add$(@Add$(@Format$("0#",frolei%),"."),@Format$("0#",fromon%)),". Fronleichnam")
    WochenTag 1,5,jahr%
    Let muta%=8
    Case %(0): Let muta%=Sub(15,%(0))
    Case Equ(pfi%,muta%):Let muta%=Sub(muta%,7)
    Let muttertag$=@Add$(@Format$("0#",muta%),".05. Muttertag  ")

EndProc

Proc Advent

    Declare 1adv%
    WochenTag 31,12,jahr%
    Let 1adv%=Sub(33,%(0))

    If Gt(1adv%,30)

        Let 1advent$=@Add$(@Format$("0#",Int(Sub(1adv%,30))),".12. 1. Advent")

    Else

        Let 1advent$=@Add$(@Format$("0#",1adv%),".11. 1. Advent")

    EndIf

    Decimals 0
    Let bussbettag$=@Add$(@Format$("0#",Sub(22,%(0))),".11. Buß-und Bettag")
    Let volkstrauer$=@Add$(@Format$("0#",Sub(19,%(0))),".11. Volkstrauertag")
    Let totensonntag$=@Add$(@Format$("0#",Sub(26,%(0))),".11. Totensonntag")
    Decimals 6

EndProc

Proc TextAusgabe

    Declare v$,e%
    Dim Tabs#,20
    long Tabs#,0=20
    long Tabs#,4=20
    long Tabs#,8=20
    long Tabs#,12=20
    long Tabs#,16=20
    setdialogfont 1
    let v$="\t"
    let Tabtexv$[0]=@Add$("Feiertage in Deutschland im Jahre ",@Str$(jahr%))
    let Tabtexv$[1]=@MkStr$("-",@Add(56,@Mul(@Len(@Str$(jahr%)),2)))
    let Tabtexv$[2]=@Add$(@Add$("01.01. Neujahr         ",v$),"03.10. Tag d. deutschen Einheit")
    let Tabtexv$[3]=@Add$(@Add$("06.01. hlg. Drei Könige",v$),"31.10. Reformationstag         ")
    let Tabtexv$[4]=@Add$(@Add$("14.02. Valentinstag    ",v$),"11.11. Allerheiligen           ")
    let Tabtexv$[5]=@Add$(@Add$(rosenmontag$,v$),volkstrauer$)
    let Tabtexv$[6]=@Add$(@Add$(aschermittwoch$,v$),bussbettag$)
    let Tabtexv$[7]=@Add$(@Add$(@Add$(karfreitag$,v$),v$),totensonntag$)
    let Tabtexv$[8]=@Add$(@Add$(ostersonntag$,v$),1advent$)
    let Tabtexv$[9]=@Add$(@Add$(ostermontag$,v$),"06.12. Nikolaustag")
    let Tabtexv$[10]=@Add$(@Add$("01.05. Tag d. Arbeit",v$),"                24.12. Heiligabend")
    let Tabtexv$[11]=@Add$(@Add$(muttertag$,v$),"                25.12. erster Weihnachtstag")
    let Tabtexv$[12]=@Add$(@Add$(himmelfahrt$,v$),"                26.12. zweiter Weihnachtstag")
    let Tabtexv$[13]=@Add$(@Add$(pfingstsonnntag$,v$),"31.12. Sylvester")
    let Tabtexv$[14]=pfingstmontag$
    let Tabtexv$[15]=fronleichnam$
    let Tabtexv$[16]="15.08. Mariä Himmelfahrt"
    sendmessage(Liste%,$0192,5,Tabs#)
    sendmessage(Liste%,$0194,mul(0,3),0)
    Dispose Tabs#
    let e%=0

    whilenot equ(e%,17)

        addstring(Liste%,tabtexv$[e%])
        inc e%

    wend

EndProc

proc fete

    Let jahr% = 0

    While Or(@Lt(jahr%,1),@Gt(jahr%,9999))

        Let jahr%=@Input$("Bitte ein Jahr eingeben:","Feiertage anzeigen",akt_jahr%)

    EndWhile

    Ostern
    Vorostern
    Nachostern
    Advent
    TextAusgabe
    EnableWindow Liste%,1

endproc

SetTrueColor 1
WindowStyle 24
Window Add(%maxX,10),0-428,345
WindowTitle "Feiertage"
Popup "&Feiertage"
AppendMenu 100,"&Eingabe"
Separator
AppendMenu 101,"&Beenden"
Popup "Info"
AppendMenu 200,"Autor: XProfan Gemeinschaft"
Cls GSC(15)
let Liste%=control("LISTBOX","",$50B000C1,10,10,403,288,%hwnd,101,%HINSTANCE)
EnableWindow Liste%,0
SetWindowPos %HWnd=Div(Sub(%maxX,428),2),Div(Sub(%maxY,345),2)-428,342;0
Let Ende% = 0

WhileNot Ende%

    WaitInput

    If Or(@Equ(%MenuItem,-2),@Equ(%MenuItem,101))

        Let Ende% = 1

    ElseIf @Equ(%MenuItem,100)

        SendMessage(Liste%,$0184,0,0)
        Let x% = 0

        WhileNot @Equ(x%,17)

            Let TabTexv$[x%] = ""
            Inc x%

        EndWhile

        EnableWindow Liste%,0
        fete

    EndIf

EndWhile

SetWindowPos %HWnd=Add(%maxX,10),0-428,402;1
@DestroyWindow(Liste%)
End