[Lazarus] DateDif function needed

Bart bartjunk64 at gmail.com
Wed Nov 13 00:10:35 CET 2013


On 11/12/13, John Landmesser <JohnML at online.de> wrote:

> On 12.11.2013 21:40, John Landmesser wrote:
>>
>> Which is correct?
>>
>> Date1 := 29.2.2000
>> Date2 := 28.02.2001
>>
>> Your function:
>> 0 Y, 11 M, 27 D
>>
>> Rxlib ( Jedi ) DateDiff:
>> 0 Y, 11 M, 28 D
[snip]
>
> RxLib is correct !!!
>

Fixed. (?)

procedure DateDiff(Date1, Date2: TDate; out Years, Months, Days: Word);
var
  Y1, Y2, M1, M2, D1, D2: word;

  procedure SwapDates(var D1, D2: TDate);
  var
    TempD: TDate;
  begin
    TempD := D1;
    D1 := D2;
    D2 := TempD;
  end;

begin
  if (Date1 > Date2) then
    SwapDates(Date1, Date2);
  Days := 0;
  Months := 0;
  Years := 0;
  DecodeDate(Date1, Y1, M1, D1);
  DecodeDate(Date2, Y2, M2, D2);
  Years := Y2 - Y1;
  if (M1 > M2) or ((M1 = M2) and (D1 > D2)) then Dec(Years);
  if (M1 > M2) then Inc(M2, 12); //already adjusted Years in that case
  Months := M2 - M1;
  if (D2 >= D1) then
    Days := D2 - D1
  else
  begin
    //writeln('D2 < D1');
    if (Months = 0) then
      Months := 11
    else
      Dec(Months);
    //writeln('DaysPerMonth(',M1,') = ',DaysPerMonth(M1, IsLeapYear(Y2)));
    Days := (DaysPerMonth(M1, IsLeapYear(Y2)) - D1) + D2 ;
    if (M1 = 2) and (M2 = 2) and IsLeapYear(Y1) then
    begin
      Inc(Days);
    end;
  end;
end;

Bart




More information about the Lazarus mailing list