function Schaltjahr(word_Jahr : Word) : Boolean;
Begin
result := ( (word_Jahr
mod 4 = 0)
and not (word_Jahr
mod 100 = 0) )
or (word_Jahr
mod 400 = 0);
end;
function Wochentag_(t, m : Byte; j : Word) : Byte;
const
c1 :
ARRAY[1..12]
OF Byte = (0,3,3,6,1,4,6,2,5,0,3,5);
c2 :
ARRAY[0..3]
OF Byte = (6,4,2,0);
var
a,w, j1, j2 : Byte;
begin
j1 := j
div 100;
j2 := j
mod 100;
a:= (t
MOD 7) + (c1[m]) + (j2
MOD 7) + ((j2
DIV 4)
MOD 7) + (c2[(j1
MOD 4)]);
IF Schaltjahr(j)
THEN Dec(a);
w := a
MOD 7;
Wochentag_ := w;
end;
function Kalendertag(tag, monat : byte; jahr : word) : Word;
const
TageProMonat :
ARRAY[1..11]
OF Byte =(31,28,31,30,31,30,31,31,30,31,30);
var
counter : Byte; GesamtTage : Word;
begin
GesamtTage:=0;
FOR counter := 1
TO (monat-1)
DO GesamtTage := GesamtTage + TageProMonat[counter];
GesamtTage := GesamtTage + tag;
IF Schaltjahr(jahr)
AND (monat > 2)
THEN Inc(GesamtTage);
Kalendertag := GesamtTage;
end;
function Kalenderwoche(Tag, Monat: Byte; Jahr : Word) : Byte;
var
Kalendertage, Vorjahr : Word;
Woche, Primus : Byte;
const
Korrektur :
ARRAY[0..6,1..2]
OF ShortInt = ((-6,0),(0,1),(-1,1),(-2,1),(-3,1),(-4,0),(-5,0));
begin
kalendertage:=kalendertag(tag,monat,jahr);
Vorjahr := Jahr - 1;
Primus:=Wochentag_(1,1,Jahr);
Woche:=Trunc((Kalendertage - 1 - Korrektur[Primus,1]) / 7) + Korrektur[Primus,2];
IF (Woche = 53)
THEN
BEGIN
IF (Primus = 4)
OR (Wochentag_(31,12, Jahr) = 4)
THEN Woche := 53
ELSE Woche := 1;
END;
IF (Woche=0)
THEN
BEGIN
IF ((Wochentag_(31,12, Vorjahr) = 4)
OR (Wochentag_(1,1, Vorjahr) = 4))
THEN Woche := 53
ELSE Woche := 52;
END;
Kalenderwoche:=Woche;
end;