interface
FUNCTION DayNum(Year,Month,Day:NativeInt):NativeInt;
FUNCTION DayOfWeek(Year,Month,Day:NativeInt):NativeInt;
overload;
FUNCTION DayOfWeek(DayNumber:NativeInt):NativeInt;
overload;
FUNCTION LeapYear(Year:NativeInt):Boolean;
FUNCTION DaysInMonth(Year,Month:NativeInt):NativeInt;
FUNCTION DaysInYear(Year:NativeInt):NativeInt;
FUNCTION WeeksInYear(Year:NativeInt):NativeInt;
PROCEDURE WeekNum(Year,Month,Day:NativeInt;
var week,yearofweek:NativeInt);
PROCEDURE DayNumToDate(dn:NativeInt;
var Year, Month, Day:NativeInt);
FUNCTION EasterSunday(Year:NativeInt;
var Month,Day:NativeInt):NativeInt;
FUNCTION FirstAdvent(Year:NativeInt;
var Month,Day:NativeInt):NativeInt;
implementation
{------------------------------------------------------------------------------}
{ DayNum }
{ Gibt die Anzahl der Tage zurück, die seit dem fiktiven Datum 01.01.0000 }
{ vergangen sind. }
{ 01.01.0000 würde 0 ergeben }
{ 01.01.0001 würde 366 ergeben (0000 wäre ein Schaltjahr) }
{------------------------------------------------------------------------------}
FUNCTION DayNum(Year,Month,Day:NativeInt):NativeInt;
begin
Result:=Year*365+Day+31*(Month-1);
If Month>2
then Dec(Result,(23+4*Month)
div 10)
else if Year<>0
then Dec(Year)
else Dec(Result);
Inc(Result,Year
div 4 - Year
div 100 + Year
div 400);
end;
{------------------------------------------------------------------------------}
{ DayOfWeek (Year, Month, Day) }
{ Gibt den Wochentag für ein Datum zurück }
{ 0=Montag, 1=Dienstag... 6=Sonntag }
{------------------------------------------------------------------------------}
FUNCTION DayOfWeek(Year,Month,Day:NativeInt):NativeInt;
begin
Result:=(5+DayNum(Year,Month,Day))
mod 7;
end;
{------------------------------------------------------------------------------}
{ DayOfWeek (DayNumber) }
{ Gibt den Wochentag für eine Tagnummer zurück }
{ 0=Montag, 1=Dienstag... 6=Sonntag }
{------------------------------------------------------------------------------}
FUNCTION DayOfWeek(DayNumber:NativeInt):NativeInt;
begin
Result:=(5+DayNumber)
mod 7;
end;
{------------------------------------------------------------------------------}
{ LeapYear }
{ Gibt True zurück, wenn year ein Schaltjahr ist }
{------------------------------------------------------------------------------}
FUNCTION LeapYear(Year:NativeInt):Boolean;
begin
result:=(Year
mod 4=0)
and (Year
mod 100<>0)
or (Year
mod 400=0);
end;
{------------------------------------------------------------------------------}
{ DaysInMonth }
{ Gibt die Anzahl der Tage in Month in Year zurück }
{------------------------------------------------------------------------------}
FUNCTION DaysInMonth(Year,Month:NativeInt):NativeInt;
const DIM:
array[1..12]
of byte=(31,28,31,30,31,30,31,31,30,31,30,31);
begin
if (Month=2)
and LeapYear(Year)
then Result:=29
else Result:=DIM[Month];
end;
{------------------------------------------------------------------------------}
{ DaysInYear }
{ Gibt die Anzahl Tage in year zurück }
{------------------------------------------------------------------------------}
FUNCTION DaysInYear(Year:NativeInt):NativeInt;
begin
if LeapYear(Year)
then Result:=366
else Result:=365;
end;
{------------------------------------------------------------------------------}
{ WeeksInYear }
{ Gibt die Anzahl der Wochen eines Jahres zurück }
{------------------------------------------------------------------------------}
FUNCTION WeeksInYear(Year:NativeInt):NativeInt;
var Dow:word;
begin
Dow:=DayOfWeek(Year,1,1);
Result:=52+Integer((Dow=3)
or ((Dow=2)
and LeapYear(Year)));
end;
{------------------------------------------------------------------------------}
{ WeekNum }
{ Berechnet für ein Datum die Wochennumer und das Jahr zu der die Wochennummer }
{ gehört.
{ Results : Week = Nummer der Woche }
{ YearOfWeek = Jahr, zu dem die Woche gehört }
{------------------------------------------------------------------------------}
PROCEDURE WeekNum(Year,Month,Day:NativeInt;
var Week,YearOfWeek:NativeInt);
var Dn:Integer; Dow:word;
begin
Dn:=DayNum(Year,1,1);
Dow:=(Dn+5)
mod 7;
Week:=(DayNum(Year,Month,Day)-Dn+Dow)
div 7;
YearOfWeek:=Year;
if Dow<4
then begin
Inc(Week);
end else if Week=0
then begin
Dec(YearOfWeek);
Week:=WeeksInYear(YearOfWeek);
Exit;
end;
if Week>WeeksInYear(YearOfWeek)
then begin
Week:=1;
Inc(YearOfWeek);
end;
end;
{------------------------------------------------------------------------------}
{ DayNumToDate }
{ Berechnet aus einer TagNummer das Datum }
{------------------------------------------------------------------------------}
PROCEDURE DayNumToDate(Dn:NativeInt;
var Year, Month, Day:NativeInt);
begin
Year:=Dn
div 366;
Month:=1;
Day:=1;
Dec(Dn,DayNum(Year,1,1));
while Dn>=DaysInYear(Year)
do begin
Dec(Dn,DaysInYear(Year));
Inc(Year);
end;
while Dn>=DaysInMonth(Year,Month)
do begin
Dec(Dn,DaysInMonth(Year,Month));
Inc(Month);
end;
Inc(Day,Dn);
end;
{------------------------------------------------------------------------------}
{ EasterSunday }
{ Berechnet den Monat und den Tag und die TagNummer des OsterSontages in year. }
{ year muß im Bereich 1583..2499 liegen, }
{ Wenn year nicht in diesem Bereich liegt, ist das Funktionsergebnis = -1 }
{ und month und day sind undefiniert. }
{ Sonst enthalten month und day das Datum und result die Tagnummer des }
{ OsterSonntages in year. }
{------------------------------------------------------------------------------}
FUNCTION EasterSunday(Year:NativeInt;
var Month,Day:NativeInt):NativeInt;
var A,B,C,D,E,H,L,M:word;
begin
if (Year<1583)
or (Year>2499)
then Exit(-1);
H:=Year
div 100;
L:=(4+H)-(H
div 4);
M:=(15+H)-(H
div 4)-(((8*H)+13)
div 25);
A:=Year
mod 4;
B:=Year
mod 7;
C:=Year
mod 19;
D:=((19*C)+M)
mod 30;
E:=((2*A)+(4*B)+(6*D)+L)
mod 7;
Day:=22+D+E;
if Day<=31
then begin
Month:=3;
end else begin
Month:=4;
if (D=29)
and (E=6)
then Day:=19
else if (D=28)
and (E=6)
and (C>=11)
then Day:=18
else Day:=D+E-9;
end;
result:=DayNum(Year,Month,Day);
end;
{------------------------------------------------------------------------------}
{ FirstAdvent }
{ Berechnet den Monat und den Tag und die TagNummer des Ersten Advent in year. }
{ year muß im Bereich 1582..9999 liegen }
{ Benötigt für Berechnung des Datums des Buss und Bettages, der 11 Tage vor }
{ Wenn year nicht im Bereich 1582..9999 liegt, wird -1 zurückgegeben und }
{ month und day sind undefiniert. }
{ Sonst enthalten month und day das Datum und result die Tagnummer des }
{ Ersten Advent in year. }
{------------------------------------------------------------------------------}
FUNCTION FirstAdvent(Year:NativeInt;
var Month,Day:NativeInt):NativeInt;
var Offset:NativeInt;
begin
if (Year<1583)
or (Year>9999)
then Exit(-1);
Result:=DayNum(Year,11,27);
Offset:=6-DayOfWeek(Result);
inc(Result,Offset);
if Offset<=3
then begin
Day:=27+Offset;
Month:=11;
end else begin
Day:=Offset-3;
Month:=12;
end;
end;
{------------------------------------------------------------------------------}
{ CompleteYear }
{------------------------------------------------------------------------------}
FUNCTION CompleteYear(Year:NativeInt):NativeInt;
begin
if Year<30
then Result:=Year+2000
else if Year<100
then Result:=Year+1900
else Result:=Year;
end;
{------------------------------------------------------------------------------}
{ WeekYearToDayNum }
{ Berechnet das Datum des Montages einer Woche in einem Jahr }
{ Result : True, wenn die Woche in dem Jahr existiert }
{ D : Wenn Result=True, Nummer des Tages (siehe DayNum) }
{------------------------------------------------------------------------------}
FUNCTION WeekYearToDayNum(Wk,Y:NativeInt;
var D:NativeInt):Boolean;
register;
var Dn,Dow:NativeInt;
begin
Result:=(Wk>=1)
and (Wk<=WeeksInYear(Y));
if not result
then Exit;
Dn:=DayNum(Y,1,1);
Dow:=DayOfWeek(Dn);
D:=Dn-Dow+7*(Wk-Integer(Dow<=Thursday));
end;