SetTimerで、タイマーを作るには？
解決なんだかTTimerは複数配置できないようで、
コンポーネントではSetTimerで、タイマーを作ることにしたんですけど、
タイマーができ、起動まではするんですけど、中で変数を使おうとすると、
読みこみ違反が起こってしまいます。
対象のウィンドウハンドルは0にして、OSから直接コールバックしてもらうようにしたんですけど、
それでもいいんですよね？
う〜ん、下みたいなコードを作って試してみましたが、エラーは出ませんでした。
どんなコードだったんでしょう？もしかすると、タイマー以外のところでエラーがあるのかもしれません。
ちなみに、この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;
そうですかぁ、
わたしは
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.を消すと、変数が必要ですといわれてしまい、コンパイルできないんです。
やっぱりこのへんがおかしいのかなと思うんですけど…。
関数定義が違ってます。
オブジェクトの関数は、第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があるためです。
追加です。解決策を提案してなくてすみません…
ということで、たかちみえさんの書かれているような、オブジェクトのレコードにアクセスする必要があるときは、TWinControlから派生したクラスを使って、
procedure TMarqueeControl.OnTimer(var m : TMessage); message WM_TIMER;
で、WM_TIMERメッセージを処理してやればいいかと思います。
ということで、SetTimerはHandleを指定する形式になります。
（調べてないですが、複数のTimerでTimerIDが同じだと動かないとかいう現象が発生するなら、integer(Self)でもTimerIDに指定しておくといいかもしれません）
スレッドを１つ作って、内部でカウントするようにしてはどうです？
そういえば、海外産のアニメGIFコンポーネントなんかはどうやってるんでしょうかね。
うーん、やっぱりウィンドウハンドルを持たないとタイマーは使えないのでしょうか？
Labelコントロールのメソッドを使っているので、
Labelコントロールをもとに作りたいのですけど…。
Labelコントロールでは、ウィンドウハンドルがないので動かせません。
ぜいたくを言ってしまってすいません。
そうですねぇ…。どうしましょう。
案その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;
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;
こんなのを作ってみました。
簡単に説明すると、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.
おや？
よくよくみたら、Timerコンポーネントを複数用意しても動きますね。
TTimerの中で、それぞれがハンドルを持ってますから。
なぜうまくいかないのでしょうか。
ごめんなさい遅れました。
> ハンドルを用いないSetTimerの使用方法ですが、MakeObjectInstanceを使えばできました。
MakeObjectInstance？
聞いたことない名前ですけど、Delphiはずいぶん奥が深そうですね、
ありがとうございました。やってみます。
Application.ProcessMessageは、入力候補に何度やっても出てこないので、
多分コンポーネントの中では使えないんじゃないかなと思うんですけど、
Sleep(1)でいいですよね？
> よくよくみたら、Timerコンポーネントを複数用意しても動きますね。
> TTimerの中で、それぞれがハンドルを持ってますから。
> なぜうまくいかないのでしょうか。
あれ？そうですか…？
わたしは2つTTimerを使ったコンポーネントをおいたら、
片方が動き始めると、もう片方の動きがすごく鈍く(1,2秒に1ピクセルくらいずれたような気がするんですけど…)なってしまい、
Timerのせいだな…と…。
もしかして早とちり…？
MakeObjectInstanceでなくても、AllocateHWND(うろ覚えですが…)などもありますね。こっちは、ウィンドウハンドルを作成します。
> わたしは2つTTimerを使ったコンポーネントをおいたら、
> 片方が動き始めると、もう片方の動きがすごく鈍く(1,2秒に1ピクセルくらいずれたような気がするんですけど…)なってしまい、
> Timerのせいだな…と…。
ソースを見てみないとなんとも言えません。
TMarqueeControlという名前から察するに、スクロールするラベルでしょうか。
もしかしたら、WM_TIMERとWM_PAINTが、うまく処理されてくれないのかも知れません。
僕がしたテストは、単純にTMemo.Lines.Addするだけでした。
これだと、２つのタイマーは綺麗に動きます。
スレッドで同期させたほうが簡単な気もしますが、複雑な処理が含まれるならお薦めしません。
>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は単に「何もしないで待つ」関数で、ちょっと違います。
> ………ってことは、Timerは１つにしておいて、そのOnTimerで定期的に全コントロールを正しい位置に描画したほうがいいのでは？
Timer１つでもやはり、WM_TIMERを処理するタイミングは、ずれていきますから。後れるのは単純にメッセージ処理が追いついていないからだと思います。
# そのためのApplication.ProcessMessagesですね
OnTimerでは、GetTickCountでタイミングをあわせるとよさそうです。
なんとか問題なくできました。
そのままやると、なぜかみょうにちらついてしまって…。
InvalidateをPaintに変えたらうまくいきました。
ありがとうございます。解決しました。
>タイマーの仕様が、純粋に「Xmsごとに呼び出される」、というものではなく、
>「OnTimerが処理された直後の時間からXms後にもう一回呼び出す」、というようなもののようです。
え？それってVBのタイマーコントロールでならききましたけど…。
Delphiのもそうなんですか？
わたしは別に、今のところ問題になりそうなことはしてませんけど、
いざというときは、注意したほうがよさそうですね。
わたしは、mciで曲の進行状況を調べるときなどは、
1秒ごとではなく、100ミリ秒ごとで調べるようにしてます。
それで前に得た数値と違っていたら、外見を更新…と。
そういえば、VBで、GetTickCountだけでタイマーを作るクラスを公開してる人がいました。
GetTickCountで得た数値が、前回に得た秒数+設定されたインターバルをこすまで
ひたすらDoEvents(Application.ProcessMessages)を繰り返すというものでした。
たしかにそういうふうにすると、処理中はイベントが起こらなくなるものの、
通常使っている範囲では、ずれることがなさそうですね。
| ツイート |  |