Функция расчета разницы между двумя датами

Вот что получилось:

// Вывод строки дней
function StrDays(iDay: integer): string;
begin
  Result:= ' дней ';
  case iDay of
    1, 21, 31: Result:= ' день ';
    2, 3, 4, 22, 23, 24: Result:= ' дня ';
  end;
end;

// Вывод строки месяцев
function StrMonths(iMonth: integer): string;
begin
  Result:= ' месяцев ';
  case iMonth of
    1: Result:= ' месяц ';
    2, 3, 4: Result:= ' месяца ';
  end;
end;

// Вывод строки лет
function StrYears(iYear: integer): string;
var
  s: string;
  sYear: string;
  i: integer;
begin
  result := ' лет ';
  if (iYear > 4) and (iYear < 21) then exit;
  sYear := IntToStr(iYear);
  s := Copy(sYear, Length(sYear), 1);
  i := StrToInt(s);
  case i of
    1: result := ' год ';
    2, 3, 4: result := ' года ';
  end;
end;

// Сама функция
function StrBetweenDate(Date1, Date2: TDate): string;
var
  id, im, iy: Integer;
  d: TDate;
begin
  Result:= '';
  if Date1 < Date2 then
  begin
    d:= Date1;
    Date1:= Date2;
    Date2:= d;
    Date1:= Date1 + 1;
  end;
  d:= DaysBetween(Date1 + 1, Date2);
  id:= DayOf(d);
  im:= MonthOf(d)-1;
  iy:= YearOf(d);
  iy:= iy - 1900;
  if im = 12 then
    begin
      im:= 0;
      inc(iy);
    end;
  if id = 31 then
  begin
    id:= 0;
    inc(im);
    if im = 12 then
    begin
      im:= 0;
      inc(iy);
    end;
  end;
  Result:= (IntToStr(iy)+ StrYears(iy) + IntToStr(im) +
            StrMonths(im) + IntToStr(id)+ StrDays(id));
end;

Пример использования

procedure TForm1.Button1Click(Sender: TObject);
var
  dt1, dt2: TDateTime;
begin
  dt1:=StrToDate('31.05.2006');
  dt2:=StrToDate('01.02.2008');
  ShowMessage(StrBetweenDate(dt1, dt2));
end;