DayOfWeek(Datum)

[rolaf]

Hi PB-Leute,

gibts ne einfache Möglichkeit die Funktion DayOfWeek nachzubilden ohne diese Einschränkung auf die Jahre 1970 bis 2038? Ich brauchs speziell vom Jahr 1950 bis min. 2050.

[Pelagio]

Hallo DrFalo,

ich hatte schon vor einiger Zeit das gleiche Problem gehabt und habe mir dafür eine Include geschrieben,
ich bin mir sicher das Du sicherlich diese als Ansatz für Dein Problem benutzen kannst.

Code: Alles auswählen

; Gregorianischer Kalender
;~~~~~~~~~~~~~~~~~~~~~~~~~~

;{- Konstanten 

#myDate_SekMin   = 60 
#myDate_MinStd   = 60 
#myDate_StdTag   = 24 
#myDate_TagJahr  = 365
#myDate_SekStd   = #myDate_MinStd * #myDate_SekMin 
#myDate_SekTag   = #myDate_StdTag * #myDate_SekStd 
#myDate_TagMon   = "31,28,31,30,31,30,31,31,30,31,30,31"
#myDate_Monate   = "Januar, Februar, März, April, Mai, Juni, Juli, August, September, Oktober, November, Dezember"
#myDate_Tage     = "Sonntag, Montag, Dienstag, Mittwoch, Donnerstag, Freitag, Samstag"

Enumeration
   #myDate_Year
   #myDate_Month
   #myDate_Week 
   #myDate_Day  
   #myDate_Hour 
   #myDate_Minute
   #myDate_Second
EndEnumeration

;} EndKonstanten

;{- Proceduren 

Procedure.l myDayOfYear(Zeitwert.q) 
   Protected n.b, Tage.l, Jahre.l, SchaltTag.w
   
   Tage = Zeitwert/#myDate_SekTag
   While (Tage>0)
      For n=1 To 12
         Tage - Val(StringField(#myDate_TagMon, n, ","))
      Next n
      If Not Jahre%400 Or (Not Jahre%4 And Jahre%100): SchaltTag + 1: Tage - 1: EndIf 
      Jahre + 1
   Wend
   Zeitwert = Zeitwert - (Jahre * #myDate_TagJahr + SchaltTag) * #myDate_SekTag
   Tage     = Round(Zeitwert/#myDate_SekTag, #PB_Round_Up) + #myDate_TagJahr
   ProcedureReturn Tage
EndProcedure 

Procedure.q myDate(Jahr.l = 0, Monat.b = 0, Tag.b = 0, Stunde.b = 0, Minute.b = 0, Sekunde.b = 0) 
   Protected n.l, ZeitWert.q, SchaltTag.w

   If (Jahr=0) And (Monat=0) And (Tag=0) And (Stunde=0) And (Minute=0) And (Sekunde=0)
      Jahr = Year(Date()): Monat = Month(Date()): Tag = Day(Date())
      Stunde = Hour(Date()): Minute = Minute(Date()): Sekunde = Second(Date())
   EndIf      
;Jahresrechnung:
   For n=0 To (Jahr-1)
      If Not n%400 Or (Not n%4 And n%100): SchaltTag + 1: EndIf
   Next n
   ZeitWert = ((Jahr-1) * #myDate_TagJahr + SchaltTag) * #myDate_SekTag

;Monatsberechnung:
   For n=1 To (Monat-1)
      Zeitwert + (Val(StringField(#myDate_TagMon, n, ",")) * #myDate_SekTag)
   Next n
   If (Monat>2) Or ((Monat=2) And (Tag=29))
      If Not Jahr%400 Or (Not Jahr%4 And Jahr%100): ZeitWert + #myDate_SekTag: EndIf
   EndIf
   
;Tagesberechnung: 
   Zeitwert + (Tag-1)* #myDate_SekTag
    
;Zeitberechnung:
   Zeitwert + Stunde * #myDate_SekStd 
   Zeitwert + Minute * #myDate_SekMin 
   Zeitwert + Sekunde
   
   ProcedureReturn Zeitwert 
EndProcedure 

Procedure.l myYear(Zeitwert.q) 
   Protected n.b, Tage.l, Jahr.l
   
   Tage = Zeitwert/#myDate_SekTag
   While (Tage>0)
      For n=1 To 12
         Tage - Val(StringField(#myDate_TagMon, n, ","))
      Next n
      If Not Jahr%400 Or (Not Jahr%4 And Jahr%100): Tage - 1: EndIf 
      Jahr + 1
   Wend
   ProcedureReturn Jahr
 EndProcedure 

Procedure.l myMonth(Zeitwert.q) 
   Protected Jahr.l = myYear(Zeitwert) 
   Protected Tage.l = myDayOfYear(Zeitwert) 
   Protected Monat.b
   
   If (Tage>59) 
      If Not Jahr%400 Or (Not Jahr%4 And Jahr%100): Tage - 1: EndIf 
   EndIf 
   For Monat=1 To 12
      Tage - Val(StringField(#myDate_TagMon, Monat, ","))
      If (Tage<=0): Break: EndIf
   Next Monat
   ProcedureReturn Monat
EndProcedure 

Procedure.b myDayOfWeek(Zeitwert.q, wStart.c = #False) 
   Protected Tage.q = Zeitwert / #myDate_SekTag 
   Protected Wochentag.b
 
   If wStart
      WochenTag = (Tage%7)
      If Not WochenTag: WochenTag = 7: EndIf
   Else
      WochenTag = (Tage%7)+1
   EndIf 
  
   ProcedureReturn WochenTag
EndProcedure 

Procedure.l myDay(Zeitwert.q)
   Protected Jahr.l  = myYear(Zeitwert) 
   Protected Monat.l = myMonth(Zeitwert) 
   Protected Tage.l  = myDayOfYear(Zeitwert) 
   
   If (Tage>59) 
      If Not Jahr%400 Or (Not Jahr%4 And Jahr%100): SchaltTag + 1: EndIf 
   EndIf
   For n=1 To (Monat-1)
      Tage - Val(StringField(#myDate_TagMon, n, ","))
      If (n=2): Tage - SchaltTag: EndIf
   Next n
   
   ProcedureReturn Tage
EndProcedure

Procedure.l myHour(Zeitwert.q) 
   Protected Stunde.l = (Zeitwert / #myDate_SekStd) % #myDate_StdTag 
   ProcedureReturn Stunde
EndProcedure 

Procedure.l myMinute(Zeitwert.q) 
   Protected Minute.l = (Zeitwert / #myDate_SeKMin) % #myDate_MinStd 
   ProcedureReturn Minute
EndProcedure 

Procedure.l mySecond(Zeitwert.q) 
   Protected Sekunde.l = (Zeitwert) % #myDate_SekMin 
   ProcedureReturn Sekunde 
EndProcedure 

Procedure.s myFormatDate(Maske.s, ZeitWert.q) 
 Maske = ReplaceString(Maske, "%yyyy",       Str(myYear  (Zeitwert))) 
 Maske = ReplaceString(Maske, "%yy"  , Right(Str(myYear  (Zeitwert)), 2)) 
 Maske = ReplaceString(Maske, "%mmmm", StringField(#myDate_Monate, myMonth(Zeitwert), ",")) 
 Maske = ReplaceString(Maske, "%mm"  , RSet (Str(myMonth (Zeitwert)), 2, "0")) 
 Maske = ReplaceString(Maske, "%dddd", StringField(#myDate_Tage , myDayOfWeek(Zeitwert), ","))
 Maske = ReplaceString(Maske, "%dd"  , RSet (Str(myDay   (Zeitwert)), 2, "0")) 
 Maske = ReplaceString(Maske, "%hh"  , RSet (Str(myHour  (Zeitwert)), 2, "0")) 
 Maske = ReplaceString(Maske, "%ii"  , RSet (Str(myMinute(Zeitwert)), 2, "0")) 
 Maske = ReplaceString(Maske, "%ss"  , RSet (Str(mySecond(Zeitwert)), 2, "0")) 
 ProcedureReturn Maske 
EndProcedure 

Procedure.q myParseDate(Maske.s, ZeitWert.s)
   Protected Jahr.l, Mon.b, Tag.b, Std.b, Min.b, Sek.b
   Protected Separator.s, n.b, DZ.q
   n = FindString(Maske," ", 1) 
   Protected DMask.s = Left(Maske   , n-1)
   Protected ZMask.s = Mid (Maske   , n+1)
   n = FindString(ZeitWert," ", 1)
   Protected Datum.s = Left(ZeitWert, n-1)
   Protected Zeit.s  = Mid (ZeitWert, n+1)
   
   Separator = Mid(DMask, FindString(DMask, "%", 2)-1,1)
   For n=1 To (CountString(DMask, Separator)+1)
      Select LCase(StringField(DMask, n, Separator))
         Case "%dd"  : Tag  = Val(StringField(Datum, n, Separator))
         Case "%mm"  : Mon  = Val(StringField(Datum, n, Separator))
         Case "%yy"  : Jahr = 2000 + Val(StringField(Datum, n, Separator))
         Case "%yyyy": Jahr = Val(StringField(Datum, n, Separator))
      EndSelect
   Next n
   Separator = Mid(ZMask, FindString(ZMask, "%", 2)-1,1)
   For n=1 To (CountString(ZMask, Separator)+1)
      Select LCase(StringField(ZMask, n, Separator))
         Case "%hh": Std = Val(StringField(Zeit, n, Separator))
         Case "%ii": Min = Val(StringField(Zeit, n, Separator))
         Case "%ss": Sek = Val(StringField(Zeit, n, Separator))
      EndSelect
   Next n
   DZ = myDate(Jahr, Mon, Tag, Std, Min, Sek)
   
   ProcedureReturn DZ
EndProcedure

Procedure.q myAddDate(Datum.q, Feld.c, ZeitWert.l)
   Protected Jahr.l = myYear  (Datum)
   Protected Mon.b  = myMonth (Datum)
   Protected Tag.b  = myDay   (Datum)
   Protected Std.b  = myHour  (Datum)
   Protected Min.b  = myMinute(Datum)
   Protected Sek.b  = mySecond(Datum)
         
   Select Feld
      Case #myDate_Year
         Jahr + Zeitwert
         Datum = myDate(Jahr, Mon, Tag, Std, Min, Sek) 
      Case #myDate_Month
         Mon + Zeitwert
         If (Mon>12): Jahr + (Mon/12): Mon % 12: EndIf
         Datum = myDate(Jahr, Mon, Tag, Std, Min, Sek) 
      Case #myDate_Week,#myDate_Day
         If (Feld=#myDate_Week): ZeitWert * 7: EndIf
         Repeat 
            If (ZeitWert>Val(StringField(#myDate_TagMon, Mon, ",")))
               ZeitWert - Val(StringField(#myDate_TagMon, Mon, ","))
               Mon + 1 
               Select Mon
                  Case 02: If Not Jahr%400 Or (Not Jahr%4 And Jahr%100): Tag - 1: EndIf       
                  Case 13: Jahr + 1: Mon = 1
               EndSelect
            Else
               Tag + ZeitWert: Break
            EndIf
         ForEver
         Datum = myDate(Jahr, Mon, Tag, Std, Min, Sek)
      Case #myDate_Hour
          Datum + (Zeitwert * #myDate_SekTag)
      Case #myDate_Minute
          Datum + (Zeitwert * #myDate_SekMin)
      Case #myDate_Second
          Datum + ZeitWert
   EndSelect
   
   ProcedureReturn Datum
EndProcedure

;} EndProceduren

Code: Alles auswählen

IncludeFile "My_Date.pbi"
Debug myDayOfWeek(myDate(),1)

[rolaf]

Hallo Pelagio,

holla die Waldfee, schon ne fertige Lösung das ist natürlich sehr schön.
Da werde ich mich gleich mal dranmachen an den Code, um auch noch was daraus zu lernen.

Besten Dank erstmal.

[javabean]

Code: Alles auswählen

Procedure.i DayOfWeekEx(Datum.q)
  retval.i = -1
  ftquad.q = (Datum + 11644473600)*10000000 ; Anzahl der Zehntel-µs seit 1 Jan. 1601 00:00
  PokeQ(@ft, ftquad)
  If FileTimeToSystemTime_(@ft, @st.SYSTEMTIME)
    dow.w = st\wDayOfWeek
    retval = dow
  EndIf
  ProcedureReturn retval
EndProcedure

Debug DayOfWeekEx(Date())

...die Prozedur hier ist lediglich eine WinAPI-Variante der DayOfWeek()-Procedure von PB.
...kann vielleicht bei Berechnungen hilfreich sein...

[Vera]

Hallo Pelagio,

Danke für Deine crossplattform Include
Leider verstehe ich nicht, wie ich nun ein persönliches Datum übergeben könnte. Kannst Du mir bitte noch ein paar Debug-Beispiele zum Lernen mitgeben ?

Es hat sich ein Typo in den Code eingeschlichen:
Protemyed - Protected
Selemy / EndSelemy - Select / EndSelect

Gruß ~ Vera

[rolaf]

...die Prozedur hier ist lediglich eine WinAPI-Variante der DayOfWeek()-Procedure von PB.
...kann vielleicht bei Berechnungen hilfreich sein...

Jepp, aber leider eben nicht für Datümer aus 1950 z.B. - leider.

Ansonsten fummle ich momentan am Pelagio-Code rum.

Edit: Der Code funktioniert ganz ausgezeichnet, ich hole gerade das für mich nötige heraus, da ich nur die Wochentags-Funktion brauche. Also nochmals besten Dank.

[c4s]

@Pelagio
Aus Zufall hatte ich eben deine Include zu "Diagrammerstellung" kopiert und sehe gerade, dass du deinen Beitrag wieder korrigiert hast (-> durch Kalender-Include ersetzt). Hast du ein Beispiel zu "Diagrammerstellung", denn es hört sich ganz brauchbar an.

[Pelagio]

Hallo,

leider hatte sich tatsächlich ein Typo in meinen Code eingeschlichen, Schiet Ersetzen, habe diesen Fehler aber inzwischen korregiert.

Leider verstehe ich nicht, wie ich nun ein persönliches Datum übergeben könnte. Kannst Du mir bitte noch ein paar Debug-Beispiele zum Lernen mitgeben ?

Hier ein Beispiel:

Code: Alles auswählen

; Gregorianischer Kalender
;~~~~~~~~~~~~~~~~~~~~~~~~~~

IncludeFile "My_Date.pbi"
;- Programm

Jahr.l   = 2009
Monat.b  = 02
Tag.b    = 07
Stund.b  = 15
Minute.b = 00
Sekund.b = 00

Datum.q = myDate(Jahr, Monat, Tag, Stund, Minute, Sekund)
Debug Str(Jahr)   + " = " + Str(myYear(Datum))
Debug Str(Monat)  + " = " + Str(myMonth(Datum))
Debug Str(Tag)    + " = " + Str(myDay(Datum))
Debug Str(Stund)  + " = " + Str(myHour(Datum))
Debug Str(Minute) + " = " + Str(myMinute(Datum))
Debug Str(Sekund) + " = " + Str(mySecond(Datum))
Debug myFormatDate ("%dddd, %dd.%mmmm %yyyy %hh:%ii:%ss", Datum)
Datum = myAddDate(datum, #myDate_Week, 52)
Debug myFormatDate ("%dddd, %dd.%mm.%yyyy %hh:%ii:%ss", Datum)
Datum = myParsedate("%dd.%mm.%yyyy %hh:%i%ss", "07.02.1959 15:00:00")
Debug myFormatDate ("%dddd, %dd.%mm.%yyyy %hh:%ii:%ss", Datum)
Debug myFormatDate ("%dddd, %dd.%mm.%yyyy %hh:%ii:%ss", myDate())
Debug myYear(myAddDate(myDate(), #myDate_Year, -myYear(Datum)))

End

ich hoffe das es ausreicht und entsprechend erklärend ist.

@c4s
ich glaube das dies nichts in diesem Thema zu suchen hat, werde aber ein Beispiel suchen und wenn ich es hinkriege Dir zusenden.

[Vera]

Danke ~ damit kann ich jetzt loslegen ~

[rolaf]

Also wenn ich alles richtig gemacht habe, ist das die kurze Lösung aus Pelagios-Code für die Funktion DayOfWeek. Mein Geburtstag (Samstag = 6) stimmt jedenfalls schon mal.

Code: Alles auswählen

Procedure myDayOfWeek(Jahr, Monat, Tag)

  Protected SchaltTag, ZeitWert.q

  For A = 0 To Jahr - 1
    If Not A % 400 Or (Not A % 4 And A % 100)
      SchaltTag + 1
    EndIf
  Next A

  ZeitWert = ((Jahr - 1) * 365 + SchaltTag) * 86400

  For A = 1 To Monat - 1
    Zeitwert + Val(StringField("31,28,31,30,31,30,31,31,30,31,30,31", A, ",")) * 86400
  Next A

  If Monat > 2 Or (Monat = 2 And Tag = 29)
    If Not Jahr % 400 Or (Not Jahr % 4 And Jahr % 100)
      ZeitWert + 86400
    EndIf
  EndIf

  ZeitWert + (Tag - 1) * 86400

  ProcedureReturn (Zeitwert / 86400) % 7

EndProcedure

Debug myDayOfWeek(1964,11,21)

Fehler oder sonstige Anmerkungen (ts-soft ?) = her damit.