Page 1 of 1
Convert Date to Calenderweek (CW) and Calenderweek to Date
Posted: Thu Jan 24, 2008 4:12 pm
by 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.
Posted: Thu Jan 24, 2008 4:35 pm
by Rings
maybe i'm crazy, but
Debug ConvertDateToCalenderWeek(Date(2008,2,4,0,0,0))
prints calendarweek 5, but its 6. (german Rosenmontag)
Posted: Wed Jan 30, 2008 4:05 pm
by 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.
Posted: Wed Jan 30, 2008 6:27 pm
by Rings
works
Posted: Thu Jan 31, 2008 2:24 am
by 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
Posted: Thu Jan 31, 2008 2:59 pm
by 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.
Posted: Thu Jan 31, 2008 6:50 pm
by rsts
Examples for quite a few languages here
http://www.merlyn.demon.co.uk/weekcalc.htm#VB
cheers