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

時間を保持するフィールドとして所有しているのは
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);

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;
//------------------------------


{-------------------------------
//年齢を調べる関数機能
    Age1/Age2
機能:       指定した日付の時の年齢を求めます。
            今日を指定する場合CheckDayにDateを代入してください
戻り値:     年齢
備考:       CheckDayがBirthDayの前の日でも
            年齢が負の値になって正しい日付計算処理をします
            (必要ない処理かも…)
            計算するときに2通りの求め方をしてみました。
            age2の方が簡単でよいかと思います。
履歴:       2001/08/21
//------------------------------}
function Age1(BirthDay, CheckDay:TDateTime):Integer;
var
  Year1,Month1,Day1,Year2,Month2,Day2: Word;
begin
//誕生日，任意の日を年月日単位にバラす
  DecodeDate(BirthDay, Year1, Month1, Day1);
  DecodeDate(CheckDay, Year2, Month2, Day2);

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

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

//その年の誕生日を過ぎていなければさらに１歳引く
  If ( EncodeDate(Year2, Month2, Day2)
       < EncodeDate(Year2, Month1, Day1) ) then
    Result := Result - 1;
End;

function Age2(BirthDay, CheckDay:TDateTime):Integer;
var
  Year1,Month1,Day1,Year2,Month2,Day2: Word;
begin
//誕生日，任意の日を年月日単位にバラす
  DecodeDate(BirthDay, Year1, Month1, Day1);
  DecodeDate(CheckDay, Year2, Month2, Day2);

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

//その年の誕生日を過ぎていなければさらに１歳引く
  if (Month2 < Month1) then
  begin
    Dec(Result);
  end else
  if (Month2 = Month1) then
  begin
    if (Day2 < Day1) then
      Dec(Result);
  end;
End;

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

procedure testAge;
begin
  Check(27, Age(StrToDateTime('1975/3/21 0:00'), StrToDateTime('2002/10/31 0:00')));

  Check(26, Age(StrToDateTime('1975/3/21 0:00'), StrToDateTime('2002/3/20 23:59')));
  Check(27, Age(StrToDateTime('1975/3/21 0:00'), StrToDateTime('2002/3/21 0:00')));
  Check(27, Age(StrToDateTime('1975/3/21 0:00'), StrToDateTime('2003/3/20 23:59')));
  Check(28, Age(StrToDateTime('1975/3/21 0:00'), StrToDateTime('2003/3/21 0:00')));

  Check(26, Age(StrToDateTime('1976/2/29 0:00'), StrToDateTime('2002/10/31 0:00')));

  Check(25, Age(StrToDateTime('1976/2/29 0:00'), StrToDateTime('2002/2/28 0:00')));
  Check(26, Age(StrToDateTime('1976/2/29 0:00'), StrToDateTime('2002/3/1 0:00')));
  Check(27, Age(StrToDateTime('1976/2/29 0:00'), StrToDateTime('2004/2/28 0:00')));
  Check(28, Age(StrToDateTime('1976/2/29 0:00'), StrToDateTime('2004/2/29 0:00')));
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.