Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年10月10日] [更新 2020年04月01日]　Delphi サンプルプログラム集
004_タイマー
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
004_TimerTest.zip　[5,519 KB]　2020年04月01日版 (EXE 同梱)






タイマー関係の関数とコンポーネント


時間の計測に使用するのがタイマー関係の関数です．時間の計測を開始して，一定時間が経過したら動作を止めるのがタイマー，途中で止めればストップウォッチということになります．
タイマー関係の関数や，タイマー関係のコンポーネントには，下の表のようなものがあります．

Delphi の TTimer コンポーネントは，OnTimer イベントを使用して，Interval プロパティで指定した一定時間間隔で，何かの処理を実行するのに便利です．また Interval, Enabled プロパティを使用すれば，一定時間だけ特定の処理をさせたり，ストップウォッチとしても使用できます．

本ページのサンプルは，Delphi 付属の TTimer コンポーネントではなく，[002_アプリの起動時間を測定] で使用したマイクロ秒測定用のストップウォッチ，Delphi の TStopWatch 等を使用した簡単なタイマーのテストです．



表1
時間計測等に関係する関数類

関数 説明
GetTickCount システム起動後の経過時間をミリ秒単位で取得
最小設定単位は 1 ミリ秒だが，実際の精度はこれより低い
精度はシステムのシステムタイマーの分解能(ハードウェアの割り込み時間)による
昔の PC では 1 秒に 18.2回 で 54.9 ミリ秒の記録がある
戻り値は DWORD 値なので約 49.71 日で 0 にリセットされる
SetTimer 指定されたタイムアウト値を持つタイマを 1 つ作成
KillTimer で破棄する
機能，性能は上の GetTickCount と同じ
Delphi の TTimer はこれを使用している
KillTimer 指定されたタイマを破棄する
timeSetEvent
(MMSystem.pas)		 マルチメディアタイマーのイベントを開始する
マルチメディアタイマーは独自のスレッドで動作する
最小単位は 1 ミリ秒
精度はシステムのマルチメディアタイマーの分解能による
timeKillEvent
(MMSystem.pas)		 timeSetEvent の説明参照
QueryPerformanceCounter 高分解能パフォーマンスカウンタのカウンタの現在の値を取得
精度はシステムの高分解能パフォーマンスカウンターの分解能による
timeGetTime
(MMSystem.pas)		 Windowsが起動してからの時間 (システム時刻) をミリ秒で取得
最小単位は 1 ミリ秒
精度はシステムのマルチメディアタイマーの分解能による
戻り値は DWORD なので，約 49.71 日で 0 にリセットされる
サンプルプログラム集では，ほとんどこれを使用している
timeGetSystemTime
(MMSystem.pas)		 timeGetTime 関数と同じ
時刻を返すのに MMTIME 構造体を使用する点が違う
timeGetTime 関数よりも少しオーバーヘッドがある
GetSystemTimeAdjustment システムタイマーの分解能の取得 (クロック割り込みの間隔の取得)
timeGetDevCaps マルチメディアタイマーの分解能の取得
QueryPerformanceFrequency 高分解能パフォーマンスカウンターの分解能の取得
正確には，カウンタの周波数 (更新頻度) の取得


表2
ストップウォッチやタイマー処理に利用可能なコンポーネント類
精度は使用しているタイマー関係関数によって異なる

クラス名 説明
TTimer Delphi の付属コンポーネント
Windows API の SetTimer 関数と KillTimer 関数を使用
TStopwatch Delphi の付属のレコード型 (Delphi 2010 以降)
QueryPerformanceCounter 関数を使用
TMMTimer Halbow 資料館の [高精度タイマ] 解説用に作成したタイマーコンポーネント
高精度タイマーとして，TTimer の代わりに使用できる
Windows API の timeSetEvent 関数と timeKillEvent 関数を使用
TSdStopWatch 29 万年まで計測可能なマイクロ秒ストップウォッチ
時間表示用のコントロール付き
QueryPerformanceCounter 関数と QueryPerformanceFrequency 関数を使用
TplJStopWatch JUNKI さん作成のものを，筆者が改変して提供
QueryPerformanceCounter 関数と QueryPerformanceFrequency 関数を使用


システムが起動してから一ヶ月以内の場合，数日以内の計測であって，分解能，精度共に 1 ミリ秒程度で構わないのであれば，次のように，uses に MMSystem を追加して，timeGetTime を使用する方法が一番簡単です．サンプルプログラム集でも，時間計測が必要な場合にはほとんどこの方法を使用しています． 

implementation

uses MMSystem;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  TimeStart : Cardinal;
begin
  //現在の時刻を取得しておく
  TimeStart := timeGetTime;

  //3000ミリ秒経過したらダイアログを表示
  while True do begin
    if (timeGetTime - TimeStart) >= 3000 then break;
    Application.ProcessMessages;
    Sleep(1);
  end;
  ShowMessage('END');
end;



01_タイマー ( スレッドを使用しないコード )


[002_アプリの起動時間を測定] で使用したマイクロ秒測定用のストップウォッチを使用したタイマーのサンプルです．タイマーとして用いるために TplJStopWatch のコードを変更しました．実際には，この精度のタイマーでしたら，TTimer コンポーネントで十分でしょう．
開発の合間に食するカップラーメンの監視ぐらいには利用できるかも知れません．

このサンプルでは，タイマー動作中にフォームの移動操作等を行うと表示の更新が停止します．また，フォーム等の移動中に経過時間が過ぎた場合，ループが終了せず，指定時間を過ぎてかタイマーが終了するという現象も発生します．


図1
設計時画面
図2
タイマー起動中の画面
  • この設定は 180 秒，つまり 3 分
  • 残り時間を表示
  • 指定した時間内にフォームの移動等，他の操作をすると残り時間の表示が更新されない

リスト1
スレッドを使用しないタイマー 
unit TimerTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, plJStopWatch, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    AStopWatch : TplJStopWatch;
    flgStop : Boolean;
   procedure DisplayTime(msTime: Extended);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  タイマー起動
//  タイマー動作中にフォームの移動操作等を行うと表示の更新が停止する
//  また，フォーム等の移動中に経過時間が過ぎた場合，ループが終了しないので注意
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  TimeStart : Extended;
  TimeValue : Integer;
  TimeDis   : Extended;
begin
  Button1.Enabled := False;

  if not Assigned(AStopWatch) then AStopWatch := TplJStopWatch.Create(Self);

  flgStop   := False;
  TimeValue := SpinEdit1.Value;
  TimeStart := AStopWatch.Start;

  while True do begin
    TimeDis := TimeValue-(AStopWatch.Time - TimeStart) / 1000;
    DisplayTime(TimeDis);
    if flgStop then break;
    if TimeDis <= 0 then break;
    Application.ProcessMessages;
    //これがないとCPU使用率が跳ね上がる
    Sleep(1);
  end;

  Button1.Enabled := True;
  Windows.Beep(200, 1200);
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  flgStop := True;
end;

//=============================================================================
//  残り時間を分と秒で表示
//  関数の引数は秒
//=============================================================================
procedure TForm1.DisplayTime(msTime: Extended);
var
  Amin : Integer;
  Asec : Integer;
begin
  Amin := Trunc(msTime / 60);
  Asec := Trunc(msTime) - Amin * 60;
  Panel1.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
  Panel1.Update;
end;

end.



02_タイマー ( TThread を使用したコード )


タイマーの動作部分をスレッド (TThread) にしたコードです．スレッドにすれば，フォームを移動する等の動作を行っても時間経過を表示し，指定時間経過すれば，タイマーは停止してくれます．


図3
タイマー起動中の画面
  • 指定した時間内にフォームの移動等，他の操作をしても残り時間の表示作が更新される


リスト2
TThead を使用したタイマー 
unit TimerTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, plJStopWatch, Spin;

type
  TplTimerThread = class(TThread)
  private
    { Private 宣言 }
    AStopWatch : TplJStopWatch;
    FPanel     : TPanel;
    FTimeValue : Integer;
    FTimeStart : Extended;
    FTimeDis   : Extended;
    procedure DisplayTime;
    procedure ChangeEnabled;
  protected
    procedure Execute; override;
  public
    constructor Create(TimeValue: Integer; Panel: TPanel); Virtual;
    destructor Destroy; override;    
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    AThread : TplTimerThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  スレッドを作成して実行
//  タイマーの起動や時間経過の監視はスレッドで行う
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;

  AThread := TplTimerThread.Create(SpinEdit1.Value, Panel1);
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Assigned(AThread) then AThread.Terminate;
end;

{ TplTimerThread }

//=============================================================================
//  スレッド生成して実行
//=============================================================================
constructor TplTimerThread.Create(TimeValue: Integer; Panel: TPanel);
begin
  FPanel     := Panel;
  FTimeValue := TimeValue;

  inherited Create(False);
  FreeOnTerminate := True;
end;

//=============================================================================
//  スレッドを破棄する時にはストップウォッチも破棄
//=============================================================================
destructor TplTimerThread.Destroy;
begin
  FreeAndNil(AStopWatch);
  inherited Destroy;
end;

//=============================================================================
//  タイマーを起動して時間経過を表示
//=============================================================================
procedure TplTimerThread.Execute;
begin
  if not Assigned(AStopWatch) then AStopWatch := TplJStopWatch.Create(nil);

  FTimeStart := AStopWatch.Start;

  while not Terminated do begin
    FTimeDis := FTimeValue - (AStopWatch.Time - FTimeStart) / 1000;
    Synchronize(DisplayTime);

    if FTimeDis <= 0 then break;

    //これがないとCPU使用率が跳ね上がる
    Sleep(1);
  end;

  //安全な動作のためにはSynchronizeを使用する
  //Form1.Button1.Enabled := True;
  Synchronize(ChangeEnabled);
  Terminate;
  Windows.Beep(200, 1200);
end;

//=============================================================================
//  残り時間を分と秒で表示．表示はこのスレッドを呼出したプログラム
//  FTimeDisの値は秒
//=============================================================================
procedure TplTimerThread.DisplayTime;
var
  Amin : Integer;
  Asec : Integer;
begin
  Amin := Trunc(FTimeDis / 60);
  Asec := Trunc(FTimeDis) - Amin * 60;
  FPanel.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
  FPanel.Update;
end;

//=============================================================================
//  スレッド外へのアクセス
//=============================================================================
procedure TplTimerThread.ChangeEnabled;
begin
  Form1.Button1.Enabled := True;
end;

end.



03_タイマー ( BeginThread を使用したコード )


こちらもスレッドを使用した例ですが，System.pas 内の BeginThread 関数を使用してみました．フォームに配置しているコントロール類は全て前のサンプルと同じです．


図4
タイマー起動中の画面
  • 動作は前項のサンプルと同じ


リスト3
BeginThread を使用したタイマー 
unit TimerTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, plJStopWatch, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  flgStop : Boolean;

//-----------------------------------------------------------------------------
//  スレッドレコードの定義
//  スレッドに値を渡す
//-----------------------------------------------------------------------------
type
  TThreadParams = record
    FButton    : TButton;
    FPanel     : TPanel;
    FTimeValue : Integer;
  end;
  PThreadParams = ^TThreadParams;

//-----------------------------------------------------------------------------
//  スレッドの実行部分
//  Format関数を使用すると，メモリマネージャーがメモリリーク(UnicodeString)を
//  を検出することがあるが問題ないだろう
//-----------------------------------------------------------------------------
procedure TimerThread(Param : PThreadParams);
var
  AStopWatch : TplJStopWatch;
  FTimeStart : Extended;
  FTimeDis   : Extended;
  Amin       : Integer;
  Asec       : Integer;
begin
  Param^.FButton.Enabled := False;
  AStopWatch := TplJStopWatch.Create(nil);

  FTimeStart := AStopWatch.Start;
  try
    while True do begin
      //残り時間を秒に換算
      FTimeDis := Param^.FTimeValue - (AStopWatch.Time - FTimeStart) / 1000;

      //分と秒の値
      Amin := Trunc(FTimeDis / 60);
      Asec := Trunc(FTimeDis) - Amin * 60;
      //表示更新
      Param^.FPanel.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
      Param^.FPanel.Update;

      if flgStop then break;
      if FTimeDis <= 0 then break;

      //これがないとCPU使用率が跳ね上がる
      Sleep(1);
    end;
  finally
    FreeAndNil(AStopWatch);
  end;
  Param^.FButton.Enabled := True;

  //終了したらビープ音
  Windows.Beep(200, 1200);
  //スレッド終了
  EndThread(0);
end;

//=============================================================================
//  スレッドを作成して実行
//  タイマーの起動や時間経過の監視はスレッドで行う
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Thread1 : Integer;
  pInfo   : PThreadParams;
  id1     : Cardinal;
begin
  flgStop := False;

  //メモリを確保し，スレッドに渡す値をセットしてスレッド開始
  //GetMem(pInfo, SizeOf(pInfo));でも可
  New(pInfo);
  pInfo^.FButton    := Button1;
  pInfo^.FPanel     := Panel1;
  pInfo^.FTimeValue := SpinEdit1.Value;

  Thread1 := BeginThread(nil, 0, Addr(TimerThread), pInfo, 0, id1);
  try
  finally
    //スレッドを終了したらハンドルクローズ
    CloseHandle(Thread1);
    //メモリの解放.GetMemを使用して確保した場合はFreeMem(pInfo);
    Dispose(pInfo);
  end;
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  flgStop := True;
end;

end.



04_TStopWatch を使用したタイマー ( Delphi 2010 以降 )


次のサンプルもスレッドを使用しています．
Delphi 2010 の Diagnostics ユニットの TStopWatch を使用したタイマーのサンプルです．
時刻取得のプロパティは，TTimeSpan 型のレコード型となっていて，いろいろな形式での時刻形式での取得ができます．この TTimeSpan クラスは，TimeSpan というユニットにあります．
この TStopWatch は QueryPerformanceCounter 関数を使用しています．


図5
タイマー起動中の画面
  • 動作は前項のサンプルと同じ


リスト4
TStopWatch クラスを使用したタイマー 
unit TimerTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Spin, Diagnostics;

type
  TplTimerThread = class(TThread)
  private
    { Private 宣言 }
    AStopWatch : TStopWatch;
    FPanel     : TPanel;
    FTimeValue : Int64;
    FTimeDis   : Int64;
  protected
    procedure Execute; override;
  public
    constructor Create(TimeValue: Int64; Panel: TPanel); Virtual;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    AThread : TplTimerThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  スレッドを作成して実行
//  タイマーの起動や時間経過の監視はスレッドで行う
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  AThread := TplTimerThread.Create(SpinEdit1.Value, Panel1);
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Assigned(AThread) then AThread.Terminate;
end;

{ TplTimerThread }

//=============================================================================
//  スレッド生成して実行
//=============================================================================
constructor TplTimerThread.Create(TimeValue: Int64; Panel: TPanel);
begin
  FPanel     := Panel;
  FTimeValue := TimeValue;

  inherited Create(False);
  FreeOnTerminate := True;
end;

//=============================================================================
//  タイマーを起動して時間経過を表示
//  DelphiのTStopWatchを使用(usesにDiagnosticsが必要)
//
//  Panel1はTheadのCreateの引数にしているが，Form1は直接コード中に書いている
//  スレッド内部で，呼び出し側のスレッドのコントロール等のアクセスが必要であれ
//  ば，Createの引数をレコード型にする方法も考えられる
//
//  TStopWatchの使用には，usesにDiagnosticsが必要
//=============================================================================
procedure TplTimerThread.Execute;
var
  Amin : Integer;
  Asec : Integer;
begin
  AStopWatch := TStopwatch.StartNew;

  while not Terminated do begin
    //FTimeDisの値は秒
    FTimeDis := FTimeValue - AStopWatch.ElapsedMilliseconds div 1000;

    //残り時間を分と秒で表示
    Synchronize(
      procedure
      begin
        Amin := FTimeDis div 60;
        Asec := FTimeDis - Amin * 60;
        FPanel.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
        FPanel.Update;
      end
    );

    if FTimeDis <= 0 then break;

    //これがないとCPU使用率が跳ね上がる
    Sleep(1);
  end;

  //安全な動作のためにはSynchronizeを使用する
  Synchronize(
    procedure
    begin
      Form1.Button1.Enabled := True;
    end
  );
  Terminate;
  Windows.Beep(200, 1200);
end;

end.



05_CreateAnonymousThread 使用のタイマー ( Delphi XE 以降 )


次のサンプルもスレッドを使用した例ですが，Delphi XE から使用可能な CreateAnonymousThread メソッドを使用しています．このCreateAnonymousThread メソッドは，簡単にスレッドを作成することができ，便利です．

このサンプルは，[スタート] ボタンをクリックして，タイマーを起動した後，指定時間が経過しない間に再度 [スタート] ボタンをクリックすると，タイマーは再起動となります．


図6
タイマー起動中の画面
  • 動作は前項のサンプルと同じ


リスト5
CreateAnonymousThread メソッドを使用したスレッド動作のタイマー 
unit TimerTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Spin, Diagnostics;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    SpinEdit1: TSpinEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    flgStop : Boolean;
    TimerThread : TThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  CreateAnonymousThreadでスレッドを作成して実行
//  タイマーの起動や時間経過の監視はスレッドで行う
//
//  TStopWatchの使用には，usesにDiagnosticsが必要
//  TThread.Synchronizeは不要かも知れない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AStopWatch : TStopWatch;
  FTimeValue : Int64;
  FTimeDis   : Int64;
  Amin       : Integer;
  Asec       : Integer;
begin
  Button1.Enabled := False;

  if Assigned(TimerThread) then begin
    flgStop := True;
    TimerThread.Terminate;
    FreeAndNil(TimerThread);
  end;

  flgStop := False;
  TimerThread := TThread.CreateAnonymousThread(
    procedure()
    begin
      AStopWatch := TStopwatch.StartNew;
      FTimeValue := SpinEdit1.Value;

      while True do begin
        //FTimeDisの値は秒
        FTimeDis := FTimeValue - AStopWatch.ElapsedMilliseconds div 1000;
        Amin     := FTimeDis div 60;
        Asec     := FTimeDis - Amin * 60;

        TThread.Synchronize(TThread.CurrentThread,
          procedure
          begin
            Panel1.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
            Panel1.Update;
          end
        );

        if flgStop       then break;
        if FTimeDis <= 0 then break;

        //これがないとCPU使用率が跳ね上がる
        Sleep(1);
      end;

      //上の処理が終了したら...
      TThread.Synchronize(TThread.CurrentThread,
        procedure
        begin
          Button1.Enabled := True;
          Windows.Beep(200, 1200);
        end
      );
    end
  );
  TimerThread.FreeOnTerminate := False;
  TimerThread.Start;
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  flgStop := True;
end;

end.


[700_一定時間だけ処理を中断] のサンプルがありますが，下のコードのように，スレッドを使用すれば指定した一定時間中も，フォームの移動や入力コントロールの操作が可能です．しかも，指定時間後には確実に処理が終了します．


リスト6
一定時間，処理を中断する例 
//=============================================================================
//  Sleepで指定した時間，Button1を使用不可にする
//  この間，フォームの移動や，入力コントロールの操作は可能
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;

  TThread.CreateAnonymousThread(
    procedure()
    begin
      Sleep(5000);

      //上の処理終了後の処理
      TThread.Synchronize(TThread.CurrentThread,
        procedure
        begin
          Button1.Enabled := True;
        end
      );
    end
  ).Start;
end;


「無名メソッド」の部分は，別のメソッド (名前ありメソッド ?) にすることもできます．
次のコードでは，無名メソッドの部分を，TimerThreadProc という名前のメソッドにしています．


リスト7
CreateAnonymousThread メソッドを使用したスレッド動作のタイマー
名前ありメソッド (?) を使用するコード		 
//=============================================================================
//  スレッド処理用メソッド
//
//  TStopWatchの使用には，usesにDiagnosticsが必要
//  TThread.Synchronizeは不要かも知れない
//=============================================================================
procedure TForm1.TimerThreadProc;
var
  AStopWatch : TStopWatch;
  FTimeValue : Int64;
  FTimeDis   : Int64;
  Amin       : Integer;
  Asec       : Integer;
  Sync       : TThreadProcedure;
  SyncEnd    : TThreadProcedure;
begin
  //メソッドを定義
  Sync := procedure
  begin
    Panel1.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
    Panel1.Update;
  end;

  SyncEnd := procedure
  begin
    Button1.Enabled := True;
    Windows.Beep(200, 1200);
  end;


  //以下が本体コード
  AStopWatch := TStopwatch.StartNew;
  FTimeValue := SpinEdit1.Value;

  while True do begin
    //FTimeDisの値は秒
    FTimeDis := FTimeValue - AStopWatch.ElapsedMilliseconds div 1000;
    Amin     := FTimeDis div 60;
    Asec     := FTimeDis - Amin * 60;

    TThread.Synchronize(TThread.CurrentThread, Sync);

    if flgStop       then break;
    if FTimeDis <= 0 then break;

    //これがないとCPU使用率が跳ね上がる
    Sleep(1);
  end;

  //上の処理が終了したら...
  TThread.Synchronize(TThread.CurrentThread, SyncEnd);
end;

//=============================================================================
//  CreateAnonymousThreadでスレッドを作成して実行
//  タイマーの起動や時間経過の監視はスレッドで行う
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  flgStop := False;

  TThread.CreateAnonymousThread(TimerThreadProc).Start;
  //スレッドなので，この下の行のコードがすぐに実行される
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  flgStop := True;
end;



06_システムタイマー等の分解能の調査


上の表でタイマー関係の関数を紹介していますが，これらの精度の目安とな分解能を調査するためのプログラムです．ここで調べた値以上の精度を得ることはできません．利用する時は，この値の「ゆらぎ」「バラツキ」を考慮する必要があります．


図7
設計時画面
図8
実行結果
  • Windows 9X 系では，システムタイマーの分解能が 50 ms という時代があった
  • パフォーマンスカウンタの分解能は，システムによって異なる

リスト8
システムのタイマー類の分解能の調査 
unit TimerResolutionUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MMSystem;

{$R *.DFM}

//=============================================================================
//  システムのタイマー類の分解能の調査
//
//  timeGetDevCapsの使用にはusesにMMSystemが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  lpTimeAdjustment        : Cardinal;
  lpTimeIncrement         : Cardinal;
  pTimeAdjustmentDisabled : LongBool;
  AtimeCaps               : TIMECAPS;
  liFrequency             : Int64;
begin
  LabeledEdit1.Text := '';
  LabeledEdit2.Text := '';
  LabeledEdit3.Text := '';

  //システムタイマーの分解能
  if GetSystemTimeAdjustment(lpTimeAdjustment,
                            lpTimeIncrement,
                            pTimeAdjustmentDisabled) then begin
    LabeledEdit1.Text := IntToStr(lpTimeIncrement div 10000) + ' ミリ秒';
  end;

  //マルチメディアタイマーの分解能
  if timeGetDevCaps(@AtimeCaps, SizeOf(ATimeCaps)) = TIMERR_NOERROR then begin
    LabeledEdit2.Text := IntToStr(AtimeCaps.wPeriodMin) + ' ミリ秒';
  end;

  //高分解パフォーんスカウンタの分解能
  if QueryPerformanceFrequency(liFrequency) then begin
    LabeledEdit3.Text :=
               FormatFloat('#0.000000', 1000000.0 / liFrequency) + ' マイクロ秒';
  end;
end;

end.



07_システムタイマーとマルチメディアタイマーの精度確認テスト


実際のシステムタイマーとてマルチメディアタイマーの精度テストです．計測時間は 50 ミリ秒とし，それを 100 回繰り返します．
結果は，当然ですが，テストするシステムによって違う場合があります．


図9
設計時画面
図10
システムタイマーの結果
  • 設定値の 50 ms に対してバラツキが大きい
図11
マルチメディアタイマーの結果
  • 全て，設定値の 50 ms になり，精度が高いことが分かる

リスト9
システムタイマーとマルチメディアタイマーの精度確認テスト 
unit TimerResolutionTestUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MMSystem;

{$R *.DFM}

//=============================================================================
//  システムタイマーの精度テスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i         : Integer;
  StartTime : DWORD;
begin
  Memo1.Clear;
  Memo1.Update;
  Memo1.Lines.BeginUpdate;

  for i := 0 to 99 do begin
    StartTime := GetTickCount;
    Sleep(50);
    Memo1.Lines.Add(FormatFloat('#####', GetTickCount - StartTime));
  end;
  Memo1.Lines.EndUpdate;
end;

//=============================================================================
//  マルチメディアタイマーの精度テスト
//
//  timeGetTimeの使用にはusesにMMSystemが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  i         : Integer;
  StartTime : DWORD;
begin
  Memo1.Clear;
  Memo1.Update;
  Memo1.Lines.BeginUpdate;

  for i := 0 to 99 do begin
    StartTime := timeGetTime;
    Sleep(50);
    Memo1.Lines.Add(FormatFloat('#####', timeGetTime - StartTime));
  end;
  Memo1.Lines.EndUpdate;
end;

end.



08_経過時間をリアルタイムに表示


ここまでのタイマーのサンプルでは，残り時間を秒単位で表示していました．
これを，経過時間を表示するようにするサンプルです．ミリ秒まで表示するようにしてます．実行すると表示が目まぐるしく変わるので，いかにも計測しているような感じになります．
サンプルの動作は，ストップウォッチとなっています．


図12
実行時画面

リスト10
経過時間をリアルタイムにミリ秒まで表示 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Diagnostics;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    flgStop : Boolean;
    TimerThread : TThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  CreateAnonymousThreadでスレッドを作成して実行
//  タイマーの起動や時間経過の監視はスレッドで行う
//
//  TStopWatchの使用には，usesにDiagnosticsが必要
//  TThread.Synchronizeは不要かも知れない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AStopWatch : TStopWatch;
  TimeNow    : Int64;
  TempTime   : Int64;
  Ahour      : Integer;
  Amin       : Integer;
  Asec       : Integer;
  Amilli     : Integer;
begin
  Button1.Enabled := False;

  if Assigned(TimerThread) then begin
    flgStop := True;
    TimerThread.Terminate;
    FreeAndNil(TimerThread);
  end;

  flgStop := False;
  TimerThread := TThread.CreateAnonymousThread(
    procedure()
    begin
      AStopWatch := TStopwatch.StartNew;

      while True do begin
        //TimeNowの値はミリ秒
        TimeNow := AStopWatch.ElapsedMilliseconds;
        //60min * 60sec * 1000millisec
        TempTime := 60 * 60 * 1000;

        Ahour  := TimeNow div TempTime;
        Amin   := (TimeNow mod TempTime) div (1000 * 60);
        Asec   := (TimeNow mod (1000 * 60)) div 1000;
        Amilli := (TimeNow mod 1000);

        TThread.Synchronize(TThread.CurrentThread,
          procedure
          begin
            Panel1.Caption := Format('%2d 時間 %2d 分 %2d 秒 : %4d ',
                                     [Ahour, Amin, Asec, Amilli]);
            Panel1.Update;
          end
        );

        if flgStop then break;

        //これがないとCPU使用率が跳ね上がる
        Sleep(1);
      end;

      //上の処理が終了したら...
      TThread.Synchronize(TThread.CurrentThread,
        procedure
        begin
          Button1.Enabled := True;
          Windows.Beep(200, 1200);
        end
      );
    end
  );
  TimerThread.FreeOnTerminate := False;
  TimerThread.Start;
end;

//=============================================================================
//  タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  flgStop := True;
end;

end.



09_経過日時 ( 経過年数・経過月数 ) の計算


上のサンプルで経過時間を表示しましたが，経過年数，経過月数となると少し面倒です．
1 日は 24 時間ですから，経過日数だけなら比較的簡単です．月数は，月によって日数が異なります．また，うるう年も考慮しなければなりません．これまでのサンプルでは，システム関係の値を元にして経過時間を計算していました．年月を扱うには TDateTime 型を使用した方が便利です．

経過年月日の計算には，拙作の [元号選択式日付時刻入力コンポーネント] 内の年齢計算の関数のコードを改変して使用しています．この関数部分だけを別ユニットにしています．
下のサンプルは，このユニットを利用して，経過年数と経過月数，経過日数を計算しています．
本サンプルは，年月まで設定する場合のタイマーの参考コードということになります．



[備考 1]
DateUtils ユニットの YearsBetween は，1 年を 365.25 日として計算します．MonthsBetween は１か月を 30.4375 日として計算します．


[備考 2]
多くの科学技術計算では，1 年を 365 日で計算してもほとんど問題ありません．例えば 1 万年での誤差は 7 年程度です．1 万年の 7 年ですから誤差の範囲内と考えられます．1 年を 365.25 日で計算すれば，1 万年での誤差は 多くても 25 日です．



図13
設計時画面
図14
うるう年の場合の計算例
  • 対象は 3 月 1 日だが，24 時間経っていないので，１か月と 28 日と 19 時間経過となる
図15
24 時間以上経過した場合
  • 2 か月経過したことになる
  • これは，1 か月と 29 日経過と同じ

下図はうるう年ではない場合です．
2 月の最終日は 28 日なので，経過日数は 27 日となっています．24 時間以上経過すると 2 か月以上経過したことになります．これは，1 か月と 28 日経過と同じです．


図16
うるう年ではない場合の計算例
図17
24 時間以上経過すると 2 か月後となる

リスト11
経過日時 (経過年数・経過月数) を計算する 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    DateTimePicker3: TDateTimePicker;
    DateTimePicker4: TDateTimePicker;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses plGetAge, DateUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  全てオブジェクト・インスペクタで設定可能
//  TDateTimePickerは，年月日と時刻の設定は別
//  KindプロパティがdtkDateの時は年月日
//  Kindプロパティがdtktimeの時は時刻となる
//  年月日と時刻を同時に表示できるが，編集できても，結果として値を取得できない
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DateTimePicker1.Date   := StrToDate('2000/01/01');
  DateTimePicker1.Kind   := dtkDate;
  DateTimePicker1.Format := 'yyyy/MM/dd';

  DateTimePicker2.Time   := StrToTime('10:00:00');
  DateTimePicker2.Kind   := dtkTime;
  DateTimePicker2.Format := 'H:mm:ss';

  DateTimePicker3.Date   := Trunc(Now);
  DateTimePicker3.Kind   := dtkDate;
  DateTimePicker3.Format := 'yyyy/MM/dd';

  DateTimePicker4.Time   := Frac(Now);
  DateTimePicker4.Kind   := dtkTime;
  DateTimePicker4.Format := 'H:mm:ss';

  Panel1.Font.Name := 'ＭＳ ゴシック';
  Panel1.Font.Size := 10;
end;

//=============================================================================
//  経過日時(経過年数・経過月数)を計算
//  日時の設定はTDateTimePickerを使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  StartDateTime : TDateTime;
  EndDateTime   : TDateTime;
  AYear         : Integer;
  AMonth        : Integer;
  ADays         : Integer;
  ADecodeHour   : WORD;
  ADecodeMin    : WORD;
  ADecodeSec    : WORD;
  ADecodeMilli  : WORD;
  TimeBetween   : TDateTime;
begin
  AYear  := 0;
  AMonth := 0;
  ADays  := 0;
  ADecodeHour  := 0;
  ADecodeMin   := 0;
  ADecodeSec   := 0;
  ADecodeMilli := 0;

  //このStartDateTimeからEndDateTiemまでの経過日時を計算する
  StartDateTime := Trunc(DateTimePicker1.Date) + Frac(DateTimePicker2.Time);
  EndDateTime   := Trunc(DateTimePicker3.Date) + Frac(DateTimePicker4.Time);

  if StartDateTime < EndDateTime then begin

    //最初の時刻が大きい場合は，まだ1日経過していないので前日とする
    if Frac(DateTimePicker2.Time) > Frac(DateTimePicker4.Time) then begin
      EndDateTime := DateUtils.IncDay(EndDateTime, -1);
    end;

    //経過年月日を計算
    plGetAge.GetAge(StartDateTime,
                    EndDateTime,
                    AYear,
                    AMonth,
                    ADays,
                    False);

    //経過時間を算出して，時，分，秒に分解
    TimeBetween := EndDateTime - StartDateTime;
    DecodeTime(TimeBetween, ADecodeHour, ADecodeMin, ADecodeSec, ADecodeMilli);
  end;

  //結果を表示
  Panel1.Caption := IntToStr(AYear)  + '年 '
                  + IntToStr(AMonth) + '月 '
                  + IntToStr(ADays)  + '日 '
                  + IntToStr(ADecodeHour)  + '時間 '
                  + IntToStr(ADecodeMin)   + '分 '
                  + IntToStr(ADecodeSec)   + '秒 経過 ';
end;

end.


リスト12
経過年数，経過月数，経過日数を計算する関数のコード
通常の年齢計算にも利用可能		 
function GetAge(Date1, Date2: TDateTime; var gAge, gMonth, gDays: Integer;
  CountDown: Boolean): Boolean;
var
  Year1  : WORD;
  Month1 : WORD;
  Day1   : WORD;
  Year2  : WORD;
  Month2 : WORD;
  Day2   : WORD;
  Dummy  : WORD;
begin
  Result := True;
  try
    DecodeDate (Date1, Year1, Month1, Day1);
    DecodeDate (Date2, Year2, Month2, Day2);

    if (Day1 > Day2) then Dec(Month2);

    gMonth := Month2 - Month1;
    gAge := Year2 - Year1;
    if (gMonth >= -12) and (gMonth <= -1) then begin
      Dec(gAge);
      gMonth := 12 + gMonth;
    end;
    if gAge < 0 then begin
      Result := False;
      gAge   := 0;
      gMonth := 0;
      gDays  := 0;
    end else begin
      if (Day2 - Day1) < 0 then begin
        if CountDown then begin
          Dummy := DateUtils.DaysInMonth(IncMonth(Date1, 1));
        end else begin
          Dummy := DateUtils.DaysInMonth(IncMonth(Date2, -1));
        end;
        gDays := Dummy + (Day2 - Day1);
      end else begin
        gDays := Day2 - Day1;
      end;
    end;
  except
    Result := False;
    gAge   := 0;
    gMonth := 0;
    gDays  := 0;
  end;
end;



10_日付をまたぐカウントダウンタイマー


上のサンプルに，設定した時間までの残り時間を表示するサンプルがあります．このような機能をカウントダウンタイマーと言うことがあります．そのサンプルでは，一定の時間を設定していますから，残り時間は単なる減算 (引き算) で計算できます．

これが，もし，日付や時刻の場合は少々面倒です．同じ日の，1 日以内であれば比較的簡単に残り時間を計算することができますが，日付をまたぐ場合が面倒です．
単に時刻の比較だけでは負の値になってしまうことがあります．また，年月日で表示するとなると閏年等も考慮する必要があります．
本ページの 2014年07月21日の更新当時は，2020 年開催の東京オリンピックが話題になっていました．その東京オリンピックの開会式は，2020年7月24日 20時00分00秒と決まっています．そこで，開会式までのカウントダウンタイマーを作ってみました．
ソースコードは ZIP 書庫内にあります．



[備考]
東京オリンピックの開催は 2020年3月，開催日が 2021年7月23日に延期になりました．
「東京オリンピック 2020」と言う呼称はそのまま使われることになっています．


図18
カウントダウンタイマーの例