再入防止のためにイベントハンドラを別メソッドでラップするには？
解決キーを連続して叩くなどでのイベントハンドラへの再入を防止するために
通常は、
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
StringGrid1.OnSelectCell:=nil;
try
...//処理
finally
StringGrid1.OnSelectCell:=StringGrid1SelectCell;
end;
end;
などと書くと思うのですが、いちいちすべてのイベントハンドラに上記のような
コードを入れるのは手間なので、フォームのCreate時に全てのイベントハンドラに対して
上記処理でラップしたいのですが、うまくいきません。
//やりたいこと
procedure TForm1.FormCreate(Sender: TObject);
begin
for i:=0 to ComponentCount - 1 do begin
WrapEventHandlersToAvoidReEntrant(Components[i]);
end;
end;
procedure TForm1.WrapEventHandlersToAvoidReEntrant(c: TComponet);
begin
//設定されているすべてのイベントハンドラを再入防止の処理でラップする
//（ここは本当はOn〜という名前のプロパティの型と、それがnilかどうかを動的に調べたい）
c.OnClick:=GetWrappedEventHandler(c.OnClick);
end;
//以下は多分イベントの型ごとに必要？
function TForm1.GetWrappedEventHandler(e: TNotifyEvent):TNotifyEvent;
begin
Result:=...;
end;
function TForm1.GetWrappedEventHandler(e: TKeyEvent):TKeyEvent;
begin
Result:=...;
end;
あるMLの過去ログで調べたのですが、PropInfo やTMethod などを使えばいいのかなと
思いつつ、いろいろ試行錯誤して結局できませんでした。
どなたかアドバイスありましたらよろしくお願いします。。。
イベントハンドラの中で明示的に
Application.ProcessMessages;
などのメッセージ処理をしない限り再入はありえないと思います。
キー入力は一つののハンドラが終わるまでキューで待っています。
ですから再入はないです。連続して実行されることはありますけど。
その場合はイベントハンドラで nil 指定して、出るとき再設定して
も無意味ですけど。
Application.ProcessMessagesはしていませんが、イベントハンドラから
時間のかかる処理を呼ぶなどした場合やはり再入が起こって
しまいます。。。
具体的にはStringGrid内でRetuneキーを押したら、
StringGrid.Col:=NextColというように選択セルを移動します。
そのときSelectCellイベントが起きますが、その中でDBアクセスします。
Returnキーを素早く連続で押すと再入が起こります。
以下はそのときの様子です。
KeyDown start （1回目のReturnキー押下。Col:=Col+1する）
SelectCell start
KeyDown start （2回目のReturnキー押下。素早く押すと発生）
SelectCell start
SelectCell end
KeyDown end
SelectCell end
KeyDown end
なるほど、きっと DB では、アプリが固まらないようにメッセージ処理をしている
んですね。だから再入がおこると。
うーん、でも、全てのハンドラに nil と再設定するのはオススメできません。
再入が疑われるところだけにするのがオススメです。一括でラップする方法は
思い浮かびません。
大抵のコンポのイベントにある OnKeyDown の引数には var Key: Word;
があります。
if Flag then Key := 0;
のように Key に ０ を代入するとキー入力はなかったことにできます。
また、 TStringGrid の OnSelectCell イベントには、var CanSelect: Boolean
がありますから、これを false にするとフォーカスは移りません。
ですから、Flag:Boolean のような変数を宣言しておけば、適切に再入防止が
できると思います。
フラグを使う等の方法も使っていましたが、少し違う方法で
やってみたいと思いまして。
それに再入防止目的だけでなく、「イベントハンドラをラップ」できれば
他の事にも応用できると思ってどうしたら実現できるのかなと考えていたのです。
（Delphiのリフレクション操作に関するいい情報が見つからなくて、ここに投稿した次第です）
引き続きアドバイス募集中です。よろしくお願い致します。。
procedure OnEventNil
begin
Button1.OnClick := nil;
Button2.OnClick := nil;
Button3.OnClick := nil;
Button4.OnClick := nil;
end;
procedure OnEventNormal
begin
Button1.OnClick := Button1OnClick;
Button2.OnClick := Button2OnClick;
Button3.OnClick := Button3OnClick;
Button4.OnClick := Button4OnClick;
end;
こんなものを用意して
何かのイベントに応じて
呼び出してみたり
プロパティで状態変化を実装して
その際に、OnEventNilやOnEventNormalを呼び出したり
してもいいんじゃないでしょうか。
命名がセンスないのは見過ごしください。
うーん、一括してnilにしたりセットしたりする必要性はあまりないです。
それにそれらを呼び出したりプロパティの状態をセットしたりするコードを
あちこちに書くのがいやなので1回で済ませたいと思っているのです。
フォームCreate時に
for i:=0 to ComponentCount - 1 do begin
WrapEventHandlersToAvoidReEntrant(Components[i]);
end;
この3行で全部済む！というのが理想なんですけど。。。
回答に礼をしない人がいる・・・
すみません、解決時点でまとめてお礼すればよいかなと思っていました。
（りおりおさん、Fusaさん、回答ありがとうございます）
TButton の OnClick だけですが、イベントハンドラのラップということで
procedure WrapEventHandlersToAvoidReEntrant(AOwner: TComponent);
var
I: Integer;
C: TComponent;
B: TButton;
begin
for I := 0 to AOwner.ComponentCount - 1 do
begin
C := AOwner.Components[I];
if (C is TButton) then
begin
B := C as TButton;
if (not Assigned(B.Action)) then
begin
B.Action := TBasicAction.Create(C);
B.Action.OnExecute := B.OnClick;
end;
B.OnClick := Form1.WrapEventHandler;
end;
WrapEventHandlersToAvoidReEntrant(C);
end;
end;
procedure TForm1.WrapEventHandler(Sender: TObject);
begin
if (Sender is TButton) then
begin
if (Tag <> 0) then
Exit;
Tag := 1;
try
TButton(Sender).Action.Execute;
finally
Tag := 0;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WrapEventHandlersToAvoidReEntrant(Self);
end;
procedure TForm1.Button1Click(Sender: TObject);
procedure Delay(MS: DWORD);
var
T: DWORD;
begin
T := GetTickCount;
while (GetTickCount - T < MS) do
begin
Application.ProcessMessages;
Sleep(1);
end;
end;
begin
Memo1.Lines.Add('Start');
Delay(1000);
Memo1.Lines.Add('End');
end;
TBasicActionですか、使ったことがないので勉強します。
（上記サンプルでラップできてるのかどうかちょっとよく分かりませんでした。。。MemoにStart...(しばらく待った後)...Endとは出たのですが。）
面白そうなので作ってみました。 長いけど勘弁。
// オリジナルのイベントを保持するクラス
type TEventWrapper = class
private
_OriginalEvent : TMethod;
//とりあえず今回はSelectCellだけ。
procedure OnSelectCell(Sender: TObject; ACol, ARow: Longint;
var CanSelect: Boolean);
public
constructor Create(orig : TMethod);
class function WrapSelectCell(c : TComponent) : TEventWrapper;
end;
{ TEventWrapper }
constructor TEventWrapper.Create(orig: TMethod);
begin
_OriginalEvent := orig;
end;
//ラップしたいイベントの数だけ同じようなメソッドを作る
procedure TEventWrapper.OnSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var
m : TSelectCellEvent;
begin
m := (Sender as TStringGrid).OnSelectCell;
try
(Sender as TStringGrid).OnSelectCell := nil;
if Assigned(TSelectCellEvent(_OriginalEvent)) then
TSelectCellEvent(_OriginalEvent)(Sender, ACol, ARow, CanSelect);
finally
(Sender as TStringGrid).OnSelectCell := m;
end;
end;
class function TEventWrapper.WrapSelectCell(c: TComponent): TEventWrapper;
var
pi : PPropInfo;
m : TSelectCellEvent;
begin
Result := nil;
pi := GetPropInfo(c.ClassInfo, 'OnSelectCell');
if Assigned(pi) then
begin
Result := TEventWrapper.Create(GetMethodProp(c, pi));
m := Result.OnSelectCell;
SetMethodProp(c, pi, TMethod(m));
end;
end;
(* つづき *)
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
w : TEventWrapper;
begin
_Wrappers := TObjectList.Create(True);
for i:=0 to ComponentCount-1 do
begin
//これもラップするイベントの数だけ必要
w := TEventWrapper.WrapSelectCell(Components[i]);
if w <> nil then
_Wrappers.Add(w);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
_Wrappers.Free;
end;
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Memo1.Lines.Add('KeyDown Start');
StringGrid1.Col := StringGrid1.Col + 1;
Memo1.Lines.Add('KeyDown End');
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
// testさんの関数を使わせていただきます
procedure Delay(MS: DWORD);
var
T: DWORD;
begin
T := GetTickCount;
while (GetTickCount - T < MS) do
begin
Application.ProcessMessages;
Sleep(1);
end;
end;
begin
Memo1.Lines.Add('SelectCell Start');
Delay(1000);
Memo1.Lines.Add('SelectCell End');
end;
ラップした場合としていない場合のMemo1の内容を比べれば
再入が防止されているのがわかります。
もう少し勉強してみます。
とりあえず解決にします。
書き込みくださったみなさん、どうもありがとうございました。
| ツイート |  |