Delphi Pages Forums

Delphi Pages Forums (http://www.delphipages.com/forum/index.php)
-   General (http://www.delphipages.com/forum/forumdisplay.php?f=2)
-   -   DateToWeek function? (http://www.delphipages.com/forum/showthread.php?t=46498)

Ted On The NeT 02-20-2002 11:48 PM

DateToWeek function?
 
hi guys,

anybody here who knows how to recalculate a date back to a weeknumber? I wrote a function, but it does not work with 53 weeks in a year.

My week starts at sunday (DayOfWeek function). 53 weeks occur with intervals of 5 and 6 years. as far as I know these weeks make januari 1st on thursday or friday.

Can anybody help me with this? I need a GOOD working DateToWeek function.

gr. Ted

PS: i could paste my code if there are people willing to help.

<tt>
Greetz,
::TeD On The NeT::

=[ QUESTIONS ]=========================================
don't forget to accept this reply if it helped you! :)
================================================== =====

=[ EXTRA INFO ]========================================
Location : Netherlands (GMT +01.00)
Languages : English, Dutch, German
Age : 25
ICQ : Be smart and figure out what my UIN is...
================================================== =====
</tt>

DarkHorse 02-20-2002 11:54 PM

RE: DateToWeek function?
 
Hi,

Will u pls. post the code. I will give it a try...

Pls. accept if it helped.

Thanx
Tomy.

Ted On The NeT 02-21-2002 12:03 AM

The code ->
 
Here's the code Tomy... if we (you? hehe..) solve the code problem, we'll have a great function :))

<cb>function date2Week(aDate: String): Integer;
var
JanuaryFirst: TDateTime;
DayNumber: Word;
FirstDayOfYear: Word;
aYear, aMonth, aDay: word;
begin
try
decodedate(StrToDate(aDate), aYear, aMonth, aDay);
except
result := -1;
exit;
end;
JanuaryFirst := EncodeDate(aYear,1,1);
FirstDayOfYear := DayOfWeek(JanuaryFirst);
<ct>// I'VE KINDA MESSED UP THE CODE FROM HERE ON. I'VE BEEN TRYING SO LONG
// I DON'T EVEN KNOW WHAT I DID, HEHE.. IT'S KINDA VAGUE TO ME :-)</ct>
DayNumber := Integer(Round(StrToDate(aDate) - JanuaryFirst));
DayNumber := DayNumber + 7 - DayOfWeek(StrToDate(aDate) - 1);
if (FirstDayOfYear in [2..5]) then
inc(DayNumber, 7);
result := (Daynumber div 7);
case result of
0: if ((DayOfWeek(encodeDate(aYear - 1, 01, 01)) > 5) or
(DayOfWeek(encodeDate(aYear - 1, 12, 31)) < 5)) then
begin { -- if there is no reason for 53 weeks -- }
result := 52;
end
else
begin
result := 53;
end;
53: if ((FirstDayOfYear > 5) or
(DayOfWeek(encodeDate(aYear, 12, 31)) < 5)) then
begin
result := 1;
end;
end; // case-statement
end; // End of function date2Week</cb>

<tt>
Greetz,
::TeD On The NeT::

=[ QUESTIONS ]=========================================
don't forget to accept this reply if it helped you! :)
================================================== =====

=[ EXTRA INFO ]========================================
Location : Netherlands (GMT +01.00)
Languages : English, Dutch, German
Age : 25
ICQ : Be smart and figure out what my UIN is...
================================================== =====
</tt>

Ted On The NeT 02-21-2002 12:13 AM

Borland's faulty code:
 
Another piece of code, created by Borland. It doens't work either. try the date: 01-01-2004. In the TMonthCalendar it's week 53. This function returns 1. I've traced the TCommonCalendar's "WeekNumbers" property in the source directory, but it's not usable...

<cb>function WeekOfYear(ADate : TDateTime) : word;
var
day : word;
month : word;
year : word;
FirstOfYear : TDateTime;
begin
DecodeDate(ADate, year, month, day);
FirstOfYear := EncodeDate(year, 1, 1);
Result := Trunc(ADate - FirstOfYear) div 7 + 1;
end;</cb>

<tt>
Greetz,
::TeD On The NeT::

=[ QUESTIONS ]=========================================
don't forget to accept this reply if it helped you! :)
================================================== =====

=[ EXTRA INFO ]========================================
Location : Netherlands (GMT +01.00)
Languages : English, Dutch, German
Age : 25
ICQ : Be smart and figure out what my UIN is...
================================================== =====
</tt>

GoodFun 02-21-2002 12:23 AM

RE: Borland's faulty code:
 
Hi there,

I think I have a working version somewhere in the office, I will check as soon as I get in (in about 4 hours).

I'll post it here if I can find it and if it works with the specs you gave.

Hope this helps,

Marcel

Please click on Accept if this helped...

bonbon 02-21-2002 12:23 AM

RE: DateToWeek function?
 
function IsLeapYear( nYear: Integer ): Boolean;
begin
Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0));
end;

function MonthDays( nMonth, nYear: Integer ): Integer;
const
DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysPerMonth[nMonth];
if (nMonth = 2) and IsLeapYear(nYear) then Inc(Result);
end;

function WeekOfYear( dDate: TDateTime ): Integer;
var
X, nDayCount: Integer;
nMonth, nDay, nYear: Word;
begin
nDayCount := 0;
deCodeDate( dDate, nYear, nMonth, nDay );
For X := 1 to ( nMonth - 1 ) do
nDayCount := nDayCount + MonthDays( X, nYear );
nDayCount := nDayCount + nDay;
Result := ( ( nDayCount div 7 ) + 1 );
end;

andyho 02-21-2002 12:30 AM

RE: DateToWeek function?
 
Keep in mind there are several different definitions on how to calculate the week number. In some cultures the week starts with Sunday (especially the jewish one as Sunday is the first working day there), other at Monday. And the first week of a year can be either that one which contains January 1st, or the one which has more days in the new year then in the old year. Borland's code uses the ISO week number definition which has Monday as first day and first week as the one containing January 4th (that means it's more in the new year then the old one). For more informations about this topic see http://www.merlyn.demon.co.uk/weekinfo.htm - it even has some source code there for the various definitions, as well as hints how to implement week counting...

Bye,
Andy

Ted On The NeT 02-21-2002 12:37 AM

RE: DateToWeek function?
 
BonBon, please try your code with '01-01-2004'. it won't work. it gives me week 1 instead of 53.

<tt>
Greetz,
::TeD On The NeT::

=[ QUESTIONS ]=========================================
don't forget to accept this reply if it helped you! :)
================================================== =====

=[ EXTRA INFO ]========================================
Location : Netherlands (GMT +01.00)
Languages : English, Dutch, German
Age : 25
ICQ : Be smart and figure out what my UIN is...
================================================== =====
</tt>

Ted On The NeT 02-21-2002 12:39 AM

RE: DateToWeek function?
 
Hi Andy,

i've been on the page already, but i haven't figured out how to get it to work. I need an allround function :=) disregarding culture :)

<tt>
Greetz,
::TeD On The NeT::

=[ QUESTIONS ]=========================================
don't forget to accept this reply if it helped you! :)
================================================== =====

=[ EXTRA INFO ]========================================
Location : Netherlands (GMT +01.00)
Languages : English, Dutch, German
Age : 25
ICQ : Be smart and figure out what my UIN is...
================================================== =====
</tt>

andyho 02-21-2002 12:50 AM

RE: DateToWeek function?
 
Take a look at the week number function I created:

function WeekNumber(date:TDateTime):integer;
var
y,m,d: word;
h: integer;
FirstofJanuary,
FirstThursday,
FirstWeekStart: TDateTime;
begin
DecodedateCorrect(date,y,m,d);
FirstofJanuary:=EncodedateCorrect(y,1,1);
h:=dayOfWeek(FirstofJanuary);
FirstThursday:=FirstofJanuary+((12-h) mod 7);
FirstWeekStart:=FirstThursday-3;
if trunc(date)<FirstWeekStart then
result:=WeekNumber(FirstofJanuary-1) (* 12-31 of previous year *)
else
result:=(round(trunc(date)-FirstWeekStart) div 7)+1;
end;

That one uses of course the ISO definition (which luckily is also the one commonly used here in Germany) - and it will give you week 1 for 2004-1-1. However if you change FirstThursday to FirstWednesday

FirstWednesday:=FirstofJanuary+((11-h) mod 7);

and then let it calculate again it will give you the 53 you want.


Bye,
Andy


All times are GMT. The time now is 05:41 PM.

Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2019, vBulletin Solutions, Inc.