Convert Date to Calenderweek (CW) and Calenderweek to Date

[CSAUER]

Here it is:

Code: Select all

Procedure.l ConvertCalenderWeekToDate(week.s)
  ; Function to convert a calenderweek expression (WW/YYYY) into a date (Monday of the week)
  Protected year.w, cw.b, tdate.l, fdate.l
  cw = Val(Left(week,2))
  year = Val(Right(week,4))
  fdate = Date(year,1,1,0,0,0)
  If DayOfWeek(fdate) > 0 And DayOfWeek(fdate) < 5 ; The first week is the one, with min. 4 days in the new year
    cw - 1
  EndIf
  ProcedureReturn AddDate(AddDate(fdate,#PB_Date_Day,(DayOfWeek(fdate)-1)*-1),#PB_Date_Week,cw)
EndProcedure


Procedure.s ConvertDateToCalenderWeek(date.l)
  ; Function to convert a date into a calenderweek expression (WW/YYYY)
  Protected fdate.l, days.l, week.l
  fdate = Date(Val(FormatDate("%yyyy",date)),1,1,0,0,0)
  days = DayOfYear(date)-1
  If DayOfWeek(fdate) > 0 And DayOfWeek(fdate) < 5 ; The first week is the one, with min. 4 days in the new year
    days + DayOfWeek(fdate)-1
  Else
    days - (6 - DayOfWeek(fdate))
  EndIf
  week = days / 7
  If days % 7 > 0
    week + 1
  EndIf
  If week < 10
    ProcedureReturn "0" + Str(week) + "/" + FormatDate("%yyyy",date)
  Else
    ProcedureReturn Str(week) + "/" + FormatDate("%yyyy",date)
  EndIf
EndProcedure

; TEST
Debug FormatDate("%dd.%mm.%yyyy",ConvertCalenderWeekToDate("05/2009"))
Debug ConvertDateToCalenderWeek(Date(2010,05,22,0,0,0))

Feel free to use or optimize.

[Rings]

maybe i'm crazy, but
Debug ConvertDateToCalenderWeek(Date(2008,2,4,0,0,0))
prints calendarweek 5, but its 6. (german Rosenmontag)

[CSAUER]

Sorry, you are not crazy. Try this:

Code: Select all

Procedure.s ConvertDateToCalenderWeek(date.l)
  ; Function to convert a date into a calenderweek expression (WW/YYYY)
  Protected fdate.l, days.l, week.l
  fdate = Date(Val(FormatDate("%yyyy",date)),1,1,0,0,0)
  days = DayOfYear(date) ;-1
  If DayOfWeek(fdate) > 0 And DayOfWeek(fdate) < 5 ; The first week is the one, with min. 4 days in the new year
    days + DayOfWeek(fdate)-1
  Else
    days - (8 - DayOfWeek(fdate))
  EndIf
  week = days / 7
  If days % 7 > 0
    week + 1
  EndIf
  If week < 10
    ProcedureReturn "0" + Str(week) + "/" + FormatDate("%yyyy",date)
  Else
    ProcedureReturn Str(week) + "/" + FormatDate("%yyyy",date)
  EndIf
EndProcedure

Please let me know, if the calculation is incorrect. Thanks.

[Rings]

works

[PB]

> Please let me know, if the calculation is incorrect. Thanks.

Easiest way to test it, is to check against the CalendarGadget.

Clicking 31 Dec 2007 says 53/2007 by your procedure, but the
CalendarGadget says it's week 1. So your code needs a tweak,
perhaps just a simple hack of: If week=53 : week=1 : EndIf

Code: Select all

Procedure.s ConvertDateToCalenderWeek(date.l)
  ; Function to convert a date into a calenderweek expression (WW/YYYY)
  Protected fdate.l, days.l, week.l
  fdate = Date(Val(FormatDate("%yyyy",date)),1,1,0,0,0)
  days = DayOfYear(date) ;-1
  If DayOfWeek(fdate) > 0 And DayOfWeek(fdate) < 5 ; The first week is the one, with min. 4 days in the new year
    days + DayOfWeek(fdate)-1
  Else
    days - (8 - DayOfWeek(fdate))
  EndIf
  week = days / 7
  If days % 7 > 0
    week + 1
  EndIf
  If week < 10
    ProcedureReturn "0" + Str(week) + "/" + FormatDate("%yyyy",date)
  Else
    ProcedureReturn Str(week) + "/" + FormatDate("%yyyy",date)
  EndIf
EndProcedure

If OpenWindow(0,200,200,400,400,"test") And CreateGadgetList(WindowID(0))
  cal=CalendarGadget(0,10,10,200,200)
  SetWindowLong_(cal,#GWL_STYLE,GetWindowLong_(cal,#GWL_STYLE)|#MCS_WEEKNUMBERS)
  TextGadget(1,10,250,100,20,"Click a date")
  Repeat
    ev=WaitWindowEvent()
    If ev=#PB_Event_Gadget And EventGadget()=0
      d=GetGadgetState(0)
      SetGadgetText(1,ConvertDateToCalenderWeek(d))
    EndIf
  Until ev=#PB_Event_CloseWindow
EndIf

[CSAUER]

Thanks for your feedback and your idea, but it is not correct as long as there are some years which could have a week 53.
I found this in wikipedia: A year has 53 weeks if it starts or ends with a Thursday.

So maybe it needs to be tweaked a bit more. Let me think about this.

[rsts]

Examples for quite a few languages here

http://www.merlyn.demon.co.uk/weekcalc.htm#VB

cheers