Kalenderwoche

[Werner]

Hallo!

Ich habe es mit den Datumsfunktionen nicht fertiggebracht die aktuelle Kalenderwoche in eine Variable zu schreiben. Es gibt zwar in einem Codearchiv diesbezüglich etwas, nur läuft das nicht auf meiner Version 3.92 unter W2K. Vielleicht wär jemand so freundlich und könnt mir diesbezüglich Code posten.

[Unimatrix Zero]

Hallo Werner,

ich habe mir da mal einen VB-Code so umgeschrieben:

Code: Alles auswählen

Procedure KW(ldate)
  Protected fwd,days,wnr
  fwd = DayOfWeek(Date(Year(ldate), 1, 1, 0, 0, 0))
  If fwd = 0 : fwd = 7 : EndIf
  days = (ldate - Date(Year(ldate), 1, 1, 0, 0, 0)) / 86400
  wnr = Round((days - (8 - fwd)) / 7, 0) + 1
  If fwd <= 4 : wnr + 1 : EndIf
  If wnr = 0
    KW(Date(Year(ldate) - 1, 12, 31, 0, 0, 0))
    ProcedureReturn
  ElseIf wnr = 53 And DayOfWeek(Date(Year(ldate) - 1, 12, 31, 0, 0, 0)) <= 3
    wnr = 1
  EndIf
  ProcedureReturn wnr
EndProcedure

Debug KW(ParseDate("%dd.%mm.%yyyy","30.12.2002"))

[Werner]

Hallo Unimatrix Zero!

Danke für Deine Mühe
Leider bekommt ich folgende Fehlermeldung unter W2K und PB392:
Zeile 3: Date() : Incorrect number of of parameters.

Hast Du mir diesbezüglich einen Tipp?

Gruß, Werner

[freedimension]

Ich kann mich dunkel an einen anderen Post erinnern der dasselbe zum Thema hatte. War damals glaube ich irgendeine User Library oder ähnliches die da Probleme bereitet hat.

Mach mal einen Test und verschiebe die Userlibraries mal in einen Ordner wo PB sie nicht finden kann und starte den Compiler neu. Wenn es danach gehen sollte einfach eine Lib nach der anderen wieder in den Originalordner kopieren, neustarten, testen usw.

[Werner]

Hallo freedimension!

Danke für den Tipp.
Leider habe ich, trotz entfernen aller UserLibraries, noch immer das gleiche Problem. Wenn ihr jedoch das Problem unter der Version 3.92 nicht habt, muss meine Installation nicht in Ordnung sein. Ich habe bis jetzt immer die neue Version über die alte installiert - wegen Registrierkey. Aber vielleicht ist das genau mein Problem.

Gruß, Werner

[sharkpeter]

Hi, das Jahr geht schon so langsam wieder dem Ende zu, ich habe mich
mit diesem Thema heute mal befaßt, da ich auch eine Angabe der
Kalenderwoche benötige. Mit diesem Code kann man den Beginn der KW 1
des jeweiligen Jahres feststellen. Ich habe mir nicht die Mühe gemacht,
die Aktualisierung des Textes nur dann vorzunehmen, wenn das Jahr
geändert wurde, weil unnützes Beiwerk an dieser Stelle. Laut DIN ist es
so, daß es eine KW 53 gibt, wenn das Jahr nicht mindestens auf einem
Donnerstag beginnt. Der Code oben berücksichtigt das nicht.

Gruß Jens

Code: Alles auswählen

; Datum der Kalenderwoche zuordnen
; Create: 16.10.2005
; Autor : Jens Haipeter

Enumeration
  #Window_0
EndEnumeration

Enumeration
  #Strg_0
  #Text_0
EndEnumeration

; Wochentage
  Dim wd.s (6)
  wd(0)="Sonntag"
  wd(1)="Montag"
  wd(2)="Dienstag"
  wd(3)="Mittwoch"
  wd(4)="Donnerstag"
  wd(5)="Freitag"
  wd(6)="Samstag"

  Quit=#False

; Fenster und Abfrage
If OpenWindow(#Window_0,0,0,420,100,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Kalenderwoche des Datums feststellen")
  If CreateGadgetList(WindowID(#Window_0))
    StringGadget(#Strg_0, 10, 10, 50, 20,"2005",#PB_String_Numeric)
    TextGadget  (#PB_Any, 70, 14,340, 14,"Geben Sie hier das Jahr ein, von dem Sie die Woche wissen möchten")
    TextGadget  (#Text_0, 10, 40,400, 14,"")
    Repeat   
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Quit=#True
      EndSelect
      ; Kalenderwoche des Jahres bestimmen für den ersten Tag
      a=ParseDate("%dd.%mm.%yyyy","1/1/"+GetGadgetText(#Strg_0))
      c=DayOfWeek(a)
      If c=0; Sonntag
        a+86400
      ElseIf c>3; Donnerstag/Freitag/Samstag
        Repeat
          c+1
          a+86400
        Until c=8
      EndIf
      ; erster Tag in KW 1 des Jahres ist
      SetGadgetText(#Text_0,"KW 1 des Jahres beginnt am "+wd(DayOfWeek(a))+", dem "+FormatDate("%dd.%mm.%yyyy",a))
    Until Quit
  Else
    End
  EndIf  
EndIf
End

[Werner]

Hallo sharkpeter,

Deine Prozedur funktioniert bestens.
Danke für die Mühe

[sharkpeter]

Hi Werner,

nix zu Danken, dafür ist doch das Forum da. Hätte ja auch wer anderes
sein können und ich selber hätte es dann benutzen können, so ist es eben
aus der Situation heraus entstanden und für andere nutzbar.

Edit: 22.10.2005/15:40:00 Uhr

Wie eine Suche im PBArchiv ergeben hat gab es da schon mal was von Gezuppel:

http://forums.purebasic.com/german/arch ... enderwoche

Das meine Procedure den gleichen Namen hat ist reiner Zufall und ich
ändere das sofort ab.

Gruß Jens

[sire]

Ich habe die Prozedur unter http://forums.purebasic.com/german/view ... enderwoche gerade in ein Programm von mir eingebaut und dabei gleich einen kleinen Fehler entdeckt. Der 01.01.2006 wird dort der KW53 zugeordnet. Laut der üblichen Normen, wie sie auf http://de.wikipedia.org/wiki/Kalenderwoche beschrieben sind, gibt es eine 53. Kalenderwoche nur in Jahren, deren erster oder letzter Tag ein Donnerstag ist. 2005 hätte demnach keine KW53 haben und daher nach 2006 keine solche überlappen können. Ich habe die Prozedur schnell ein bißchen abgewandelt, um das auch zu berücksichtigen. Hier das Ergebnis:

Code: Alles auswählen

Procedure JSGetKW(DateS)
  ; Tag, Monat, Jahr ausfiltern
  y.s=FormatDate("%yyyy"        ,DateS)
  i.s=FormatDate("%dd.%mm.%yyyy",DateS)
  ; Kalenderwoche des Jahres bestimmen für den ersten Tag
  g=1
  a=ParseDate("%dd.%mm.%yyyy","1/1/"+y)
  b=DayOfWeek(a)
  If b=0; Sonntag
    a+86400: g=2
  ElseIf b>3; Donnerstag/Freitag/Samstag
    Repeat
      b+1: a+86400: g+1
    Until b=8; hochzählen bis folgender Montag (Sonntag = 7!)
  EndIf
  ; Tageseingabe Kalenderwoche bestimmen
  c=ParseDate("%dd.%mm.%yyyy",i)
  d=DayOfWeek(c): e=DayOfYear(c): f=e-g
  If f<0
    ; KW53 gibt es, wenn das betreffende Jahr entweder mit einem Donnerstag beginnt oder aufhört
    If (DayOfYear(DateS)>360 And DayOfWeek(ParseDate("%dd.%mm.%yyyy","31.12."+y))=4) Or (DayOfYear(DateS)<4 And DayOfWeek(ParseDate("%dd.%mm.%yyyy","01.01."+Str(Year(DateS)-1)))=4)
      f=53
    Else
      f=52
    EndIf
  Else
    f=f/7+1
  EndIf   
  ; Rückgabewert Kalenderwoche
  ProcedureReturn f
EndProcedure

[MLK]

*puh* danke, du kommst gerade noch rechtzeitig ^^