年齢の計算

任意の日付における生物学的(?)年齢を計算する方法。日本の法律では誕生日の前日の満了を以って年齢が加算される(明治三十五年法律第五十号(年齢計算ニ関スル法律)、民法(明治二十九年四月二十七日法律第八十九号)第百四十三条および年齢のとなえ方に関する法律(昭和二十四年五月二十四日法律第九十六号))ため、法的年齢を要求される場合は注意が必要です。

uses
  Windows, SysUtils;

function GetAge(ABirthday: TDateTime; ABase: TDateTime;
                var AYear: Integer; var AMonth: Integer;
                var ADate: Integer; var AWeek: Integer): Integer;
var
  DT: TDateTime;
  ST1: TSystemTime;
  ST2: TSystemTime;
  ST3: TSystemTime;
begin

  { Decode }
  DecodeDate(ABirthday,ST1.wYear,ST1.wMonth,ST1.wDay);
  DecodeDate(ABase,ST2.wYear,ST2.wMonth,ST2.wDay);

  AYear  := ST2.wYear  - ST1.wYear;
  AMonth := ST2.wMonth - ST1.wMonth;
  ADate  := ST2.wDay   - ST1.wDay;

  if (ST1.wMonth > ST2.wMonth) or
     ((ST1.wMonth = ST2.wMonth) and (ST1.wDay > ST2.wDay)) then
  begin
    AYear  := AYear  -  1;
    AMonth := AMonth + 12;
  end;

  { Regulate date }
  if ADate < 0 then
  begin
    AMonth := AMonth - 1;

    ST3.wYear  := ST1.wYear  + AYear;
    ST3.wMonth := ST1.wMonth + AMonth;
    ST3.wDay   := ST1.wDay;
    if ST3.wMonth > 12 then
    begin
      ST3.wYear  := ST3.wYear  +  1;
      ST3.wMonth := ST3.wMonth - 12;
    end;

    DT := ABase;
{$IFDEF CONDITIONALEXPRESSIONS}
    { Delphi 6 or later }
    while TryEncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay,DT) = False do
    begin
      ST3.wDay := ST3.wDay - 1;
    end;
{$ELSE}
    { Delphi 5 or before }
    repeat
      try
        DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

      except
        ST3.wDay := ST3.wDay - 1;
        Continue;
      end;

      Break;
    until False;
{$ENDIF}

    ADate := Trunc(ABase - DT);
  end;

  { Calc weeks }
  DT := ABase;
  ST3.wYear  := ST1.wYear + AYear;
  ST3.wMonth := ST1.wMonth;
  ST3.wDay   := ST1.wDay;
{$IFDEF CONDITIONALEXPRESSIONS}
  { Delphi 6 or later }
  while TryEncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay,DT) = False do
  begin
    ST3.wDay := ST3.wDay - 1;
  end;
{$ELSE}
  { Delphi 5 or before }
  repeat
    try
      DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

    except
      ST3.wDay := ST3.wDay - 1;
      Continue;
    end;

    Break;
  until False;
{$ENDIF}

  AWeek := Trunc(ABase - DT) div 7;

  Result := AYear;

end;

ABirthdayに誕生日、ABaseに基準日を渡すとAYear/AMonth/ADateに経過年/月/日数が、AYear/AWeekに経過年/週数が格納されます。

2010/12/16追記: 経過日数、経過週数の補正処理の部分で、Delphi 6以降({$IFDEF CONDITIONALEXPRESSIONS}で判別)ではEncodeDateの呼び出しとそこからの例外の送出ではなくTryEncodeDateとその戻値を使用するように変更しました。オリジナルのコードは以下に置いておきます。

uses
  Windows, SysUtils;

function GetAge(ABirthday: TDateTime; ABase: TDateTime;
                var AYear: Integer; var AMonth: Integer;
                var ADate: Integer; var AWeek: Integer): Integer;
var
  DT: TDateTime;
  ST1: TSystemTime;
  ST2: TSystemTime;
  ST3: TSystemTime;
begin

  { Decode }
  DecodeDate(ABirthday,ST1.wYear,ST1.wMonth,ST1.wDay);
  DecodeDate(ABase,ST2.wYear,ST2.wMonth,ST2.wDay);

  AYear  := ST2.wYear  - ST1.wYear;
  AMonth := ST2.wMonth - ST1.wMonth;
  ADate  := ST2.wDay   - ST1.wDay;

  if (ST1.wMonth > ST2.wMonth) or
     ((ST1.wMonth = ST2.wMonth) and (ST1.wDay > ST2.wDay)) then
  begin
    AYear  := AYear  -  1;
    AMonth := AMonth + 12;
  end;

  { Regulate date }
  if ADate < 0 then
  begin
    AMonth := AMonth - 1;

    ST3.wYear  := ST1.wYear  + AYear;
    ST3.wMonth := ST1.wMonth + AMonth;
    ST3.wDay   := ST1.wDay;
    if ST3.wMonth > 12 then
    begin
      ST3.wYear  := ST3.wYear  +  1;
      ST3.wMonth := ST3.wMonth - 12;
    end;

    DT := ABase;
    repeat
      try
        DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

      except
        ST3.wDay := ST3.wDay - 1;
        Continue;
      end;

      Break;
    until False;

    ADate := Trunc(ABase - DT);
  end;

  { Calc weeks }
  DT := ABase;
  ST3.wYear  := ST1.wYear + AYear;
  ST3.wMonth := ST1.wMonth;
  ST3.wDay   := ST1.wDay;
  repeat
    try
      DT := EncodeDate(ST3.wYear,ST3.wMonth,ST3.wDay);

    except
      ST3.wDay := ST3.wDay - 1;
      Continue;
    end;

    Break;
  until False;
  AWeek := Trunc(ABase - DT) div 7;

  Result := AYear;

end;