Italia
Fonte/ Codesnippets

Berechnen Datum Feiertage

 
Peter Max Müller (08.06.15)
Nabend.
Ohne grande Kommentare: Vielleicht kanns einer gebrauchen.
KompilierenMarkierenSeparieren
' 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

 
08.06.2015  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

3.475 Views

Untitledvor 0 min.
Karl von Weizen vor 20 Tagen
p.specht20.11.2021
Uwe Lang20.11.2021
Manfred Barei19.11.2021
Di più...

Themeninformationen

Dieses Thema hat 1 subscriber:

iF (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie