Nabend.
Ohne grande Kommentare: Vielleicht kanns einer gebrauchen.
' 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(%DestroyWindow(Liste%)
End