Spielereien mit Datumsberechnungen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Spielereien mit Datumsberechnungen

Beitrag von berie »

Hallo,
ich melde mich nach längerer Zeit mal wieder.
Ich habe kürzlich ein wenig mit Wochentagsberechnung und Osterberechnug herumgespielt. Das ist dabei herausgekommen:
(Ziemlich quick'n'dirty - zugegeben).

Hier kann man das Osterdatum eines Jahres berechnen lassen:

Code: Alles auswählen

;Osterdatum berechnen nach Spencers Osterformel
;siehe https://de.wikipedia.org/wiki/Spencers_Osterformel

EnableExplicit

Global.i tag,monat

Define jahr.s

Macro Divide(Formel,by,q,r)
  q=(Formel)/by
  r=(Formel)%by
EndMacro

Procedure Osterdatum(jahr.i)
  Protected.i a,b,c,d,e,f,g,h,i,k,l,m,n,o
  Protected dummy.i ; wenn "Quotient" oder "Remainder" nicht benötigt werden
  Divide(jahr,19,dummy,a)
  Divide(jahr,100,b,c)
  Divide(b,4,d,e)
  Divide(b+8,25,f,dummy)
  Divide(b-f+1,3,g,dummy)
  Divide(19*a+b-d-g+15,30,dummy,h)
  Divide(c,4,i,k)
  Divide(32+2*e+2*i-h-k,7,dummy,l)
  Divide(a+11*h+22*l,451,m,dummy)
  Divide(h+l-7*m+114,31,n,o)
  tag=o+1
  monat=n
EndProcedure

OpenConsole("Osterdatum berechnen")
PrintN(#CRLF$+" Das Programm berechnet das Osterdatum des angegebenen Jahres nach Spencers Osterformel")
PrintN(" für den gregorianischen Kalender ab 1582.") 
Repeat
  Print(#CRLF$+" Bitte Jahr eingeben (0 für Ende):")
  jahr=Input()
  If Val(jahr)>1582
    Osterdatum(Val(jahr))
    PrintN(" Der Ostersonntag des Jahres "+jahr+" ist/war am "+Str(tag)+"."+Str(monat)+".")
  Else
    CloseConsole()
    End
  EndIf
ForEver
Hier wird der Wochentag eines Datums berechnet:

Code: Alles auswählen

;Berechnung des Wochentages
;siehe https://de.wikipedia.org/wiki/Wochentagsberechnung

EnableExplicit

Procedure Wochentag(d,m,j)
  Protected w   ;Wochentag
  Protected c   ;Jahrhundert (die ersten beiden Stellen des Jahres)
  Protected y   ;Jahr (die letzten beiden Stellen des Jahres)
  Protected x.f
  Protected z  
  If m<=2:j-1:EndIf
  c=j/100
  y=j%100
  m-2  
  If m<=0:m+12:EndIf 
  x=2.6*m-0.2
  z=Int(x)
  w=(d+z+y+(y/4)+(c/4)-2*c)
  w%7
  If w<0:w+7:EndIf
  ProcedureReturn w
EndProcedure

Procedure Eingabe()  
  Protected.s t,m,j
  Protected jahr,schaltjahr=#False
  Protected Dim wtag.s(6)
  Protected Dim tage(12)
  wtag(0)="Sonntag"
  wtag(1)="Montag"
  wtag(2)="Dienstag"
  wtag(3)="Mittwoch"
  wtag(4)="Donnerstag"
  wtag(5)="Freitag"
  wtag(6)="Samstag"
  tage(1)=31
  tage(2)=29
  tage(3)=31
  tage(4)=30
  tage(5)=31
  tage(6)=30
  tage(7)=31
  tage(8)=31
  tage(9)=30
  tage(10)=31
  tage(11)=30
  tage(12)=31
  
  Repeat
    Repeat
      Print(#CRLF$+" Tag:   ")
      t=Input()
      If Val(t)<=0:ProcedureReturn :EndIf
    Until Val(t)<=31
    Repeat
      Print(" Monat: ")
      m=Input()
      If Val(m)<=0:ProcedureReturn :EndIf
    Until Val(m)>=1 And Val(m)<=12
    While Val(t)>tage(Val(m))   ;gibt es den Tag, z.B. den 31.4 ?
      Print(" Tag:   ")
      t=Input()
    Wend   
    Repeat
      Print(" Jahr:  ")
      j=Input()
      jahr=Val(j)
      If jahr<=0:ProcedureReturn :EndIf
    Until jahr>=1582
    If Val(m)=2 And Val(t)=29   ; 29.Februar ?
      schaltjahr=#False
      If jahr%4=0 Or jahr%400=0:schaltjahr=#True:EndIf 
      If schaltjahr=#False
        PrintN(" In diesem Jahr gab/gibt es keinen 29.Februar!")
        m="3":t="1"
      EndIf
    EndIf    
    PrintN(" Der "+t+"."+m+"."+j+" war/ist ein "+wtag(Wochentag(Val(t),Val(m),Val(j))))
  ForEver
EndProcedure

OpenConsole("Wochentag berechnen")
PrintN(#CRLF$+" Das Programm berechnet den Wochentag des eingegebenen Datums")
PrintN(" für den gregorianischen Kalender ab 1582.") 

Eingabe()

CloseConsole()
Hier sind die beiden Programme "zusammengefrickelt", um sämtliche bundesweite gesetzliche Feiertage eines Jahres zu berechnen:

Code: Alles auswählen

EnableExplicit

Global tag,monat,jahr
Define Neujahr,TagDerArbeit,TagDerEinheit,ErsterWeihnachtstag
Global Dim wtag.s(6)
Global Dim tage(12)

wtag(0)="Sonntag"
wtag(1)="Montag"
wtag(2)="Dienstag"
wtag(3)="Mittwoch"
wtag(4)="Donnerstag"
wtag(5)="Freitag"
wtag(6)="Samstag"
tage(1)=31
tage(2)=28
tage(3)=31
tage(4)=30
tage(5)=31
tage(6)=30
tage(7)=31
tage(8)=31
tage(9)=30
tage(10)=31
tage(11)=30
tage(12)=31

Macro Divide(Formel,by,q,r)
  q=(Formel)/by
  r=(Formel)%by
EndMacro

Procedure Osterdatum(jahr.i)
  Protected.i a,b,c,d,e,f,g,h,i,k,l,m,n,o
  Protected dummy.i ; wenn "Quotient" oder "Remainder" nicht benötigt werden
  Divide(jahr,19,dummy,a)
  Divide(jahr,100,b,c)
  Divide(b,4,d,e)
  Divide(b+8,25,f,dummy)
  Divide(b-f+1,3,g,dummy)
  Divide(19*a+b-d-g+15,30,dummy,h)
  Divide(c,4,i,k)
  Divide(32+2*e+2*i-h-k,7,dummy,l)
  Divide(a+11*h+22*l,451,m,dummy)
  Divide(h+l-7*m+114,31,n,o)
  tag=o+1
  monat=n
EndProcedure

Procedure Wochentag(d,m,j)
  Protected w   ;Wochentag
  Protected c   ;Jahrhundert (die ersten beiden Stellen des Jahres)
  Protected y   ;Jahr (die letzten beiden Stellen des Jahres)
  Protected x.f
  Protected z  
  If m<=2:j-1:EndIf
  c=j/100
  y=j%100
  m-2  
  If m<=0:m+12:EndIf 
  x=2.6*m-0.2
  z=Int(x)
  w=(d+z+y+(y/4)+(c/4)-2*c)
  w%7
  If w<0:w+7:EndIf
  ProcedureReturn w
EndProcedure

Procedure Addiere(t)  ;addiert t Tage zu den globalen Variablen tag und ggf. monat bzw. jahr
  tag+t
  While tag>tage(monat) ;Da es hier nicht benötigt wird, wird kein Schaltjahr berücksichtigt.
    tag-tage(monat)
    monat+1
    If monat>12:monat-12:jahr+1:EndIf
  Wend  
EndProcedure

OpenConsole("Feiertage berechnen")
PrintN(#CRLF$+" Das Programm berechnet die bundesweiten gesetzlichen Feiertage des angegeben Jahres")
PrintN(" für den gregorianischen Kalender ab 1582.")
PrintN(" Das Programm berücksichtigt den Tag der Deutschen Einheit.")
Repeat
  Print(#CRLF$+" Bitte Jahr eingeben (0 für Ende):")
  jahr=Val(Input())
  If jahr>1582
    Neujahr=Wochentag(1,1,jahr)
    TagDerArbeit=Wochentag(1,5,jahr)
    ErsterWeihnachtstag=Wochentag(25,12,jahr)
    PrintN(" Neujahr (1.1.)"+#TAB$+#TAB$+#TAB$+#TAB$+wtag(Neujahr))
    PrintN(" Tag der Arbeit (1.5.)"+#TAB$+#TAB$+#TAB$+wtag(TagDerArbeit))
    If jahr>=1990
      TagDerEinheit=Wochentag(3,10,jahr)      
      PrintN(" Tag der Deutschen Einheit (3.10.)"+#TAB$+wtag(TagDerEinheit))
    EndIf
    If jahr>=1953 And jahr<1990
      TagDerEinheit=Wochentag(17,6,jahr)      
      PrintN(" Tag der Deutschen Einheit (17.6.)"+#TAB$+wtag(TagDerEinheit))
    EndIf      
    PrintN(" Erster Weihnachtstag (25.12.)"+#TAB$+#TAB$+wtag(ErsterWeihnachtstag))
    Osterdatum(jahr)
    PrintN(" Ostersonntag"+#TAB$+#TAB$+#TAB$+#TAB$+Str(tag)+"."+Str(monat)+".")
    Addiere(39) ;Himmelfahrt ist 39 Tage nach Ostern
    PrintN(" Christi Himmelfahrt"+#TAB$+#TAB$+#TAB$+Str(tag)+"."+Str(monat)+".")    
    Addiere(10) ;Pfingsten ist 49 Tage nach Ostern
    PrintN(" Pfingstsonntag"+#TAB$+#TAB$+#TAB$+#TAB$+Str(tag)+"."+Str(monat)+".")
  Else
    CloseConsole()
    End
  EndIf
ForEver
formerly known as bizzl
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Spielereien mit Datumsberechnungen

Beitrag von berie »

Hallo,
jetzt ist es nicht mehr so heiss und die "grauen Zellen" arbeiten wieder halbwegs.

Darum habe ich mich hingesetzt und das alles in ein Programm gepackt und eine GUI drumherum gebastelt.
Ist allerdings immer noch nicht gut kommentiert.

Viel Spass damit.

Code: Alles auswählen

EnableExplicit

#WinW=280
#WinH=210
#WinTitle="Feiertage"

;-Init

;-Enum
Enumeration 
  #TagGadget
  #MonatGadget
  #JahrGadget
  #AnzeigeGadget
  #BerechnenGadget
EndEnumeration

;-Const

;-Structure

;-Global
Global event
Global Dim Wochentag.s(6)
Global Dim TageImMonat(12)

;-Use

;-Define

;-Declare

;-Include

;-Macro
Macro Divide(Formel,by,q,r)   ;für Osterdatum
  q=(Formel)/by
  r=(Formel)%by
EndMacro

Procedure InitGui()
  Protected c,x=10,y=10,w=50,h=22,xo=w+10,a.s
  
  ExamineDesktops()
  OpenWindow(1,(DesktopWidth(0)-#WinW)/2,(DesktopHeight(0)-#WinH)/2+50,#WinW,#WinH,#WinTitle,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
  ComboBoxGadget(#TagGadget,x,y,w,h,#PB_ComboBox_Editable)
  For c=1 To 31
    AddGadgetItem(#TagGadget,-1,Str(c))
  Next
  x+xo 
  ComboBoxGadget(#MonatGadget,x,y,w,h,#PB_ComboBox_Editable)
  For c=1 To 12
    AddGadgetItem(#MonatGadget,-1,Str(c))
  Next 
  x+xo
  StringGadget(#JahrGadget,x,y,w,h,"",#PB_String_Numeric)
  x+xo
  ButtonGadget(#BerechnenGadget,x,y,w+30,h+1,"Berechnen")
  x=10
  y+30
  EditorGadget(#AnzeigeGadget,x,y,260,150,#PB_Editor_ReadOnly)
  Repeat
    Read.s a
    If a="XXX":Break:EndIf
    AddGadgetItem(#AnzeigeGadget,-1,a)
  ForEver
  
EndProcedure

Procedure InitProgram()
  Protected x
  
  For x=0 To 6
    Read.s Wochentag(x)
  Next
  For x=1 To 12
    Read.i TageImMonat(x)
  Next  
EndProcedure  

Procedure WochentagBerechnen(d,m,j)
  ;Berechnung des Wochentages
  ;siehe https://de.wikipedia.org/wiki/Wochentagsberechnung
  Protected w   ;Wochentag
  Protected c   ;Jahrhundert (die ersten beiden Stellen des Jahres)
  Protected y   ;Jahr (die letzten beiden Stellen des Jahres)
  Protected x.f
  Protected z
  
  If m<=2:j-1:EndIf
  c=j/100
  y=j%100
  m-2  
  If m<=0:m+12:EndIf 
  x=2.6*m-0.2
  z=Int(x)
  w=(d+z+y+(y/4)+(c/4)-2*c)
  w%7
  If w<0:w+7:EndIf
  
  ProcedureReturn w
EndProcedure

Procedure Osterdatum(j)
  ;Osterdatum berechnen nach Spencers Osterformel
  ;siehe https://de.wikipedia.org/wiki/Spencers_Osterformel
  Protected a,b,c,d,e,f,g,h,i,k,l,m,n,o
  Protected dummy ; wenn "Quotient" oder "Remainder" nicht benötigt werden
  
  Divide(j,19,dummy,a)
  Divide(j,100,b,c)
  Divide(b,4,d,e)
  Divide(b+8,25,f,dummy)
  Divide(b-f+1,3,g,dummy)
  Divide(19*a+b-d-g+15,30,dummy,h)
  Divide(c,4,i,k)
  Divide(32+2*e+2*i-h-k,7,dummy,l)
  Divide(a+11*h+22*l,451,m,dummy)
  Divide(h+l-7*m+114,31,n,o)
  
  ProcedureReturn n*40+o+1
EndProcedure

Procedure Addiere(tage,t,m) ;addiert "tage" zu "t" für Himmelfahrt und Pfingsten, Schaltjahr ist hier nicht relevant
  t+tage
  While t>TageImMonat(m)
    t-TageImMonat(m)
    m+1
  Wend
  
  ProcedureReturn m*40+t
EndProcedure

Procedure Schaltjahr(j)
  Protected s
  
  If j%4=0:s=1:EndIf    ;jahr durch 4 teilbar ? Dann Schaltjahr
  If j%100=0:s=0:EndIf  ;durch 100 teilbar ? Dann doch nicht
  If j%400=0:s=1:EndIf  ;durch 400 teilbar ? Dann doch wieder
  
  ProcedureReturn s
EndProcedure

Procedure TageDesMonats(m,j)
  Protected t=TageImMonat(m)
  
  If m=2 
    t+Schaltjahr(j)
  EndIf
  
  ProcedureReturn t
EndProcedure

Procedure Berechnen(t,m,j)
  Protected wt.s=Wochentag(WochentagBerechnen(t,m,j))
  Protected od=Osterdatum(j),ot=od%40,om=od/40                ;Ostersonntag
  Protected chd=Addiere(39,ot,om),cht=chd%40,chm=chd/40       ;Himmelfahrt
  Protected pd=Addiere(49,ot,om),pt=pd%40,pm=pd/40            ;Pfingstsonntag
  Protected TagDerEinheit,tde.s="Tag der Deutschen Einheit "
  Protected sj.s="ein"
  If j>=1953 And j<1990
    TagDerEinheit=WochentagBerechnen(17,6,j)
    tde+"(17.6.)"+#TAB$+Wochentag(TagDerEinheit)
  EndIf
  If j>=1990
    TagDerEinheit=WochentagBerechnen(3,10,j)
    tde+"(3.10.)"+#TAB$+Wochentag(TagDerEinheit)
  EndIf
  If Schaltjahr(j)=0:sj="kein":EndIf 
  ClearGadgetItems(#AnzeigeGadget)
  AddGadgetItem(#AnzeigeGadget,-1,"Das Jahr "+Str(j)+" war/ist "+sj+" Schaltjahr")
  AddGadgetItem(#AnzeigeGadget,-1,"")
  AddGadgetItem(#AnzeigeGadget,-1,"Der "+Str(t)+"."+Str(m)+"."+Str(j)+" war/ist ein"+#TAB$+#TAB$+wt)
  AddGadgetItem(#AnzeigeGadget,-1,"")
  AddGadgetItem(#AnzeigeGadget,-1,"Neujahr (1.1.)"+#TAB$+#TAB$+#TAB$+Wochentag(WochentagBerechnen(1,1,j)))
  AddGadgetItem(#AnzeigeGadget,-1,"Tag der Arbeit (1.5)"+#TAB$+#TAB$+#TAB$+Wochentag(WochentagBerechnen(1,5,j)))
  If TagDerEinheit
    AddGadgetItem(#AnzeigeGadget,-1,tde)
  EndIf
  AddGadgetItem(#AnzeigeGadget,-1,"Erster Weihnachtstag (25.12.)"+#TAB$+#TAB$+Wochentag(WochentagBerechnen(25,12,j)))  
  AddGadgetItem(#AnzeigeGadget,-1,"Ostersonntag"+#TAB$+#TAB$+#TAB$+Str(ot)+"."+Str(om))
  AddGadgetItem(#AnzeigeGadget,-1,"Christi Himmelfahrt"+#TAB$+#TAB$+#TAB$+Str(cht)+"."+Str(chm))
  AddGadgetItem(#AnzeigeGadget,-1,"Pfingstsonntag"+#TAB$+#TAB$+#TAB$+Str(pt)+"."+Str(pm))
EndProcedure

Procedure Main()
  Protected jahr=Random(2100,1582)
  Protected monat=Random(12,1)
  Protected tdm,tag
  
  InitGui()
  InitProgram()
  tag=Random(TageDesMonats(monat,jahr),1)
  SetGadgetState(#TagGadget,tag-1)
  SetGadgetState(#MonatGadget,monat-1)
  SetGadgetText(#JahrGadget,Str(jahr))
  Repeat
    event=WaitWindowEvent()
    If event=#PB_Event_Gadget
      Select EventGadget()
        Case #BerechnenGadget:Berechnen(tag,monat,jahr)
        Case #TagGadget
          tag=Val(GetGadgetText(#TagGadget))
          If tag<1:tag=1:SetGadgetText(#TagGadget,"1"):EndIf
          tdm=TageDesMonats(monat,jahr)
          If tag>tdm
            tag=tdm
            SetGadgetText(#TagGadget,Str(tag))
          EndIf 
        Case #MonatGadget
          monat=Val(GetGadgetText(#MonatGadget))
          If monat<1:monat=1:SetGadgetText(#MonatGadget,"1"):EndIf
          If monat>12:monat=12:SetGadgetText(#MonatGadget,"12"):EndIf
          tdm=TageDesMonats(monat,jahr)
          If tag>tdm
            tag=tdm
            SetGadgetText(#TagGadget,Str(tag))
          EndIf 
        Case #JahrGadget
          If EventType()=#PB_EventType_Focus
            SetGadgetText(#JahrGadget,"")
          EndIf        
          If EventType()=#PB_EventType_Change
            jahr=Val(GetGadgetText(#JahrGadget))
            If jahr>=1582
              tdm=TageDesMonats(monat,jahr)
              If tag>tdm
                tag=tdm
                SetGadgetText(#TagGadget,Str(tag))
              EndIf  
            EndIf 
          EndIf
      EndSelect
    EndIf  
  Until event=#PB_Event_CloseWindow
EndProcedure

Main()

DataSection
  Data.s "Das Programm berechnet den Wochentag","des eingegeben Datums"
  Data.s "und die gesetzlichen Feiertage des Jahres","nach dem gregorianischen Kalender ab 1582."
  Data.s "Das Programm berücksichtigt den","Tag der Deutschen Einheit (17.6./3.10.)."
  Data.s "XXX"
  Data.s "Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Sonnabend"
  Data.i 31,28,31,30,31,30,31,31,30,31,30,31 
EndDataSection

P.S.: Wieso kann man den Codeblock eigentlich nicht falten ?
formerly known as bizzl
Benutzeravatar
#NULL
Beiträge: 2235
Registriert: 20.04.2006 09:50

Re: Spielereien mit Datumsberechnungen

Beitrag von #NULL »

berie hat geschrieben:P.S.: Wieso kann man den Codeblock eigentlich nicht falten ?
Meinst du die DataSection? Man kann in Preferences > Editor > Folding Keywords hinzufügen, z.b. für DataSection und EndDataSection. Oder ;{ ... ;} verwenden (wenn sie dort eingetragen sind)

Code: Alles auswählen

;{
DataSection
  Data.s "Das Programm berechnet den Wochentag","des eingegeben Datums"
  Data.s "und die gesetzlichen Feiertage des Jahres","nach dem gregorianischen Kalender ab 1582."
  Data.s "Das Programm berücksichtigt den","Tag der Deutschen Einheit (17.6./3.10.)."
  Data.s "XXX"
  Data.s "Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Sonnabend"
  Data.i 31,28,31,30,31,30,31,31,30,31,30,31
EndDataSection
;}
my pb stuff..
Bild..jedenfalls war das mal so.
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Spielereien mit Datumsberechnungen

Beitrag von berie »

Ich meine den Code in meinem Beitrag hier im Forum.
Ich kenne das aus dem DBPro-Forum, dort konnte man den Code falten wie in der PB-IDE, so dass man beim Lesen der Seite nicht ewig und drei Tage scrollen musste. Wenn man den Code lesen wollte, konnte man ihn aufklappen.

Siehe z.B. https://forum.thegamecreators.com/thread/222746.
Der Beitrag ist nicht von mir, er soll hier nur als Beispiel dienen.
Wenn du auf "+Code Snippet" klickst, klappt der Code auf.
So ein Feature vermisse ich hier.
formerly known as bizzl
Benutzeravatar
Kiffi
Beiträge: 10621
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Re: Spielereien mit Datumsberechnungen

Beitrag von Kiffi »

<OT>
berie hat geschrieben:So ein Feature vermisse ich hier.
da bist Du nicht der einzige.

Bezüglich so mancher Komfort-Funktionen, wie man sie aus anderen Foren kennt, sind die PB-Foren recht stiefmütterlich versorgt.

Grüße ... Peter

</OT>
Hygge
Benutzeravatar
NicknameFJ
Beiträge: 324
Registriert: 03.06.2007 14:36
Wohnort: Von der Sonne aus gesehen der dritte Planet

Re: Spielereien mit Datumsberechnungen

Beitrag von NicknameFJ »

[OT]

Zumindest für Firefox gibt es ein Addon "GreaseMonkey" und im Forum eine Scriptdatei die das Folding ermöglicht.

Ich nutze das schon seit Jahren und bin damit sehr zufrieden.


NicknameFJ


EDIT:
https://www.purebasic.fr/english/viewto ... 86#p464686

Nur diese Zeilen am Anfang

Code: Alles auswählen

// @include         http://purebasic.fr/*
// @include         http://www.purebasic.fr/*
// @include         http://purebasic.com/*
// @include         http://www.purebasic.com/*
// @include         http://forums.purebasic.fr/*
so ändern, dann funktioniert es auch mit den neuen https Seiten

Code: Alles auswählen

// @include         https://purebasic.fr/*
// @include         https://www.purebasic.fr/*
// @include         https://purebasic.com/*
// @include         https://www.purebasic.com/*
// @include         https://forums.purebasic.fr/*
[/OT]
PS: Alle im Text enthaltenen Schreibfehler sind beabsichtigt und dienen der Belustigung aller

Bild
berie
Beiträge: 75
Registriert: 17.01.2018 08:52
Computerausstattung: Windows 11 64 bit, i7, 16GB RAM
Wohnort: Wesertal in Nordhessen

Re: Spielereien mit Datumsberechnungen

Beitrag von berie »

Hallo,
ich habe noch einen Fehler korrigiert (Der Tag der Einheit wurde nicht richtig angezeigt)
und das StringGadget zur Eingabe der Jahreszahl in ein SpinGadget geändert.

Code: Alles auswählen

EnableExplicit

#WinW=280
#WinH=210
#WinTitle="Feiertage"

;-Init

;-Enum
Enumeration 
  #TagGadget
  #MonatGadget
  #JahrGadget
  #AnzeigeGadget
  #BerechnenGadget
EndEnumeration

;-Const

;-Structure

;-Global
Global event
Global Dim Wochentag.s(6)
Global Dim TageImMonat(12)

;-Use

;-Define

;-Declare

;-Include

;-Macro
Macro Divide(Formel,by,q,r)   ;für Osterdatum
  q=(Formel)/by
  r=(Formel)%by
EndMacro

Procedure InitGui()
  Protected c,x=10,y=10,w=50,h=22,xo=w+10,a.s
  
  ExamineDesktops()
  OpenWindow(1,(DesktopWidth(0)-#WinW)/2,(DesktopHeight(0)-#WinH)/2+50,#WinW,#WinH,#WinTitle,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
  ComboBoxGadget(#TagGadget,x,y,w,h,#PB_ComboBox_Editable)
  For c=1 To 31
    AddGadgetItem(#TagGadget,-1,Str(c))
  Next
  x+xo 
  ComboBoxGadget(#MonatGadget,x,y,w,h,#PB_ComboBox_Editable)
  For c=1 To 12
    AddGadgetItem(#MonatGadget,-1,Str(c))
  Next 
  x+xo
  SpinGadget(#JahrGadget,x,y,w,h,1582,9999,#PB_Spin_Numeric)
  x+xo
  ButtonGadget(#BerechnenGadget,x,y,w+30,h+1,"Berechnen")
  x=10
  y+30
  EditorGadget(#AnzeigeGadget,x,y,260,150,#PB_Editor_ReadOnly)
  Repeat
    Read.s a
    If a="XXX":Break:EndIf
    AddGadgetItem(#AnzeigeGadget,-1,a)
  ForEver
  AddKeyboardShortcut(1,#PB_Shortcut_Return,100)
  
EndProcedure

Procedure InitProgram()
  Protected x
  
  For x=0 To 6
    Read.s Wochentag(x)
  Next
  For x=1 To 12
    Read.i TageImMonat(x)
  Next  
EndProcedure  

Procedure WochentagBerechnen(d,m,j)
  ;Berechnung des Wochentages
  ;siehe https://de.wikipedia.org/wiki/Wochentagsberechnung
  Protected w   ;Wochentag
  Protected c   ;Jahrhundert (die ersten beiden Stellen des Jahres)
  Protected y   ;Jahr (die letzten beiden Stellen des Jahres)
  Protected x.f
  Protected z
  
  If m<=2:j-1:EndIf
  c=j/100
  y=j%100
  m-2  
  If m<=0:m+12:EndIf 
  x=2.6*m-0.2
  z=Int(x)
  w=(d+z+y+(y/4)+(c/4)-2*c)
  w%7
  If w<0:w+7:EndIf
  
  ProcedureReturn w
EndProcedure

Procedure Osterdatum(j)
  ;Osterdatum berechnen nach Spencers Osterformel
  ;siehe https://de.wikipedia.org/wiki/Spencers_Osterformel
  Protected a,b,c,d,e,f,g,h,i,k,l,m,n,o
  
  a=j%19
  Divide(j,100,b,c)
  Divide(b,4,d,e)
  f=(b+8)/25
  g=(b-f+1)/3
  h=(19*a+b-d-g+15)%30
  Divide(c,4,i,k)
  l=(32+2*e+2*i-h-k)%7
  m=(a+11*h+22*l)/451
  Divide(h+l-7*m+114,31,n,o)

  ProcedureReturn n*40+o+1
EndProcedure

Procedure Addiere(tage,t,m) ;addiert "tage" zu "t" für Himmelfahrt und Pfingsten, Schaltjahr ist hier nicht relevant
  t+tage
  While t>TageImMonat(m)
    t-TageImMonat(m)
    m+1
  Wend
  
  ProcedureReturn m*40+t
EndProcedure

Procedure Schaltjahr(j)
  Protected s
  
  If j%4=0:s=1:EndIf    ;jahr durch 4 teilbar ? Dann Schaltjahr
  If j%100=0:s=0:EndIf  ;durch 100 teilbar ? Dann doch nicht
  If j%400=0:s=1:EndIf  ;durch 400 teilbar ? Dann doch wieder
  
  ProcedureReturn s
EndProcedure

Procedure TageDesMonats(m,j)
  Protected t=TageImMonat(m)
  
  If m=2 
    t+Schaltjahr(j)
  EndIf
  
  ProcedureReturn t
EndProcedure

Procedure Berechnen(t,m,j)
  Protected wt.s=Wochentag(WochentagBerechnen(t,m,j))
  Protected od=Osterdatum(j),ot=od%40,om=od/40                ;Ostersonntag
  Protected chd=Addiere(39,ot,om),cht=chd%40,chm=chd/40       ;Himmelfahrt
  Protected pd=Addiere(49,ot,om),pt=pd%40,pm=pd/40            ;Pfingstsonntag
  Protected TagDerEinheit,tde.s
  Protected sj.s="ein"
  If j>=1953 And j<1990
    TagDerEinheit=WochentagBerechnen(17,6,j)
    tde="Tag der Deutschen Einheit (17.6.)"+#TAB$+Wochentag(TagDerEinheit)
  EndIf
  If j>=1990
    TagDerEinheit=WochentagBerechnen(3,10,j)
    tde="Tag der Deutschen Einheit (3.10.)"+#TAB$+Wochentag(TagDerEinheit)
  EndIf
  If Schaltjahr(j)=0:sj="kein":EndIf 
  ClearGadgetItems(#AnzeigeGadget)
  AddGadgetItem(#AnzeigeGadget,-1,"Das Jahr "+Str(j)+" war/ist "+sj+" Schaltjahr")
  AddGadgetItem(#AnzeigeGadget,-1,"")
  AddGadgetItem(#AnzeigeGadget,-1,"Der "+Str(t)+"."+Str(m)+"."+Str(j)+" war/ist ein"+#TAB$+#TAB$+wt)
  AddGadgetItem(#AnzeigeGadget,-1,"")
  AddGadgetItem(#AnzeigeGadget,-1,"Neujahr (1.1.)"+#TAB$+#TAB$+#TAB$+Wochentag(WochentagBerechnen(1,1,j)))
  AddGadgetItem(#AnzeigeGadget,-1,"Tag der Arbeit (1.5)"+#TAB$+#TAB$+#TAB$+Wochentag(WochentagBerechnen(1,5,j)))
  If tde
    AddGadgetItem(#AnzeigeGadget,-1,tde)
  EndIf
  AddGadgetItem(#AnzeigeGadget,-1,"Erster Weihnachtstag (25.12.)"+#TAB$+#TAB$+Wochentag(WochentagBerechnen(25,12,j)))  
  AddGadgetItem(#AnzeigeGadget,-1,"Ostersonntag"+#TAB$+#TAB$+#TAB$+Str(ot)+"."+Str(om))
  AddGadgetItem(#AnzeigeGadget,-1,"Christi Himmelfahrt"+#TAB$+#TAB$+#TAB$+Str(cht)+"."+Str(chm))
  AddGadgetItem(#AnzeigeGadget,-1,"Pfingstsonntag"+#TAB$+#TAB$+#TAB$+Str(pt)+"."+Str(pm))
EndProcedure

Procedure Main()
  Protected da=Date()
  Protected jahr=Year(da)
  Protected monat=Month(da)
  Protected tag=Day(da)
  Protected tdm
  
  InitGui()
  InitProgram()
  SetGadgetState(#TagGadget,tag-1)
  SetGadgetState(#MonatGadget,monat-1)
  SetGadgetText(#JahrGadget,Str(jahr))
  SetGadgetState(#JahrGadget,jahr)
  Repeat
    event=WaitWindowEvent()
    Select event 
      Case #PB_Event_Menu
        If EventMenu()=100
          jahr=GetGadgetState(#JahrGadget)
          If jahr>=1582
            tdm=TageDesMonats(monat,jahr)
            If tag>tdm
              tag=tdm
              SetGadgetText(#TagGadget,Str(tag))
            EndIf
            Berechnen(tag,monat,jahr)
          EndIf 
        EndIf
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #BerechnenGadget:Berechnen(tag,monat,jahr)
          Case #TagGadget
            tag=Val(GetGadgetText(#TagGadget))
            If tag<1:tag=1:SetGadgetText(#TagGadget,"1"):EndIf
            tdm=TageDesMonats(monat,jahr)
            If tag>tdm
              tag=tdm
              SetGadgetText(#TagGadget,Str(tag))
            EndIf 
          Case #MonatGadget
            monat=Val(GetGadgetText(#MonatGadget))
            If monat<1:monat=1:SetGadgetText(#MonatGadget,"1"):EndIf
            If monat>12:monat=12:SetGadgetText(#MonatGadget,"12"):EndIf
            tdm=TageDesMonats(monat,jahr)
            If tag>tdm
              tag=tdm
              SetGadgetText(#TagGadget,Str(tag))
            EndIf 
          Case #JahrGadget
            Select EventType()
              Case #PB_EventType_Up:jahr+1:Berechnen(tag,monat,jahr)
              Case #PB_EventType_Down:jahr-1:Berechnen(tag,monat,jahr)
            EndSelect
        EndSelect
    EndSelect
  Until event=#PB_Event_CloseWindow
EndProcedure

Main()

DataSection
  Data.s "Das Programm berechnet den Wochentag","des eingegeben Datums"
  Data.s "und die gesetzlichen Feiertage des Jahres","nach dem gregorianischen Kalender ab 1582."
  Data.s "Das Programm berücksichtigt den","Tag der Deutschen Einheit (17.6./3.10.)."
  Data.s "XXX"
  Data.s "Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Sonnabend"
  Data.i 31,28,31,30,31,30,31,31,30,31,30,31 
EndDataSection

formerly known as bizzl
Antworten