function wochentag_nummer(tag, monat:byte; jahr:word):byte;
var year, century:word;
begin
if monat > 2
then
dec(monat, 2)
else begin
inc(monat, 10);
dec(jahr);
end;
year:=jahr
mod 100;
century:=jahr
div 100;
Result:=(tag + (13*monat-1)
div 5
+ year
+ year
div 4
+ century
div 4
+ 5 * century)
mod 7;
if Result = 0
then
Result:=7;
end;
function schaltjahr(jahr:word):boolean;
begin
Result:=(jahr
mod 4 = 0)
and (jahr
mod 100 <> 0)
or (jahr
mod 400 = 0);
end;
function tag_im_jahr(tag, monat:byte; jahr:word):word;
var tage, i:word;
begin
tage:=0;
for i:=1
to monat-1
do begin
case i
of
1,3,5,7,8,10,12: inc(tage,31);
2:
if schaltjahr(jahr)
then
inc(tage, 29)
else
inc(tage, 28);
4,6,9,11: inc(tage,30)
end
end;
Result:=tage + tag;
end;
function kalenderwoche(tag, monat:byte; jahr:word):byte;
var wtag, neujahr, silvester:byte;
kw, tage:integer;
begin
wtag:=wochentag_nummer(1, 1, jahr);
if wtag <= 4
then
kw:=0
else
kw:=-1;
tage:=0 - (wtag - 1);
repeat
inc(kw);
inc(tage, 7)
until tage >= tag_im_jahr(tag, monat, jahr);
if kw = 0
then begin
dec(jahr);
neujahr:=wochentag_nummer(1, 1, jahr);
silvester:=wochentag_nummer(31, 12, jahr);
if (neujahr = 4)
or (silvester = 4)
then
kw:=53
else
kw:=52;
end
else begin
if kw = 53
then begin
silvester:=wochentag_nummer(31, 12, jahr);
if silvester < 4
then
kw:=1;
end;
end;
Result:=kw;
end;