[ 高精度タイマ ] - Halbow 資料館

Delphi の VCL の TTimer クラスは、API の SetTimer() と KillTimer() をカプセル化したコンポーネントである。通常の人間の感覚で「一定時間間隔で、ある処理を定期的に繰り返す」という目的には十分な機能を持っている。その精度はおよそ５０ミリ秒である。上記の参照元で議論・検証されているとおり、問題は、最大誤差が５０ミリ秒の揺らぎをもってイベントハンドラが呼び出されることではなく、誤差が一方向に蓄積されることである。したがって、一定時刻間隔でのイベント処理には向いていない。毎日決まった時刻にポップアップウィンドウを表示するとか、即席ラーメンタイマをつくるとかの用途には TTimer は十分な性能を持っているが、ゲームや計測などではより高精度なタイマが必要になるときもあるだろう。ここではこのような用途に使えるマルチメディアタイマについて調べることにする。

マルチメディアタイマは Delphi の MMSystem.pas でインポートされる timeSetEvent() と timeKillEvent() を使って実現できる。

第一パラメータ uDelay には、時間間隔をミリ秒単位で設定する。TTimer の Interval と同じである。uResolution には「精度」をミリ秒単位で指定する。小さい値の方が精度がよいが CPU パワーがその分消費される。ゼロが最も高精度になる。lpFunction には、カウントアップしたときに呼び出されるコールバック関数を指定する。

uTimerID には、このタイマをインストールした timeSetEvent( ) の戻り値が設定されている。uMessage と dw1, dw2 は現在の実装では使われていない。dwUser は、timeSetEvent( ) で設定した dwUser の値がそのまま渡される。

timeSetEvent( ) の uFlags には、以下の定数のどちらか一つを設定できる。

ここでは TTimer 相当の機能を使いたいので uFlags には TIME_PERIODIC を設定するだけでよい。timeSetEvent( ) の戻り値 MMRESULT 型は、

を実行する。唯一のパラメータには、timeSetEvent( ) の戻り値を設定する。

それではさっそく試してみよう。ボタンを２つ、ラベルを２つ、TTimer を一つ、Form1 に配置して以下のようにする。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  MMSystem;

var 
  mmResult:UINT;
  StartTime:DWORD;
  Count1,Count2:UINT;

procedure TForm1.FormCreate(Sender: TObject);
begin

  Timer1.Enabled := false;
  Timer1.Interval := 200;
end;

procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD);stdcall;
var
  Interval:UINT;
  Average:Single;
begin
  Interval := timeGetTime-StartTime;
  Inc(Count1);
  Average := Interval / Count1;
  Form1.Label1.Caption := Format('%d : %d  Average = %.2f',[Count1,Interval,Average]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Count1 := 0; Count2 := 0;
  timeBeginPeriod(1);
  mmResult := TimeSetEvent(200,0,@TimeCallBack,1234,TIME_PERIODIC);
  Timer1.Enabled := true;
  StartTime := timeGetTime;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  timeKillEvent(mmResult);
  Timer1.Enabled := false;
  timeEndPeriod(1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Interval:UINT;
  Average:Single;
begin
  Interval := timeGetTime-StartTime;
  Inc(Count2);
  Average := Interval / Count2;
  Label2.Caption := Format('%d : %d  Average = %.2f',[Count2,Interval,Average]);
end;

end.

Button1 を押すと、タイマがスタートし、Label1 にはマルチメディアタイマのカウント回数とそこまでの累積時間とそれをカウント数で割った平均時間間隔が表示される。同様に、Label2 には TTimer の結果が示される。適当なところで Button2 を押してタイマを停止させる。結果は、右図のようになる。TTimer に比べると Label1 に表示されたマルチメディアタイマの正確さが分かるだろう。上記リスト中の timeBeginPeriod() と timeEndPeriod() は、ウィンドウズがスタートしてからの時間をミリ秒単位で返す timeGetTime 関数の精度を決めるものである。Win95,98,Me では、この関数の実行とかかわりなく精度は１ミリ秒になっている。WinNT,2000,XP では、ちゃんと精度を設定する必要がある。

TTimer は、タイマがカウントアップするたびに WM_TIMER メッセージをそのタイマをインストールしたスレッドのキューにポストする。したがって、メッセージ処理の結果として OnTimer イベントハンドラの呼び出しは、自動的にスレッドの処理順序にたいしてシリアル化されている。上記のテストプログラムでもカウント動作中に Form1 の最小化・復帰を繰り返してメッセージ処理を忙しくすると、精度が急に悪化することを確かめることができる。これに対して、マルチメディアタイマのカウントアップ動作は精度を保つため別のスレッドを作って行われている。したがって、コールバック関数は別スレッドで実行される、と見なすことができる。このことは、ＶＣＬがスレッドセーフであることを保証していないので重大な結果を招くかも知れない。たとえば、メインスレッドとタイマのコールバック関数が、ともに同じ Label1.Caption を変更するような場合、一般に、Label1 に表示される文字列を予測することはできなくなる。VCL のクラスによっては、別スレッドからのアクセスによって動作が不安定になることも考えられる。これを防ぐにはどうしたらよいだろうか。すべてのクラスに対してコードで同期をとることは事実上不可能であるので、メインスレッドのメッセージ処理機構に割り込んで処理をシリアル化することで解決しよう。これにより、実際に処理コードが実行されるタイミングの時間精度が損なわれるが、TTimer のようにキューにポストするのではなく、SendMessage() で同期処理としてよびだすことにしよう。そうすると、メッセージループが回ると最優先で実行されることが期待できる。しかし、メインスレッドが忙しくてメッセージに応答できずに次のカウントアップが起こる、という自体があり得る。そうすると SendMessage() で処理の終了を待っているスレッドは凍り付く。これを防ぐため、Interval で設定された時間の９割が経過するまで待つ、という仕様にしよう。そうすると処理待ち中のカウントアップは防止できる。それには SendMessage() の代わりに

を使う。lParam までは、SendMessage() と同じである。fuFlags には以下の定数のいくつかを設定できる。

uTimeout には、処理待ちの最大待ち時間をミリ秒で設定する。lpdwResult は、処理先からのメッセージ処理の結果を受け取る。SendMessageTimeout() は成功するとゼロ以外の値を返す。これを使って、設定された時間間隔の９割が経過するまで待つ、という仕様にすると、メッセージ処理中に Application.ProcessMessages を実行したり、ShowMessage() や Form2.ShowModal などでモーダルループが実行されるなどのメッセージ処理が行われると、処理が終わらないうちに次のカウントアップが起こってイベントハンドラに再入がおこる、という事態は回避できるが、SendMessageTimeout() で送られたメッセージの処理に上記のようなメッセージループが回るような処理をしてはいけない、という制約がつくことになる。まぁ、普通は、再入が起こるようなコードは TTimer を使う場合でも避けるべきである。

それでは試してみよう。Form1 にボタンを２つとラベルを二つ置いて以下のようにする。

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    procedure WMTimer(var Msg:TMessage);message WM_TIMER;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses 
  MMSystem; 

var 
  mmResult:UINT;
  StartTime:DWORD;
  Count:UINT;

procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD);stdcall;
var
  Result: DWORD;
begin
  Result := 0;
  SendMessageTimeOut(Form1.Handle,WM_TIMER,dwUser,0,SMTO_ABORTIFHUNG,90,Result);

  if Result <> 3333 then begin
    timeKillEvent(mmResult);
    timeEndPeriod(1);
  end;
end;

procedure TForm1.WMTimer(var Msg:TMessage);
var
  Interval:UINT;
  Average:Single;
begin
  Interval := timeGetTime-StartTime;
  Inc(Count);
  Average := Interval / Count;
  Label1.Caption := Format('%d : %d  Average = %.2f',[Count,Interval,Average]);

  Label2.Caption := IntToStr(Msg.WParam);
  Sleep(Random(50));
  Msg.Result := 3333;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Count := 0;
  timeBeginPeriod(1);
  mmResult := timeSetEvent(100,0,@TimeCallBack,1234,TIME_PERIODIC);
  StartTime := timeGetTime;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  timeKillEvent(mmResult);
  timeEndPeriod(1);
end; 

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

end.

実行すると右図のようになる。Button1 を押すとタイマがインストールされ、Label1 には前と同じ表示が現れる。Label2 では、TimeSetEvent() で設定した dwUser の値がちゃんとメッセージハンドラまで届けられていることを確認できる。メッセージは Form1 に WM_TIMER として送っている。ここでは、重い処理の代わりに Sleep(Random(50)) を実行して、５０ミリ秒までのランダムな時間でメインスレッドを眠らせ、その分だけ応答を遅らせている。これを Sleep(Random(100)); とか Sleep(Random(200)); にしたらどうなるだろう。SendMessageTimeOut( ) の待ち時間を９０ミリ秒にしているので、途中で勝手に止まってしまうだろう。これは、タイムアウトが起こって、本来ならば 3333 の戻り値であるはずが、そうならなくて自動的にタイマをアンインストールしているからである。再入が起こってややこしいことになるよりも、タイマを止める方をここでは選んだ。くれぐれも待ち時間より時間がかかる処理はしないように。

最後に、以上の機能を TTimer の実装をまねしてコンポーネントにしてみよう。以下に全リストを示す。

unit MMTimerUnit;

interface

uses
  Windows, Messages,MMSystem,Forms,Classes;

type
TMMTimer = class(TComponent)
private
  FEnabled:Boolean;
  FInterval:Cardinal;
  FWaitTime:Cardinal;
  FOnTimer: TNotifyEvent;
  FWindowHandle:HWND;
  FTimerID:DWORD;
  procedure SetEnabled(value:Boolean);
  procedure SetInterval(value:Cardinal);
  procedure SetOnTimer(Value:TNotifyEvent);
  procedure WndProc(var Msg:TMessage);
  procedure UpdateTimer;
protected
  procedure Timer;virtual;
  procedure OnCallTimer;
public
  constructor Create(AOwner:TComponent);override;
  destructor Destroy;override;
published
  property Enabled:Boolean read FEnabled write SetEnabled;
  property Interval:Cardinal read FInterval write SetInterval default 1000;
  property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
end;

procedure Register;

implementation

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

constructor TMMTimer.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FInterval := 1000;
  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor TMMTimer.Destroy;
begin
  Enabled := false;
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TMMTimer.WndProc(var Msg:TMessage);
begin
  case Msg.Msg of
    WM_TIMER:begin
      try
        Timer;
      except
        Application.HandleException(Self);
      end;
      Msg.Result := 3333;
    end;
  else
    Msg.Result := DefWindowProc(FWindowHandle,Msg.Msg,MSg.WParam,Msg.LParam);
  end;
end;

procedure TMMTimer.OnCallTimer;
var
  Result:DWORD;
begin
  Result := 0;
  SendMessageTimeOut(FWindowHandle,WM_TIMER,0,0,
            SMTO_NORMAL or SMTO_ABORTIFHUNG,FWaitTime,Result);

  if Result <> 3333 then begin
    Enabled := false;
  end;
end;

procedure TimerCallBack(TimerID,Msg:Uint;dwUser,dw1,dw2:DWORD);stdcall;
begin
  TMMTimer(dwUser).OnCallTimer;
end;

procedure TMMTimer.UpdateTimer;
begin
  if FTimerID <> 0 then begin
    timeKillEvent(FTimerID);
    FTimerID := 0;
  end;
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    FTimerID := timeSetEvent(FInterval,0,@TimerCallBack,
                                           DWORD(self),TIME_PERIODIC);
end;

procedure TMMTimer.SetEnabled(value:Boolean);
begin
  if value <> FEnabled then
  begin
    FEnabled := value;
    UpdateTimer;
  end;
end;

procedure TMMTimer.SetInterval(value:Cardinal);
begin
  if value <> FInterval then
  begin
    FInterval := value;
    FWaitTime := Round(value*0.9);
    UpdateTimer;
  end;
end;

procedure TMMTimer.SetOnTimer(value:TNotifyEvent);
begin
  FOnTimer := value;
  UpdateTimer;
end;

procedure TMMTimer.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

end.

ここでは、タイマの別スレッドから呼ばれるコールバック関数をクラスのメソッドにできないので、

のように、dwUser のアプリケーション定義パラメータには自分自身のインスタンスを渡し、コールバック関数では

のように TMMTimer 型にキャストして、これを呼んだインスタンスの OnCallTimer メソッドを呼び出し、そこで SendMessageTimeOut( ) でメインスレッドにメッセージを送っている。あとは前のプログラムと論理は同じである。これをテストするプログラムを以下に示す。MMTimer を一つしか作らない場合は、 Interval に比較して、OnTimer イベントハンドラでの処理時間が短い場合は何の問題もない。問題なのは、複数のインスタンスを作った場合である。おのおのの OnTimer 処理にかかる時間は、その処理中にメッセージ処理をしなければ、メインスレッドでシリアル化しているので、一方の処理が終わるまで OnTimer イベントの呼び出しは待たされる。このことを試してみよう。

右図のように TPanel を二つ、TButton を二つ、TMMTimer を二つ置いて以下のようにする。

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    MMTimer1: TMMTimer;
    MMTimer2: TMMTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MMTimer1Timer(Sender: TObject);
    procedure MMTimer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  MMSystem;

var
  StartTime:DWORD;
  Count1,Count2:UINT;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MMTimer1.Interval := 300;
  MMTimer2.Interval := 400;
  timeBeginPeriod(1);

  Randomize;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  timeEndPeriod(1);
end;

procedure TForm1.MMTimer1Timer(Sender: TObject);
var
  Interval:UINT;
  Average:Single;
begin
  Panel1.Color := TColor(Random($1000000));

  Interval := timeGetTime-StartTime;
  Inc(Count1);
  Average := Interval / Count1;
  Panel1.Caption := Format('%d : %d Average = %.2f',[Count1,Interval,Average]);

  Sleep(Random(50));
end;

procedure TForm1.MMTimer2Timer(Sender: TObject);
var
  Interval:UINT;
  Average:Single;
begin
  Panel2.Color := TColor(Random($1000000));

  Interval := timeGetTime-StartTime;
  Inc(Count2);
  Average := Interval / Count2;
  Panel2.Caption := Format('%d : %d Average = %.2f',[Count2,Interval,Average]);

  Sleep(Random(50));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Count1 := 0; Count2 := 0;
  MMTimer1.Enabled := true;
  MMTimer2.Enabled := true;
  StartTime := timeGetTime;
  Button1.Enabled := false;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  MMTimer1.Enabled := false;
  MMTimer2.Enabled := false;
  Button1.Enabled := true;
end;

end.

実行して、Button1 を押すと二つのタイマがスタートし、Panel の色がランダムに変更される。Panel には経過時間と、呼び出しインターバルの平均値が表示される。各 OnTimer イベントハンドラでは、メッセージ処理をしない重い処理として Sleep(Random(50)); が実行される。刻々と表示される平均インターバルの値を見ていると、定期的にお互いの処理時間が相手のイベント呼び出しを遅らせることが確認できるだろう。そのような場合でも、揺れは次に解消されて、誤差が蓄積しないことも確認できるだろう。

以上、ここではマルチメディアタイマについて簡単に調べた。