SetTimerで、タイマーを作るには？

解決

たかみちえ URL 2002-06-01 06:25:50 No: 957

なんだかTTimerは複数配置できないようで、
コンポーネントではSetTimerで、タイマーを作ることにしたんですけど、
タイマーができ、起動まではするんですけど、中で変数を使おうとすると、
読みこみ違反が起こってしまいます。

対象のウィンドウハンドルは0にして、OSから直接コールバックしてもらうようにしたんですけど、
それでもいいんですよね？

wing 2002-06-01 13:29:53 No: 958

う〜ん、下みたいなコードを作って試してみましたが、エラーは出ませんでした。
どんなコードだったんでしょう？もしかすると、タイマー以外のところでエラーがあるのかもしれません。

ちなみに、このOnTimer関数がいつ呼び出されるのか気になって調べてみたら、Application.ProcessMessage中の、DispachMessageを呼び出したところでOnTimer関数がコールされました。呼び出す直前のMsg構造体のMsgIDを調べたら、WM_TIMER…。
TimerProcを設定しようが、結局メッセージの処理と同様に扱われていて、非同期の呼び出しにはなってないみたいですね。

procedure OnTimer(hwnd : THandle; uMsg,idEvent:integer; dwTime: DWORD); stdcall;
begin
  with Form1 do
  begin
    label1.Caption := IntToStr(Count);
    inc(Count);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
IDTimer := SetTimer(0,0,300,@OnTimer);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
KillTimer(0,IDTimer);
IDTimer := 0;
end;

たかみちえ URL 2002-06-01 17:49:44 No: 959

そうですかぁ、
わたしは
TimerID := SetTimer(0,1,mScrollDelay,@TMarqueeControl.TimerProc);
(mScrollDelayには100が入ってます)
でタイマーを作り、
KillTimer(0,TimerID);
で削除してます。

TimerProcは
procedure TMarqueeControl.TimerProc(hWindow:THandle;uMsg,idEvent:integer;dwTime:DWORD);stdcall;
Begin
  if mMarqueeAbled Then
    mPosition := mPosition + mScrollAmount;
  InvaliDate;
end;
としました。
いかにもwingさんのと違っておかしいと思うのは、
TMarqueeControl.TimerProcなんですけど、
TMarqueeControl.を消すと、変数が必要ですといわれてしまい、コンパイルできないんです。

やっぱりこのへんがおかしいのかなと思うんですけど…。

wing 2002-06-01 19:41:05 No: 960

関数定義が違ってます。
オブジェクトの関数は、第1引数にオブジェクトへのポインタが暗黙的に追加されています。
つまり、
procedure TMarqueeControl.TimerProc(hWindow:THandle;uMsg,idEvent:integer;dwTime:DWORD);stdcall;
は、
procedure TimerProc(Self:TMarqueeControl; hWindow:THandle;uMsg,idEvent:integer;dwTime:DWORD);stdcall;
という意味になります。
オブジェクトのメソッドで自分のレコードにアクセスできるのは、このSelfがあるためです。

wing 2002-06-01 20:00:00 No: 961

追加です。解決策を提案してなくてすみません…

ということで、たかちみえさんの書かれているような、オブジェクトのレコードにアクセスする必要があるときは、TWinControlから派生したクラスを使って、

procedure TMarqueeControl.OnTimer(var m : TMessage); message WM_TIMER;
で、WM_TIMERメッセージを処理してやればいいかと思います。
ということで、SetTimerはHandleを指定する形式になります。
（調べてないですが、複数のTimerでTimerIDが同じだと動かないとかいう現象が発生するなら、integer(Self)でもTimerIDに指定しておくといいかもしれません）

にしの 2002-06-02 05:14:05 No: 962

スレッドを１つ作って、内部でカウントするようにしてはどうです？
そういえば、海外産のアニメGIFコンポーネントなんかはどうやってるんでしょうかね。

たかみちえ URL 2002-06-02 05:15:16 No: 963

うーん、やっぱりウィンドウハンドルを持たないとタイマーは使えないのでしょうか？
Labelコントロールのメソッドを使っているので、
Labelコントロールをもとに作りたいのですけど…。
Labelコントロールでは、ウィンドウハンドルがないので動かせません。
ぜいたくを言ってしまってすいません。

wing 2002-06-03 08:27:29 No: 964

そうですねぇ…。どうしましょう。

案その1
にしのさんのおっしゃるような、スレッドを作って内部的にカウントする方法を使う。

案その2
Application.ProcessMessagesを使って、メッセージループを横取りしてしまう。やはり内部的なカウントには変わりないですが。

たとえば、
すべてのタイマーを管理するTTimerListクラスをグローバルに作っておいて、
そいつにTimerを追加していくという方法とか。

uses
  MMSystem;
// TTimerList.FTimerList : TList;
// TMultiTimer.FInterval , FCallbackTime : DWORD;
// TMultiTimer.FOnTimer : procedure(sender:TObject;dwTime:DWORD) of object;
procedure TTimerList.Loop;
var
  dwCurrent : DWORD;
  i : integer;
begin
  repeat
    Application.ProcessMessages;

// 現在の時刻
dwCurrent := TimeGetTime;

    // とりあえず総当りで調べてみる。
    for i := 0 to FTimerList.Count-1 do
    begin
      with TMultiTimer(FTimerList[i]) do
      begin
        if FCallbackTime >= dwCurrent then
        begin
          FCallbackTime := dwCurrent + FInterval; // FCallbackTime + FInterval
          if Assigned(FOnTimer) then FOnTimer(Self,dwCurrent);
        end;
      end; // with
    end; // for
  until Application.Terminated;
end;

wing 2002-06-05 08:27:44 No: 965

Application.ProcessMessagesを使ったタイマーのエミュレーションは
http://hb4.seikyou.ne.jp/home/torao/src/timer.lzh
ここのソースを参考にしてみてください。

ハンドルを用いないSetTimerの使用方法ですが、MakeObjectInstanceを使えばできました。

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IDs = 0 then
    IDs := SetTimer(0,0,300,FObjectInstance)
  else
  begin
    KillTimer(0,IDs);
    IDs := 0;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FObjectInstance := Classes.MakeObjectInstance(OnWM_Timer);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Classes.FreeObjectInstance(FObjectInstance);
end;

procedure TForm1.OnWM_Timer(var m: TMessage); // message指令ではなく、単なる関数
begin // lParamが呼び出し時間
label3.Caption := 'Called';
end;

にしの 2002-06-05 23:21:04 No: 966

こんなのを作ってみました。

簡単に説明すると、TTimerのSetTimer部分で、nIDEventが1固定だったのを、Tagを私用するに変更しました。
KillTimerでも、同じくTagを使用するようにしました。

unit SomeTime;

interface

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

type
  TSomeTime = class(TTimer)
  private
    FTag, FOldTag: Cardinal;
    FWindowHandle: HWND;
    procedure SetTag(Value: Cardinal);
    procedure UpdateTimer;
  protected
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Tag: Cardinal read FTag write SetTag;
  end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('System', [TSomeTime]);
end;

{ TSomeTime }
constructor TSomeTime.Create(AOwner: TComponent);
begin
  FTag := 1;
  FOldTag := 1;
  inherited Create(AOwner);
  FWindowHandle := AllocateHWnd(WndProc);
end;
destructor TSomeTime.Destroy;
begin
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TSomeTime.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
      try
        Timer;
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TSomeTime.SetTag(Value: Cardinal);
begin
FTag := Value;
UpdateTimer;
end;

procedure TSomeTime.UpdateTimer;
begin
  KillTimer(FWindowHandle, FOldTag);
  FOldTag := FTag;
  if (Interval <> 0) and Enabled and Assigned(OnTimer) then
    if SetTimer(FWindowHandle, Tag, Interval, nil) = 0 then
      raise EOutOfResources.Create(SNoTimers);
end;

end.

にしの 2002-06-05 23:24:56 No: 967

おや？
よくよくみたら、Timerコンポーネントを複数用意しても動きますね。
TTimerの中で、それぞれがハンドルを持ってますから。
なぜうまくいかないのでしょうか。

たかみちえ URL 2002-06-06 10:19:39 No: 968

ごめんなさい遅れました。
> ハンドルを用いないSetTimerの使用方法ですが、MakeObjectInstanceを使えばできました。
MakeObjectInstance？
聞いたことない名前ですけど、Delphiはずいぶん奥が深そうですね、
ありがとうございました。やってみます。
Application.ProcessMessageは、入力候補に何度やっても出てこないので、
多分コンポーネントの中では使えないんじゃないかなと思うんですけど、
Sleep(1)でいいですよね？

> よくよくみたら、Timerコンポーネントを複数用意しても動きますね。
> TTimerの中で、それぞれがハンドルを持ってますから。
> なぜうまくいかないのでしょうか。
あれ？そうですか…？
わたしは2つTTimerを使ったコンポーネントをおいたら、
片方が動き始めると、もう片方の動きがすごく鈍く(1,2秒に1ピクセルくらいずれたような気がするんですけど…)なってしまい、
Timerのせいだな…と…。
もしかして早とちり…？

にしの 2002-06-06 10:36:02 No: 969

MakeObjectInstanceでなくても、AllocateHWND(うろ覚えですが…)などもありますね。こっちは、ウィンドウハンドルを作成します。

> わたしは2つTTimerを使ったコンポーネントをおいたら、
> 片方が動き始めると、もう片方の動きがすごく鈍く(1,2秒に1ピクセルくらいずれたような気がするんですけど…)なってしまい、
> Timerのせいだな…と…。

ソースを見てみないとなんとも言えません。
TMarqueeControlという名前から察するに、スクロールするラベルでしょうか。
もしかしたら、WM_TIMERとWM_PAINTが、うまく処理されてくれないのかも知れません。
僕がしたテストは、単純にTMemo.Lines.Addするだけでした。
これだと、２つのタイマーは綺麗に動きます。

スレッドで同期させたほうが簡単な気もしますが、複雑な処理が含まれるならお薦めしません。

wing 2002-06-07 06:38:07 No: 970

>MakeObjectInstance？
これは、「Windowsのコントロール」から送られてくるメッセージを「Delphiのオブジェクト」が受けるようにするための関数です。
つまり、返ってくるポインタは、
type
WNDPROC = function(hwnd : THandle; Msg,wParam,lParam:integer):integer;stdcall;
型の関数です。

>わたしは2つTTimerを使ったコンポーネントをおいたら、
>片方が動き始めると、もう片方の動きがすごく鈍く(1,2秒に1ピクセルくらいずれたような気がするんですけど…)なってしまい、
>Timerのせいだな…と…。
>もしかして早とちり…？
そうでもないようです。
Windowsのタイマーですが、正確な同期をとる必要があるときはちょっと工夫が必要なようですね。
タイマーの仕様が、純粋に「Xmsごとに呼び出される」、というものではなく、「OnTimerが処理された直後の時間からXms後にもう一回呼び出す」、というようなもののようです。
試しに、1秒ごとにカウントアップしていくラベルを作ってみてください。
ここでフォームをドラッグしただけで、カウントは一気に遅れてしまいます。
タイマーを使うときはOnTimerイベント中にもう一度正確な時間を取得し、
「その時間にあるべき正しい位置」に描画してやってください。＞何！？

………ってことは、Timerは１つにしておいて、そのOnTimerで定期的に全コントロールを正しい位置に描画したほうがいいのでは？

それから
>Application.ProcessMessage
すみません、Application.ProcessMessagesの間違いです。
必要なユニットは Forms です。
アプリケーションにやってくるすべてのメッセージを処理します。
Sleepは単に「何もしないで待つ」関数で、ちょっと違います。

にしの 2002-06-07 18:24:12 No: 971

> ………ってことは、Timerは１つにしておいて、そのOnTimerで定期的に全コントロールを正しい位置に描画したほうがいいのでは？

Timer１つでもやはり、WM_TIMERを処理するタイミングは、ずれていきますから。後れるのは単純にメッセージ処理が追いついていないからだと思います。
# そのためのApplication.ProcessMessagesですね
OnTimerでは、GetTickCountでタイミングをあわせるとよさそうです。

たかみちえ URL 2002-06-08 00:04:12 No: 972

なんとか問題なくできました。
そのままやると、なぜかみょうにちらついてしまって…。
InvalidateをPaintに変えたらうまくいきました。
ありがとうございます。解決しました。

>タイマーの仕様が、純粋に「Xmsごとに呼び出される」、というものではなく、
>「OnTimerが処理された直後の時間からXms後にもう一回呼び出す」、というようなもののようです。
え？それってVBのタイマーコントロールでならききましたけど…。
Delphiのもそうなんですか？

わたしは別に、今のところ問題になりそうなことはしてませんけど、
いざというときは、注意したほうがよさそうですね。
わたしは、mciで曲の進行状況を調べるときなどは、
1秒ごとではなく、100ミリ秒ごとで調べるようにしてます。
それで前に得た数値と違っていたら、外見を更新…と。

そういえば、VBで、GetTickCountだけでタイマーを作るクラスを公開してる人がいました。
GetTickCountで得た数値が、前回に得た秒数+設定されたインターバルをこすまで
ひたすらDoEvents(Application.ProcessMessages)を繰り返すというものでした。

たしかにそういうふうにすると、処理中はイベントが起こらなくなるものの、
通常使っている範囲では、ずれることがなさそうですね。