Алгоритмы: Функция DateSer


Данная функция весьма полезна но, к сожалению, ее нет в Delphi. Применяется она так:


//--------------------------------------------------------------------------------
DecodeDate(Date,y,m,d);
NewDate:=DateSer(y-4,m+254,d+1234);

или приблизительно так....

//--------------------------------------------------------------------------------
function DateSer(y,m,d: Integer): TDateTime;
const

mj: array[1..12] of Integer=(31,28,31,30,31,30,31,31,30,31,30,31);
var

add: Integer;
begin

while(true) do begin
y:=y+(m-1) div 12;
m:= (m-1) mod 12 +1;
if m<=0 then begin
Inc(m,12);
Dec(y);
end;
if ((y mod 4 = 0) and
((y mod 100<>0) or (y mod 400=0)))
and (m=2) then
add:=1 //дополнительный день в феврале
else
add:=0;
if (d>0) and (d<=(mj[m]+add)) then break;
if d>0 then begin Dec(d,mj[m]+add); Inc(m); end
else begin Inc(d,mj[m]+add); Dec(m); end;
end;
Result:=EncodeDate(y,m,d);
end;

 

Hosted by uCoz