http://codecentral.borland

you will find this example

---begin paste

No that code will not work correctly. Here is code that does:

(Note that you must cater for days 'belonging' to week 52 or 53 in the

previous year and days belonging to week 1 in the next year. By international

standards week 1 is always the first week (Monday through Sunday) containing

at least 4 days of the year, this rule is equivalent to the first week with a

Thursday. It also implies that January 4th is always in week 1).

Be aware that the code includes no validation of the input.

{*************************

Function LeapYear(year:word):boolea

{ returns true if year is a leap year }

begin

LeapYear := (((year mod 4) = 0) and

(((year mod 100) <> 0) or ((year mod 400) = 0)));

end;

Function Jan4th(year:word):byte;

{ calculates the day of week for January 4th: Monday = 0 through Sunday = 6

}

var z : word;

begin

z := (year-1) mod 400;

z := z - ((z div 100) * 12);

Jan4th := (((z+25) mod 28) * 5) div 4) mod 7;

end;

Function Week53inYear(year:word):bo

{ returns true if year has 53 weeks }

begin

Week53inYear := (Jan4th(year) = 6) or

((Jan4th(year) = 5) and LeapYear(year));

end;

Function DayOfYear(day,month,year:w

{ calculates day number within year from dd,mm,yyyy }

const m : array[1..12] of word = (0,31,59,90,120,151,181,21

var q : byte;

begin

if (LeapYear(year) and (month > 2)) then q := 1 else q := 0;

DayOfYear := day + m[month] + q;

end;

Function DayOfWeek(day,month,year:w

{ calculates the day of week (Monday through Sunday) from dd,mm,yyyy }

begin

DayOfWeek := (DayOfYear(day,month,year)

end;

Procedure WeekOfYear(var week, wyear : word; day, month,year:word);

{ calculates the week number and associated year for any given date }

begin

week := (DayOfYear(day,month,year)

case week of

0 : begin

wyear := year - 1;

if Week53inYear(wyear) then week := 53 else week := 52;

end;

53 : begin

if Week53inYear(year) then wyear := year

else

begin

wyear := year + 1;

week := 1;

end;

end;

else wyear := year;

end;

end;

{*************************

Regards Sven

--- end paste

hope this helps

meikl ;-)