Aktuelle Zeit: 14.11.2018 05:20

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 7 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Spielereien mit Datumsberechnungen
BeitragVerfasst: 21.06.2018 23:46 
Offline

Registriert: 17.01.2018 08:52
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:
;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:
;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:
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Spielereien mit Datumsberechnungen
BeitragVerfasst: 12.08.2018 10:18 
Offline

Registriert: 17.01.2018 08:52
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:
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Spielereien mit Datumsberechnungen
BeitragVerfasst: 12.08.2018 10:34 
Offline
Benutzeravatar

Registriert: 20.04.2006 09:50
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:
;{
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.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Spielereien mit Datumsberechnungen
BeitragVerfasst: 12.08.2018 16:35 
Offline

Registriert: 17.01.2018 08:52
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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Spielereien mit Datumsberechnungen
BeitragVerfasst: 12.08.2018 17:35 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9
<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>

_________________
ƃᴉɹǝᴉʍɥɔs ʇsᴉ ɥɔɐɟuᴉǝ


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Spielereien mit Datumsberechnungen
BeitragVerfasst: 14.08.2018 12:24 
Offline
Benutzeravatar

Registriert: 03.06.2007 14:36
Wohnort: Von der Sonne aus gesehen der dritte Planet
[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/viewtopic.php?p=464686#p464686

Nur diese Zeilen am Anfang

Code:
// @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:
// @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


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Spielereien mit Datumsberechnungen
BeitragVerfasst: 09.09.2018 09:58 
Offline

Registriert: 17.01.2018 08:52
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:
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


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 7 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 7 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye