{ -----------------------------------
時間の差分を
日にちで表すと何日か
時間で表すと何時間か
という計算をするクラス

時間を保持するフィールドとして所有しているのは
StartDateTimeとIntervalMilliSecondのみなので
すべてそこから値を求めている。

2002/07/21
  作成
2002/09/29
  ドキュメントを少し記述
2002/10/31
  Age関数とAgeプロパティを作成
  Age関数のテストを記述
//----------------------------------- }
unit IntervalTime;

interface

uses
  Classes,
  SysUtils;

type
  TOutFormat = (ofDay, ofHour);

  TIntervalTime = class(TComponent)
  private
    FStartDateTime: TDateTime;
    FIntervalMilliSecond: INt64;
    FOnChange: TNotifyEvent;
    FOutFormat: TOutFormat;
    procedure SetStartDateTime(const Value: TDateTime);
    procedure SetEndDateTime(const Value: TDateTime);
    procedure SetDay(const Value: Extended);
    procedure SetHour(const Value: Extended);
    procedure SetMinute(const Value: Extended);
    procedure SetSecond(const Value: Extended);
    procedure SetMilliSecond(const Value: Int64);
    procedure SetIntervalMilliSecond(const Value: INt64);
    function GetStartDateTime: TDateTime;
    function GetEndDateTime: TDateTime;
    function GetDay: Extended;
    function GetHour: Extended;
    function GetMinute: Extended;
    function GetSecoud: Extended;
    function GetMilliSecond: Int64;
    procedure Change;
    function GetFormatString: String;
    function GetAge: Integer;
    procedure SetAge(const Value: Integer);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property StartDateTime: TDateTime read GetStartDateTime write SetStartDateTime;
    property EndDateTime: TDateTime read GetEndDateTime write SetEndDateTime stored False;
    property Day: Extended read GetDay write SetDay stored False;
    property Hour: Extended read GetHour write SetHour stored False;
    property Minute: Extended read GetMinute write SetMinute stored False;
    property Second: Extended read GetSecoud write SetSecond stored False;
    property MilliSecond: Int64 read GetMilliSecond write SetMilliSecond;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OutFormat: TOutFormat read FOutFormat write FOutFormat;
    property FormatString: String read GetFormatString;
    property Age: Integer read GetAge write SetAge;
  end;

procedure Register;

type
  THour = 0..23;
  TMinute = 0..59;
  TSecond = 0..59;
  TMilliSecond = 0..999;

procedure IntervalDayFormatOut(IntervalMilliSecond: Int64;
 out Day: Integer; out Hour: THour; out Minute: TMinute;
 out Second: TSecond; out MilliSecond: TMilliSecond);
procedure IntervalHourFormatOut(IntervalMilliSecond: Int64;
 out Hour: Integer; out Minute: TMinute;
 out Second: TSecond; out MilliSecond: TMilliSecond);
procedure IntervalMinuteFormatOut(IntervalMilliSecond: Int64;
 out Minute: Integer;
 out Second: TSecond; out MilliSecond: TMilliSecond);

function Age(BirthDay, CheckDay:TDateTime):Integer;
procedure testAge;

implementation

uses DateUtils, XPtest;

{-------------------------------
//  ミリ秒で時間を指定すると
    日:時:分:秒:ミリ秒で出力する関数
備考:
履歴:       2002/09/29
              説明を記述
//--▼----------------------▽--}
procedure IntervalDayFormatOut(IntervalMilliSecond: Int64;
 out Day: Integer; out Hour: THour; out Minute: TMinute;
 out Second: TSecond; out MilliSecond: TMilliSecond);
var
  MinusFlag: Boolean;
begin
  MinusFlag := False;
  if IntervalMilliSecond < 0 then
    MinusFlag := True;

  Day := 0;
  Hour := 0;
  Minute := 0;
  Second := 0;
  MilliSecond := 0;

  IntervalMilliSecond := Abs(IntervalMilliSecond);

  if IntervalMilliSecond = 0 then Exit;
  Day := IntervalMilliSecond div (24*60*60*1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Day)*24*60*60*1000);
  if MinusFlag then Day := -1 * Day;

  if IntervalMilliSecond = 0 then Exit;
  Hour := IntervalMilliSecond div (60*60*1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Hour)*60*60*1000);

  if IntervalMilliSecond = 0 then Exit;
  Minute := IntervalMilliSecond div (60*1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Minute)*60*1000);

  if IntervalMilliSecond = 0 then Exit;
  Second := IntervalMilliSecond div (1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Second)*1000);

  if IntervalMilliSecond = 0 then Exit;
  MilliSecond := IntervalMilliSecond;
end;
//--△----------------------▲--

{-------------------------------
//  ミリ秒で時間を指定すると
    時:分:秒:ミリ秒で出力する関数
備考:
履歴:       2002/09/29
              説明を記述
//--▼----------------------▽--}
procedure IntervalHourFormatOut(IntervalMilliSecond: Int64;
 out Hour: Integer; out Minute: TMinute;
 out Second: TSecond; out MilliSecond: TMilliSecond);
var
  MinusFlag: Boolean;
begin
  MinusFlag := False;
  if IntervalMilliSecond < 0 then
    MinusFlag := True;

  Hour := 0;
  Minute := 0;
  Second := 0;
  MilliSecond := 0;

  IntervalMilliSecond := Abs(IntervalMilliSecond);

  if IntervalMilliSecond = 0 then Exit;
  Hour := IntervalMilliSecond div (60*60*1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Hour)*60*60*1000);
  if MinusFlag then Hour := -1 * Hour;

  if IntervalMilliSecond = 0 then Exit;
  Minute := IntervalMilliSecond div (60*1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Minute)*60*1000);

  if IntervalMilliSecond = 0 then Exit;
  Second := IntervalMilliSecond div (1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Second)*1000);

  if IntervalMilliSecond = 0 then Exit;
  MilliSecond := IntervalMilliSecond;
end;
//--△----------------------▲--

{-------------------------------
//  ミリ秒で時間を指定すると
    分:秒:ミリ秒で出力する関数
備考:
履歴:       2008/01/28
              作成
//--▼----------------------▽--}
procedure IntervalMinuteFormatOut(IntervalMilliSecond: Int64;
 out Minute: Integer;
 out Second: TSecond; out MilliSecond: TMilliSecond);
var
  MinusFlag: Boolean;
begin
  MinusFlag := False;
  if IntervalMilliSecond < 0 then
    MinusFlag := True;

  Minute := 0;
  Second := 0;
  MilliSecond := 0;

  IntervalMilliSecond := Abs(IntervalMilliSecond);

  if IntervalMilliSecond = 0 then Exit;

  if IntervalMilliSecond = 0 then Exit;
  Minute := IntervalMilliSecond div (60*1000);
  IntervalMilliSecond := IntervalMilliSecond - (Integer(Minute)*60*1000);
  if MinusFlag then Minute := -1 * Minute;

  if IntervalMilliSecond = 0 then Exit;
  Second := IntervalMilliSecond div (1000);
  IntervalMilliSecond := IntervalMilliSecond - (Int64(Second)*1000);

  if IntervalMilliSecond = 0 then Exit;
  MilliSecond := IntervalMilliSecond;
end;
//--△----------------------▲--


{-------------------------------
//年齢を調べる関数機能
    GetAgeOld/GetAge
機能:       指定した日付の時の年齢を求めます。
            今日を指定する場合CheckDateにDateを代入してください
戻り値:     年齢
備考:       CheckDateがBirthDateの前の日でも
            年齢が負の値になって正しい日付計算処理をします
            (必要ない処理かも…)
            計算するときに2通りの求め方をしてみました。
            GetAgeOldはEncodeDateしているので遅いかもしれない
            GetAgeを使ってください。
履歴:       2001/08/21
            2008/01/30
              関数名・変数名やコメントなどを修正
              テストコードをしっかり記述
//--▼----------------------▽--}
function GetAgeOld(BirthDate, CheckDate: TDateTime): Integer;
var
  BirthYear, BirthMonth, BirthDay,
  CheckYear, CheckMonth, CheckDay: Word;
begin
  //誕生日，任意の日を年月日単位にバラす
  DecodeDate(BirthDate, BirthYear, BirthMonth, BirthDay);
  DecodeDate(CheckDate, CheckYear, CheckMonth, CheckDay);

  //現在（任意の年月日）の「年」から誕生日の「年」を引く
  Result := CheckYear - BirthYear;

  //チェックしたい年がうるう年ではない場合
  if not IsLeapYear(CheckYear) then
  begin
    //誕生日がうるう日なら
    if (BirthMonth=2) and (BirthDay=29) then
    begin
      BirthMonth := 3; BirthDay := 1;
    end; //誕生日を3/1にしておく
  end;

  //その年の誕生日を過ぎていなければさらに１歳引く
  if ( EncodeDate(CheckYear, CheckMonth, CheckDay)
       < EncodeDate(CheckYear, BirthMonth, BirthDay) ) then
    Result := Result - 1;
End;

function GetAge(BirthDate, CheckDate: TDateTime): Integer;
var
  BirthYear, BirthMonth, BirthDay,
  CheckYear, CheckMonth, CheckDay: Word;
begin
  DecodeDate(BirthDate, BirthYear, BirthMonth, BirthDay);
  DecodeDate(CheckDate, CheckYear, CheckMonth, CheckDay);

  Result := CheckYear - BirthYear;

  //誕生日を過ぎていなければさらに１歳引く
  if (CheckMonth < BirthMonth) then
  begin
    Dec(Result);
  end else
  if (CheckMonth = BirthMonth) then
  begin
    if (CheckDay < BirthDay) then
      Dec(Result);
  end;
End;

function Age(BirthDay, CheckDay:TDateTime):Integer;
begin
  Result := GetAge(BirthDay, CheckDay);
end;

type
  TAgeFunction = Function(A, B: TDateTime): Integer;

procedure testAge;

    function AgeText(BirthDateText, CheckDateText: String; Func: TAgeFunction): Integer;
    begin
      Result :=
        Func(StrToDate(BirthDateText), StrToDate(CheckDateText)) ;
    end;

    procedure CheckAgeFunction(BirthDateText, CheckDateText: String; CheckAge: Integer);
    begin
      Check(AgeText(BirthDateText, CheckDateText, GetAge), CheckAge);
      Check(AgeText(BirthDateText, CheckDateText, GetAgeOld), CheckAge);
    end;

begin
  //閏年が誕生日 と 閏年じゃない年 との年齢
  CheckAgeFunction('1992/02/28', '1993/02/27', 0);
  CheckAgeFunction('1992/02/28', '1993/02/28', 1);
  CheckAgeFunction('1992/02/28', '1993/03/01', 1);

  CheckAgeFunction('1992/02/29', '1993/02/27', 0);
  CheckAgeFunction('1992/02/29', '1993/02/28', 0);
  CheckAgeFunction('1992/02/29', '1993/03/01', 1);

  CheckAgeFunction('1992/03/01', '1993/02/27', 0);
  CheckAgeFunction('1992/03/01', '1993/02/28', 0);
  CheckAgeFunction('1992/03/01', '1993/03/01', 1);

  //閏年が誕生日 と 閏年 との年齢
  CheckAgeFunction('1992/02/28', '2008/02/27', 15);
  CheckAgeFunction('1992/02/28', '2008/02/28', 16);
  CheckAgeFunction('1992/02/28', '2008/02/29', 16);
  CheckAgeFunction('1992/02/28', '2008/03/01', 16);

  CheckAgeFunction('1992/02/29', '2008/02/27', 15);
  CheckAgeFunction('1992/02/29', '2008/02/28', 15);
  CheckAgeFunction('1992/02/29', '2008/02/29', 16);
  CheckAgeFunction('1992/02/29', '2008/03/01', 16);

  CheckAgeFunction('1992/03/01', '2008/02/27', 15);
  CheckAgeFunction('1992/03/01', '2008/02/28', 15);
  CheckAgeFunction('1992/03/01', '2008/02/29', 15);
  CheckAgeFunction('1992/03/01', '2008/03/01', 16);

  //閏年じゃない年が誕生日 と 閏年じゃない年 との年齢
  CheckAgeFunction('1993/02/28', '1994/02/27', 0);
  CheckAgeFunction('1993/02/28', '1994/02/28', 1);
  CheckAgeFunction('1993/02/28', '1994/03/01', 1);

  CheckAgeFunction('1993/03/01', '1994/02/27', 0);
  CheckAgeFunction('1993/03/01', '1994/02/28', 0);
  CheckAgeFunction('1993/03/01', '1994/03/01', 1);

  //閏年じゃない年が誕生日 と 閏年 との年齢
  CheckAgeFunction('2007/02/28', '2008/02/27', 0);
  CheckAgeFunction('2007/02/28', '2008/02/28', 1);
  CheckAgeFunction('2007/02/28', '2008/02/29', 1);
  CheckAgeFunction('2007/02/28', '2008/03/01', 1);

  CheckAgeFunction('2007/03/01', '2008/02/27', 0);
  CheckAgeFunction('2007/03/01', '2008/02/28', 0);
  CheckAgeFunction('2007/03/01', '2008/02/29', 0);
  CheckAgeFunction('2007/03/01', '2008/03/01', 1);
end;
//--△----------------------▲--

////////////////////////////////////////////////////////////
{ TIntervalTime }
////////////////////////////////////////////////////////////

procedure Register;
begin
  RegisterComponents('Samples', [TIntervalTime]);
end;


constructor TIntervalTime.Create(AOwner: TComponent);
begin
  inherited;
  FStartDateTime := Date;
  FIntervalMilliSecond := 0;
  FOutFormat := ofDay;
end;

{-------------------------------
//  StartDateTimeのプロパティ
備考:
履歴:       2002/09/29
//--▼----------------------▽--}
procedure TIntervalTime.SetStartDateTime(const Value: TDateTime);
begin
  if Value <> GetStartDateTime then
  begin
    FStartDateTime := Value;
    Change;
  end;
end;

function TIntervalTime.GetStartDateTime: TDateTime;
begin
  Result := FStartDateTime;
end;
//--△----------------------▲--

{-------------------------------
//  EndDateTimeのプロパティ
備考:       結局SetDay/GetDayと
            FStartDateTimeを用いて計算している
履歴:       2002/09/29
//--▼----------------------▽--}
procedure TIntervalTime.SetEndDateTime(const Value: TDateTime);
begin
  SetDay(Value - FStartDateTime);
end;

function TIntervalTime.GetEndDateTime: TDateTime;
begin
  Result := StartDateTime + GetDay;
end;
//--△----------------------▲--

{-------------------------------
//  時間範囲を日:時:分:秒:ミリ秒
    で出力するプロパティGetメソッド
    GetDay/GetHour/GetMinute/GetSecond/GetMilliSecond
機能:       86400秒が1日ということが
            すぐわかる。
備考:
履歴:       2002/09/29
//--▼----------------------▽--}
function TIntervalTime.GetDay: Extended;
begin
  Result := GetHour / 24;
end;

function TIntervalTime.GetHour: Extended;
begin
  Result := GetMinute / 60;
end;

function TIntervalTime.GetMinute: Extended;
begin
  Result := GetSecoud / 60;
end;

function TIntervalTime.GetSecoud: Extended;
begin
  Result := GetMilliSecond / 1000;
end;

function TIntervalTime.GetMilliSecond: Int64;
begin
  Result := FIntervalMilliSecond;
end;
//--△----------------------▲--

{-------------------------------
//  日:時:分:秒:ミリ秒をセットすると
    間隔をミリ秒で求めて保持するプロパティSetメソッド
    SetDay/SetHour/SetMinute/SetSecond/SetMilliSecond
機能:       86400秒が1日ということが
            すぐわかる。
備考:
履歴:       2002/09/29
//--▼----------------------▽--}
procedure TIntervalTime.SetDay(const Value: Extended);
begin
  SetHour(Value * 24);
end;

procedure TIntervalTime.SetHour(const Value: Extended);
begin
  SetMinute(Value * 60);
end;

procedure TIntervalTime.SetMinute(const Value: Extended);
begin
  SetSecond(Value * 60);
end;

procedure TIntervalTime.SetSecond(const Value: Extended);
begin
  SetMilliSecond( Round( Value * 1000 ) );
end;

procedure TIntervalTime.SetMilliSecond(const Value: Int64);
begin
  SetIntervalMilliSecond( Value );
end;
//--△----------------------▲--

procedure TIntervalTime.SetIntervalMilliSecond(const Value: Int64);
begin
  if Value <> FIntervalMilliSecond then
  begin
    FIntervalMilliSecond := Value;
    Change;
  end;
end;

procedure TIntervalTime.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{-------------------------------
//  書式化した文字列で出力
機能:       クラスが持っている差分時間間隔を
            ○日間○時間○分○秒
            ○時間○時間○分○秒
            という形式で出力
            形式はFOutFormat:TOutFormatの値で決まる
履歴:       2002/09/29
//--▼----------------------▽--}
function TIntervalTime.GetFormatString: String;
var
 OutValue: Integer;
 Hour: THour; Minute: TMinute;
 Second: TSecond; MilliSecond: TMilliSecond;
begin
  case FOutFormat of
    ofDay:
    begin
      IntervalDayFormatOut(FIntervalMilliSecond,
        OutValue, Hour, Minute, Second, MilliSecond);

      Result :=
        IntToStr(OutValue) +'日間' +
        IntToStr(Hour) +    '時間' +
        IntToStr(Minute) +  '分' +
        IntToStr(Second) +  '秒' +
        IntToStr(MilliSecond);
    end;

    ofHour:
    begin
      IntervalHourFormatOut(FIntervalMilliSecond,
        OutValue, Minute, Second, MilliSecond);
      Result :=
        IntToStr(OutValue) +'時間' +
        IntToStr(Minute) +  '分' +
        IntToStr(Second) +  '秒' +
        IntToStr(MilliSecond);
    end;

  else
    Assert(False,'');
  end;
end;
//--△----------------------▲--

function TIntervalTime.GetAge: Integer;
begin
  Result := IntervalTime.Age(FStartDateTime, EndDateTime);
end;

procedure TIntervalTime.SetAge(const Value: Integer);
begin
  EndDateTime := IncYear(FStartDateTime, Value);
end;

end.