[Lazarus] DateDif function needed

[Bart]

On 11/11/13, Michael Schnell <mschnell at lumino.de> wrote:

First try at it:
(Only works for correct Gregorian dates).

uses Classes, SysUtils, DateUtils;

type
  TDaysPerMonth = Array[1..12] of Word;


function DaysPerMonth(AMonth: Word; IsLeapYear: Boolean): Word;
const
  DaysPerMonthNormal: TDaysPerMonth = (31,28,31,30,31,30,31,31,30,31,30,31);
  DaysPerMonthLeap:   TDaysPerMonth = (31,29,31,30,31,30,31,31,30,31,30,31);
begin
  if IsLeapYear then
    Result := DaysPerMonthLeap[AMonth]
  else
   Result := DaysPerMonthNormal[AMonth];
end;

procedure DateDiff(Date1, Date2: TDate; out Years, Months, Days: Word);
var
  //Reverse: Boolean;
  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
  begin
    SwapDates(Date1, Date2);
    //Reverse := True;
  end
  else
    //Reverse := False;
  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 ;
  end;
end;

Bart