複数のペインからなるプログラムで、フォーカスの有無により各ペインのタイトル部の色を変えるには
解決１点質問させてください。
【今作っているプログラムの概要】
・１つのフォーム上で、３つのペインからなるプログラムを作成しています。
・この各ペインには、TMemo，TListView，TTreeViewが張り付けられています。
（タブ式のメモ帳のようなもので、TMemoだけはユーザーの操作によって、
複数生成、削除が可能です。）
・各ペインの上部には、どのペインにフォーカスが当たっているかがわかる
よう、TPanelを細長くしてAlign := alTopの状態で貼り付け、フォーカスが
当たっているときには色をActiveCaption、当たっていないときは色を
InactiveCaptionに設定しています。
【質問】
TMemo、TListView、TTreeViewのOnEnter、OnExitイベントに、それぞれ、
・TitlePanel.Color := clActiveCaption
・TitlePanel.Color := clInactiveCaption
と記述して色を切り替えていますが、TMemoにフォーカスが当たっているとき
にTMemoを削除したり、意図しないエラーダイアログ等が出て、フォーム自体
がフォーカスを失ったりしたときに、色が変わらない場合などがあります。
各コンポーネントがフォーカスを得たとき、失ったときは、きっちりと色を
変えたいです。
これを実現しているプログラムは多いので、もしかしたら定石のような
コーディング方法があるのではないかと思い、ご教示いただきたく質問させて
いただきました。どうぞよろしくお願いいたします。
定石は知りませんが、私ならTApplicationEventsコンポーネントのOnIdleイベントを使います。
この方法は楽なので好きです。
procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
PanelColorChange([TMemo, TListView, TTreeView], [Panel1, Panel2, Panel3]);
end;
procedure TForm1.PanelColorChange(WinCtrls: array of TWinControlClass;
Panels: array of TPanel);
var
I: Integer;
begin
for I:=0 to High(WinCtrls) do
if (Self.ActiveControl is WinCtrls[I])
then Panels[I].Color:=clActiveCaption
else Panels[I].Color:=clInactiveCaption;
end;
実用に供するには、以下のような点について仕様を決め、調整する必要があると思います。
・上記コードはすべてのTMemo／TListView／TTreeViewが対象です。除外したいものがある場合。
・他のコントロール（例えばTButton）にフォーカスがあるときはどうしたいのか。
・どのコントロールにもフォーカスが無い場合はどうしたいのか。
→なお、フォーカスを持つコントロールが無いとき、Self.ActiveControlは nil になります。
正直OnIdleを使用する方法はおすすめできません。
OnIdleはかなりの高頻度でコールされることになりますが、そのほとんどが不必要です。
昨今ではChromeの消費電力が（バグにより）高いということがニュースになるくらいですから、
手抜きのために無駄な負荷をかけるのは極力避けるべきではないかと思います。
と文句だけなら誰でも言えますので簡潔な解決方法を。
TFormにはSetFocusedControlというメソッドがありますので、
これをoverrideすれば簡単にフォーカスの移り変わりが直接分かります。
type
TForm1 = class
protected
function SetFocusedControl(Control: TWinControl): Boolean; override;
end;
function TForm1.SetFocusedControl(Control: TWinControl): Boolean;
begin
Result := inherited; // ←必須です
// ここに任意の処理
end;
このとき、Resultはフォーカスの有無を確実に示すものではないので注意してください。
詳しくはこちらを。
http://docwiki.embarcadero.com/Libraries/XE8/ja/Vcl.Forms.TCustomForm.SetFocusedControl
また、同様の方法としてScreen.OnActiveControlChangeを使う方法もあります。
上記の方法は設定したフォームのコントロールのみが対象なのに対し、
Screen.OnActiveControlChangeはアプリケーションが含む全フォームのコントロールが対象になります。
（Screen.OnActiveControlChange自体はSetFocusedControl内で呼ばれています）
一点訂正を。
protectedではなくpublicでした。
お二人とも、お答えと具体的なコードまでご提示くださり、誠にありがとうございます。
Harry様
盲点でしたが、非常に簡単に記述できて良さそうですね。確かにこれなら必ず希望通りになります。
ただ、この解法で気になる点が２つあります。OnIdleイベントを使うと、Windows7の端末で、一部コンポーネントが消えるとVxEditorの作者様がおっしゃっていたような気がします。（記載が遅れてしまい、大変申し訳なかったのですが、当方の環境はDelphi6Personal + Windows7Proです。）
そのため、少し使用をためらってしまっておりました。
参考URL
http://dr-x.jimdo.com/2009/06/23/windows7/
その部分の引用
「たとえはダイアログを表示しているときにAltキーを押すとコントロールが消えてしまったりしました。これを対策するコードを追加していたのですが、なぜか動いていません。調べてみるとApplication.OnIdleを別の目的で使っていると動作しないようです。」
省電力様
今、実験してみました。Harry様のご提示くださったコードに引けを取らないくらい簡単に記述できました。このScreen.OnactiveControlChangeというイベントは全く知りませんでしたので、非常に感動しました。もうしばらく様子を見て、当方の希望にもっとも合致しそうでしたら、解決マークを付させていただきたいと思います。本当に助かりました。
お2人とも、重ね重ね、いろいろなアイデアをくださり、誠にありがとうございました。本当にうれしく思いました。
１点訂正です。
× この解法で気になる点が２つあります。
○ この解法で気になる点が１つあります。
省電力さんより地球に優しいコード例が示されましたが、OnIdleの濫用によるムダな処理に
ついては私もかなり気にしております。（電力消費量というより主に精神衛生上ですが。）
なので、もう一つ別の観点の話と、ムダな処理をなるべく抑制したコード例、合わせて二つを
追加で投稿しようとしておりました。
ですが、OnIdleの暗部が発覚したり、Screen.OnActiveControlChangeも試されて良好となると、
差し当たっては不要なようなので控えておきます。
省電力さん
今後はOnIdleの使用を封印する勢いで臨んでみたいと思います。
で、ちょっと気になったことが。
＞Result := inherited; // ←必須です
ここは
Result := inherited SetFocusedControl(Control);
のようにしないと、「E2008 互換性の無い型です」が出て、コンパイル不能でした。
（Turbo Delphi Explorer）
risaさん
別の観点の話ですが、かいつまんで。
＞エラーダイアログ等が出て、フォーム自体がフォーカスを失ったりしたときに、色が変わらない場合などがあります
↑これは「正常に動かないことがある」と判断したのですが、続く文と合わせて考えると、
＞各コンポーネントがフォーカスを得たとき、失ったときは、きっちりと色を変えたいです。
↑この動作を絶対忠実に実現することに尽きる、ということだったのか？と気になりました。
だとすると、アプリケーションが非アクティブになった時は各コントロールもフォーカスを
喪失するので、すべてのパネルの色を clInactiveCaption にするのかな、と思いました。
もしそうなら、Application.OnActivate と OnDeactivate も Screen.OnActiveControlChange と
同じイベントハンドラに突っ込んでやれば良いと思います。
（ただし、ActiveControl が Focused かチェックするコードになってれば、ですが。）
現状の動作に満足されているなら、的外れなおせっかいでした、失礼。
Harry様
貴重なご助言、誠にありがとうございます。
おっしゃるとおり、アプリケーションが非アクティブになった時はすべてのパネル
の色を clInactiveCaptionにする、という動作まで実現したかったのですが、確かに
先ほどのコードだけではうまく実現できていないことを確認いたしました。
（簡易的なテストプログラムを作成してテストしたのですが、作り方が少し甘くなってしまっていました。）
当方では、以下の場合にも色を変えたいと思っています。
１ アプリケーションがアクティブ／ディアクティブになったとき
・アクティブの場合は、アクティブペインの色をclActiveCaptionにする。
・ディアクティブの場合は、すべてのペインをclInactiveCaptionにする。
２ 他のダイアログが出てそちらにフォーカスが移ったとき
・すべてのペインをclInactiveCaptionにする。
このうち、まだ試しておりませんが、１の場合はご提示くださった方法で解決
できるように感じます。
２の場合はもうしばらく継続して考え、試行してみたいと思います。
いろいろ考えると、OnIdleというのは非常に簡単ですね。
もちろん、無駄な処理は極力排除したいので、別の方法ももっと追求してみたいと思います。
先ほどはご助言、誠にありがとうございました。
ご助言を踏まえ、以下のコードを実行してみましたところ、なんとなく希望通りの動作になっているようです。
まだ確実ではないのですが、もう少し試行錯誤してみたいと思います。
※フォームに、Panel1、2と、Memo1、2、SpeedButton1の5つを追加し、以下のイベント等を記述しました。
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnActivate := ColorChange;
Application.OnDeactivate := ColorChange;
Screen.OnActiveControlChange := ColorChange;
end;
// 手動で追記したprocedure。
procedure TForm1.ColorChange(Sender: TObject);
begin
Panel1.Color := clInactiveCaption;
Panel2.Color := clInactiveCaption;
// ↓モーダルダイアログが出ているときは、IsWindowEnabledがFalseになることを利用した判別方法。（モーダルでないダイアログを出すときは、別の条件が必要かも。）
if not IsWindowEnabled(Self.Handle) then exit;
if Memo1.Focused then Panel1.Color := clActiveCaption;
if Memo2.Focused then Panel2.Color := clActiveCaption;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Screen.OnActiveControlChange := nil; // これがないとなぜかエラーが起こる？
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
// 前面にダイアログが表示されたときの動作を確認するためのコード。
ShowMessage('');
end;
＞ Screen.OnActiveControlChange := nil; // これがないとなぜかエラーが起こる？
Formの破棄中にもActiveControlに変化が起きていると推測します。そのため、例えばMemo1が
無い状態でColorChangeに突入している、と。 ちなみに自分はOnDestroyに記述してました。
＞ // ↓モーダルダイアログが出ているときは、IsWindowEnabledがFalseになることを利用した判別方法。
＞ if not IsWindowEnabled(Self.Handle) then exit;
いや、ちゃんと Focused をチェックしてるから、この判別は不要だと思うのですが。
＞（モーダルでないダイアログを出すときは、別の条件が必要かも。）
こちらも同様に、判別不要かと。
なぜなら、risaさんの提示した「色を変える条件」は、各コントロールの Focused と完全一致
しているからです。各コントロールの Focused を真正直にチェックし、それに従って対応する
パネルの色を変化させるロジックになっている限り、特に小細工は要らないと思います。
（Self.ActiveControl を利用する場合は、それが Focused であるかチェックすればOKです。）
Harry様
ご回答、誠にありがとうございます。
先ほど、コードを以下のように修正し、実行してみました。
procedure TForm1.ColorChange(Sender: TObject);
begin
Panel1.Color := clInactiveCaption;
Panel2.Color := clInactiveCaption;
// ↓削除
// if not IsWindowEnabled(Self.Handle) then exit;
if Memo1.Focused then Panel1.Color := clActiveCaption;
if Memo2.Focused then Panel2.Color := clActiveCaption;
end;
その結果、モーダルウィンドウでは、期待通りに色が変わりましたが、
モーダルでないダイアログの場合（ShowMessageの代わりにFindDialog1.Execute）、
アクティブペインの色は、clInactiveCaptionに切り替わりませんでした。
アクティブなウィンドウを判定するロジックを組み込むとうまくいきそう
です。各ペインを持つウィンドウがアクティブかどうかを判断するロジック
の実装を考え、また報告させていただきます。
先ほど、FindDialog1を表示させた状態で、フォームとFontDialog1を交互に
クリックして確認してみましたが、このタイミングではそもそも
Screen.OnActiveControlChange
のイベントが起こらず、そのために色が変わらなかったようです。
今のところ、モーダルでないダイアログはすぐには使う予定はないため、
当面は影響ないのですが、せっかくの機会ですので、これもクリアできる
よう、もっと調べてみたいと思います。
＞その結果、モーダルウィンドウでは、期待通りに色が変わりましたが、
ShowMessage のことですよね。FontDialog1 はダメでした…。
＞FindDialog1を表示させた状態で、フォームとFontDialog1を交互にクリックして確認
ん？ 「フォームとFindDialog1を交互にクリック」ですよね？？
＞Screen.OnActiveControlChange のイベントが起こらず、そのために色が変わらなかった
そんな罠があるとはまったく思いも寄りませんでした。
何かうまい方法はないかと考えたのですが、結局のところOnIdleを使うよりも美しくない、
うんこコードしか作れませんでした…。汚いものですが、陳列しておきます。
※フォームにTMemo×2、TPanel×2、TSpeedButton×3、TFindDialog、TFontDialogを置きます。
private
procedure ActiveControlChange(Sender: TObject);
procedure WM_APP_2(var Msg: TMessage); message WM_APP+2;
procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
procedure ColorChange();
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange:=ActiveControlChange;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Screen.OnActiveControlChange:=nil; // 終了時エラー対策
end;
procedure TForm1.ActiveControlChange(Sender: TObject);
begin
Self.ColorChange();
end;
// 自前メッセージを受信したらパネルの色を変更
procedure TForm1.WM_APP_2(var Msg: TMessage);
begin
Self.ColorChange();
end;
// フォームが アクティブ／非アクティブ になるときに来る
procedure TForm1.WMActivate(var Msg: TWMActivate);
begin
inherited;
// この時点ではまだ各コントロールのフォーカスが変化
// してないので、自分に自前メッセージを送信して時間稼ぎ
PostMessage(Self.Handle, WM_APP+2, 0, 0);
end;
procedure TForm1.ColorChange();
const
Colors: array[Boolean] of TColor = (clInactiveCaption, clActiveCaption);
begin
Panel1.Color:=Colors[Memo1.Focused];
Panel2.Color:=Colors[Memo2.Focused];
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
ShowMessage('ShowMessage!'); // 通常のモーダルダイアログ
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
FindDialog1.Execute; // モードレスダイアログ
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
FontDialog1.Execute; // モーダルダイアログ
end;
Application.OnIdle は、（うまく使えば）最強…と思ってたんですが、、、恐ろしいことに
FontDialog1.Execute 後は発生しないことに気付きました。（つまり今回の目的を満たせない。）
これでは上のみっともないコードが最強になってしまう…何とかそれを阻止したかったので
いろいろ探してみますと、WinEvent というのがありました。
この WinEvent、Windows98時代から存在するのですが、なぜかあまり利用されてないような。
SetWinEventHook関数で指定できるイベントの種類は↓こんなにたくさんあるんですが。
http://msdn.microsoft.com/en-us/library/dd318066%28v=vs.85%29.aspx
その中の EVENT_OBJECT_FOCUS を使って、上のサンプルを書き直してみました。
変更点のみ記述。
private
FEventHook: THandle;
FPrevFocusedCtrl: TWinControl;
function GetFocusedCtrl: TWinControl;
procedure ColorChange();
// Screen.ActiveControl はフォーム内のコントロール以外を示す
// こともあるので、不都合なら Self.ActiveControl に変更する
function TForm1.GetFocusedCtrl(): TWinControl;
begin
if Assigned(Screen.ActiveControl) and Screen.ActiveControl.Focused
then Result:=Screen.ActiveControl
else Result:=nil;
end;
procedure WinEventProc(hWinEventHook: THandle; event: DWORD; hwnd: HWND;
idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;
begin
if Form1.GetFocusedCtrl=Form1.FPrevFocusedCtrl then Exit;
Form1.FPrevFocusedCtrl:=Form1.GetFocusedCtrl;
Form1.ColorChange();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FEventHook:=SetWinEventHook(EVENT_OBJECT_FOCUS, EVENT_OBJECT_FOCUS,
0, WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWinEvent(FEventHook);
end;
procedure TForm1.ColorChange();
≪以下同文≫
上の投稿の続編です。
アプリケーション内のフォーカスが移動・消失するとイベントで通知するクラスを作りました。
それを使ったときのサンプルの変更点と、別ユニットでクラス本体を。
usesにFocusWatcherを追加。
private
FFocusWatcher: TFocusWatcher;
procedure FocusChange(Sender: TObject);
procedure ColorChange();
procedure TForm1.FormCreate(Sender: TObject);
begin
FFocusWatcher:=TFocusWatcher.Create;
FFocusWatcher.OnChange:=Self.FocusChange;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FFocusWatcher.Free;
end;
procedure TForm1.FocusChange(Sender: TObject);
begin
Self.ColorChange();
end;
procedure TForm1.ColorChange();
≪以下同文≫
-----------------------------------------------------------------------------
unit FocusWatcher;
interface
uses
Windows, Classes, Controls;
type
TFocusWatcher = class(TObject)
private
FEventHook: THandle;
FEnabled: Boolean;
FFocusedCtrl: TWinControl;
FOnChange: TNotifyEvent;
procedure SetEnabled(Value: Boolean);
procedure WinEventFired();
public
constructor Create();
destructor Destroy(); override;
property Enabled: Boolean read FEnabled write SetEnabled;
property FocusedCtrl: TWinControl read FFocusedCtrl;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
implementation
uses
SysUtils, Forms;
{ TFocusWatcher }
var
InstanceList: TList = nil;
function GetFocusedCtrl(): TWinControl;
begin
if Assigned(Screen.ActiveControl) and Screen.ActiveControl.Focused
then Result:=Screen.ActiveControl
else Result:=nil;
end;
procedure TFocusWatcher.WinEventFired();
begin
if GetFocusedCtrl=Self.FocusedCtrl then Exit;
FFocusedCtrl:=GetFocusedCtrl;
if Assigned(Self.OnChange) then Self.OnChange(Self);
end;
procedure WinEventProc(hWinEventHook: THandle; event: DWORD; hwnd: HWND;
idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;
var
I: Integer;
begin
for I:=0 to InstanceList.Count-1 do
if TFocusWatcher(InstanceList[I]).FEventHook=hWinEventHook
then TFocusWatcher(InstanceList[I]).WinEventFired();
end;
constructor TFocusWatcher.Create;
begin
if not Assigned(InstanceList) then InstanceList:=TList.Create;
InstanceList.Add(Self);
Self.Enabled:=True;
end;
destructor TFocusWatcher.Destroy;
begin
Self.Enabled:=False;
InstanceList.Remove(Self);
if InstanceList.Count=0 then FreeAndNil(InstanceList);
end;
procedure TFocusWatcher.SetEnabled(Value: Boolean);
begin
if FEnabled=Value then Exit;
FEnabled:=Value;
if Value then begin
FFocusedCtrl:=GetFocusedCtrl;
FEventHook:=SetWinEventHook(
EVENT_OBJECT_FOCUS, EVENT_OBJECT_FOCUS, 0,
WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT
);
end else begin
UnhookWinEvent(FEventHook);
end;
end;
返事が遅れ、申し訳ありません。
今、長期の休みで仕事やプログラムから離れておりました。
戻り次第、改めてレスポンスさせていただきたいと思いますが、
さしあたりharry様にお礼を申し上げたく書きこみました。
本当にありがとうございます。後ほど、試させていただきたいとおもいます。
Harry様をはじめとする皆様。返事が遅れ、申し訳ありません。
しばらく、アプリケーションに付加したい機能について、改めて整理しておりました。
結局、モーダルでないウィンドウは、使う可能性はありますが、TFindDialogのような
ものは使わず、使うとしても自前でダイアログを作る方向といたしました。
その前提でテストしなおした結果、ここでご提示いただいた方法だけで良好な
動作をすることを確認いたしました。
Harry様、省電力におかれましては、非常に貴重なご助言をくださり、誠に
ありがとうございました。本当に助かりました。
| ツイート |  |