Deutsch
Forum

XProfan X3 Beta

@dt("getLastM")

 

ByteAttack
OK! Eigentlich leicht zu berechnen, aber wie gesagt, bin faul
Denn letzten Tag eines Monats berechnen, wäre cool.
Oder auch so komische Feiertage wie Buß- und Bettag berechnen. z.Zt. mache ich das so: (als Beispiel)
' Buß- und Bettag
WT23%=dt("getDoW",dt("setDate","23.11."+Str$(Jahr&)))
23Str$=Str$(Jahr&)+"1123"
23Str&=val(23Str$)
23Date&=DBtoDate(23Str&)

if WT23%=3' Mi

    BB&=IncDay(23Date&,-7)

elseif WT23%=2' Di

    BB&=IncDay(23Date&,-6)

elseif WT23%=1' Mo

    BB&=IncDay(23Date&,-5)

elseif WT23%=7' So

    BB&=IncDay(23Date&,-4)

elseif WT23%=6' Sa

    BB&=IncDay(23Date&,-3)

elseif WT23%=5' Fr

    BB&=IncDay(23Date&,-2)

elseif WT23%=4' Do

    BB&=IncDay(23Date&,-1)

endif


könnte ja man vielleicht in @dt("getBettag",Jahr%) oder sowas machen...
weil die Feiertage:
Ostersonntag
Karfreitag
Ostermontag
Christi Himmelfahrt
Pfingsten (Mo)
und Fronleichnam müssen berechnet werden. Was eigentlich weniger schlimm ist, aber wie gesagt, bin zu faul
 
07.06.2015  
 




Peter
Max
Müller
Nabend.
Ohne große 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(%maxX,10),0-428,402;1
@DestroyWindow(Liste%)
End

Und hier ein Codeschnipsel für Mondphasen:
Declare DOUBLE d.i, d.ii, d.d
Declare STRING s.Mondphase
Def !FirstMond 105.49167
Def !SynodMond 29.5305589

Proc MondPhase

    Parameters STRING s.Datum
    d.i = Int((s.Datum-!FirstMond) / !SynodMond)*!SynodMond
    d.ii = ((s.datum-!FirstMond)-d.i) / !SynodMond

    If d.ii < 0.05

        s.Mondphase = "Vollmond"

    ElseIf (d.ii > 0.05) and (d.ii < 0.45)

        s.Mondphase = "Abnehmender Mond"

    ElseIf (d.ii > 0.45) AND (d.ii < 0.55)

        s.Mondphase = "Neumond"

    ElseIf (d.ii > 0.55) And (d.ii < 0.95)

        s.Mondphase = "Zunehmender Mond"

    Else

        s.Mondphase = "Vollmond"

    EndIf

EndProc

'd.d = !now
d.d = dt("setDate", "2.7.2015", d.d)
MondPhase d.d
CLS
Print str$(d.ii)
Print s.Mondphase
WaitInput
End
 
XProfan X3, X4ß, Win 10.1
08.06.2015  
 




ByteAttack
Ja schon klar...
Aber wäre doch "geiler" wenn man das in die Datumsfunktionen mit einbauen könnte. Perl und Php haben es zb auch drin
 
08.06.2015  
 




RGH
Dann hebe Dir den Vorschlag für die nächste Version auf. XProfan X3 ist schon in der Release-Phase. Da kommt nichts mehr Neues hinzu.

Gruß
Roland
 
XProfan X2
Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4
08.06.2015  
 



Antworten


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

2.758 Betrachtungen

Unbenanntvor 0 min.
Peter Max Müller21.01.2024
Michael W.11.12.2016
Magda18.02.2016
iF31.12.2015
Mehr...

Themeninformationen

Dieses Thema hat 3 Teilnehmer:

ByteAttack (2x)
RGH (1x)
Peter Max Müller (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


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