"Советы по Delphi. Версия 1.0.6" - читать интересную книгу автора (Озеров Валентин)

Функция DateSer

Привет, я хочу в качестве совета поделиться функцией DateSer, которую я написал перед этим на VB. Данная функция весьма полезна но, к сожалению, ее нет в 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 mlt;=0 then begin

   Inc(m,12);

   Dec(y);

  end;

  if ((y mod 4 = 0) and ((y mod 100lt;gt;0) or (y mod 400=0))) and (m=2) then add:=1 //дополнительный день в феврале

  else add:=0;

  if (dgt;0) and (dlt;=(mj[m]+add)) then break;

  if dgt;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;