unit kdate;
{


   Author:  Vesa Lappalainen/ by help of Tapani Tarvainen
   Date:    10.01.1997
   Changes: 

}

interface

function julian(d,m,y:integer):integer;
function weekno(d, m, y : integer):integer;
function WeekNoOfDate(Date:TDateTime):integer;

implementation
uses SysUtils;

function julian(d,m,y:integer):integer;
var n1, n2 : integer;
begin
  n1 := 12*y + m - 3;
  n2 := n1 div 12;
  Result := (734*n1+15) div 24 - 2*n2 + n2 div 4 - n2 div 100
            + n2 div 400 + d + 1721119;
end;

function weekno(d, m, y : integer):integer;
var n1, n2, w : integer;
begin
  w := 1;
  n1 := julian(d, m, y);
  n2 := 7*(n1 div 7)+10;
  y  := y+1;
  while ( true ) do begin
    w := (n2 - julian(1,1,y)) div 7;
    if ( w > 0) then break;
    y := y-1;
  end;
  Result := w;
end;

function WeekNoOfDate(Date:TDateTime):integer;
var d,m,y:word;
begin
  DecodeDate(Date,y,m,d);
  Result := weekno(d,m,y);
end;



end.