Delphi Programming / Object Pascal

[掲載 2005年03月25日] [更新 2017年04月12日] Delphi サンプルプログラム集 |
| 256_ローカルフック ( キー・マウス ) |
| 動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
 |
256_LocalHookKeyMouse.zip [3,293 KB] 2017年04月12日版 (EXE 同梱) |
キーとマウス操作のローカルフックと関連するサンプルです。
キーとマウスのローカルフックを使用すると、自アプリのキー操作とマウス操作をフック (捕捉) できるようになります。フックの処理を変更すると、プログラムの処理を変更することができます。
フックは以下の手順で行います。
- (1) SetWindowsHookEx 関数でフックを開始する
- (2) キーフックの場合、何かキーを押すと、コールバック関数が自動で実行される
- (3) このコールバック関数内で、何らかの処理を行う
- (4) フックする必要がなくなったら、UnhookWindowsHookEx 関数でフックを解除する
フックを開始する SetWindowsHookEx 関数では、その引数でコールバック関数を指定します。
コールバック関数は、クラス (本サンプルの場合では TForm1) の関数にはできません。コールバック関数はシステムが直接呼び出して実行する関数だからです。システムは、Delphi のクラス内のメンバーにはアクセスできません。
グローバルフックとローカルフックの違いは、SetWindowsHookEx 関数の引数の違いです。 ローカルフックでは、コールバック等の処理を DLL にする必要はありません。
|
キーやマウスのフックは強力ですが、アクティブなフォームだけのキー操作やマウスの操作を捕捉するのであれば、TApplicationEvents コンポーネントの OnMessage イベントが利用できます。
|
マウスとキー操作のローカルフックの実際のサンプルです。
コールバック関数の引数からマウスの情報やキーコードの情報を取得する方法はグローバルフックでもローカルフックでも同じです。コールバック関数の記事へのリンクを再掲しておきます。
本サンプルでは、コールバック関数の引数のの値をそのままメッセージとして送信し、受信側でそれらの値を取得して処理するようにしています。これらの引数の値は、WM_XXX メッセージの第 1 引数と第 2 引数に相当する値です。MSDN の記事では wParam, lParam となっています。
本サンプルは、単に押下したキーコードの値とマウスカーソルの位置を表示するだけです。
|
[備考]
本サンプルではコールバック関数から PostMessage でメッセージを送信して、そのメッセージを受信して処理しています。
一方、Halbow 資料館のサンプルでは、コールバック関数内で、コールバック関数の引数の値を処理したり、コールバック関数内で TForm の関数やメソッドを実行しています。本サンプルは、メッセージ送受信処理の 1 つのサンプル程度に考えてください。
|
 |
図1
実行時の画面 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
protected
procedure WMApp100(var Message: TMessage); message WM_APP+100;
procedure WMApp110(var Message: TMessage); message WM_APP+110;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
FTargetWnd : HWND;
FMouseHook : HHOOK;
FKeyHook : HHOOk;
//-----------------------------------------------------------------------------
// マウスフックのコールバック関数
// メッセージを送る
//-----------------------------------------------------------------------------
function MouseHookProc(nCode:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
begin
if nCode < 0 then begin
Result := CallNextHookEx(FMouseHook, nCode, wPar, lPar);
end else begin
if nCode = HC_ACTION then begin
PostMessage(FTargetWnd, WM_APP+100, wPar, 0);
end;
Result := CallNextHookEx(FMouseHook, nCode, wPar, lPar);
end;
end;
//-----------------------------------------------------------------------------
// キーフックのコールバック関数
// メッセージを送る
//-----------------------------------------------------------------------------
function KeyHookProc(nCode:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
begin
if nCode < 0 then begin
Result := CallNextHookEx(FKeyHook, nCode, wPar, lPar);
end else begin
if nCode = HC_ACTION then begin
PostMessage(FTargetWnd, WM_APP+110, wPar, lPar);
end;
Result := CallNextHookEx(FKeyHook, nCode, wPar, lPar);
end;
end;
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
const
MSGFLT_ADD = 1;
MSGFLT_REMOVE = 2;
var
DLLHandle : THandle;
FuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
begin
//UIPI(ユーザーインターフェイス特権の分離)対応処理
//このプログラムを管理者権限で実行してもメッセージの受信を可能にする
if CheckWin32Version(6, 0) then begin
DLLHandle := loadLibrary('user32.dll');
try
if DLLHandle > 0 then begin
@FuncFilter := GetProcAddress(DLLHandle, 'ChangeWindowMessageFilter');
if @FuncFilter <> nil then begin
FuncFilter(WM_APP+100, MSGFLT_ADD);
FuncFilter(WM_APP+110, MSGFLT_ADD);
end;
end;
finally
FreeLibrary(DLLHandle);
end;
end;
end;
//=============================================================================
// フォーム破棄の時の処理
// アプリ終了時はフック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
//フック解除
if FMouseHook > 0 then begin
UnhookWindowsHookEx(FMouseHook);
FMouseHook := 0;
end;
if FKeyHook > 0 then begin
UnhookWindowsHookEx(FKeyHook);
FKeyHook := 0;
end;
end;
//=============================================================================
// [StartHook]ボタン
// フック開始
// フック関数をインストール(登録)
//
// FTargetWndはフックしたメッセージを受信するウィンドウハンドル(グローバル変数)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
//フックのメッセージを受信するウィンドウのハンドル
FTargetWnd := Self.Handle;
//マウスとキーのローカルフック開始
FMouseHook:= SetWindowsHookEx(WH_MOUSE,
@MouseHookProc,
0,
GetCurrentThreadId);
FKeyHook := SetWindowsHookEx(WH_KEYBOARD,
@KeyHookProc,
0,
GetCurrentThreadId);
end;
//=============================================================================
// [StopHook]ボタン
// フック関数をアンインストール(登録解除)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FormDestroy(nil);
end;
//-----------------------------------------------------------------------------
// フックしたマウス情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
LMousePos : TPoint;
begin
if Message.WParam = WM_LBUTTONDOWN then begin
GetCursorPos(LMousePos);
//マウスの座標値を表示
if Edit1.Focused then begin
Panel2.Caption := Format('[ X=%.4d Y=%.4d ]', [LMousePos.X, LMousePos.Y]);
end;
end;
end;
//-----------------------------------------------------------------------------
// フックしたキー情報を受取る
//-----------------------------------------------------------------------------
procedure TForm1.WMApp110(var Message: TMessage);
var
LIsDown : Boolean;
LKey : WORD;
LCode : Integer;
begin
//キーが押された時に処理
LIsDown := (Message.LParam and (1 shl 31)) = 0;
if LIsDown then begin
//Shiftキー等を取得する場合
//IsShift := (GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0;
//IsCtrl := (GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0;
//IsAlt := (Message.LParam and (1 shl 29)) <> 0;
//仮想キーコード
LKey := Message.WParam;
//キーコードを表示
if Edit1.Focused then begin
LCode := LKey and $FF;
Panel1.Caption := Chr(LCode) + Format(' %.2d ($%.2x)', [LCode, LCode]);
end;
end;
end;
end.
上のコードでは、コールバック関数からメッセージを受信して、そこでマウスカーソルの位置を取得していますが、コールバック関数の引数にマウスカーソルの位置を与えて送信することもできます。
コールバック関数内で結果を表示するのであれば、例えば次のようなコードとなります。
|
//-----------------------------------------------------------------------------
// マウスフックのコールバック関数
//-----------------------------------------------------------------------------
function MouseHookProc(nCode:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
var
LPos : TPoint;
begin
if nCode < 0 then begin
Result := CallNextHookEx(FMouseHook, nCode, wPar, lPar);
end else begin
if nCode = HC_ACTION then begin
if wPar = WM_LBUTTONDOWN then begin
if Form1.Edit1.Focused then begin
LPos := PMouseHookStruct(lPar)^.pt;
Form1.Panel2.Caption := Format('[ X=%.4d Y=%.4d ]', [LPos.X, LPos.Y]);
end;
end;
end;
Result := CallNextHookEx(FMouseHook, nCode, wPar, lPar);
end;
end;
キーフックは、操作したキーコードの検出になりますが、IME が起動中はコントロールの OnKeyDown イベントの引数の Key の値は VK_PROCESSKEY (IME PROCESSキー) になります。
このことを利用すると、コントロールの OnKeyDown イベント内で、日本語 IME が起動中かどうかを検出できます。
このことを確認したのが下図です。
|
 |
図2
日本語 IME が起動中の場合 |
//=============================================================================
// Edit1のOnKeyDownイベント処理
//
// VK_PROCESSKEYfはIME PROCESSキー(229, $E5)
// IMEのプロセスが起動中はOnKeyDownのKeyコードはこの値になる
//=============================================================================
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//キーコードを表示
if Key = VK_PROCESSKEY then begin
Panel2.Caption := '日本語 IME ON';
end else begin
Panel2.Caption := '日本語 IME OFF';
end;
Panel1.Caption := Chr(Key) + Format(' %.2d ($%.2x)', [Key, Key]);
end;
OnKeyUp イベントの引数の Key の値は操作したキーコードです。したがって、日本語 IME が起動中かどうかは検出できません。
ただし、筆者がテストしたのは Microsoft Office IME 2010 です。日本語 IME の種類によっては検出できるかも知れません。
|

|
図3
OnKeyUp では日本語 IME が起動中か検出できない |
//=============================================================================
// Edit1のOnKeyUpイベント処理
//
// OnKeyUpイベントではVK_PROCESSKEYが検出されない
// 日本語IMEの種類によっては検出可能かも知れない
//=============================================================================
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
//キーコードを表示
if Key = VK_PROCESSKEY then begin
Panel2.Caption := '日本語 IME ON';
end else begin
Panel2.Caption := '日本語 IME OFF';
end;
Panel1.Caption := Chr(Key) + Format(' %.2d ($%.2x)', [Key, Key]);
end;
| 02_TApplicationEvents によるフックのメッセージ受信 |
コールバック関数が送信したメッセージは、以下のように TApplicationEvents の OnMessage イベントでも受信することができます。また、WndProc メソッドでも受信できます。
|
リスト2
TApplicationEvents の OnMessage イベントでメッセージを受信する
WMApp100, WMApp110 のメソッドは不要 |
//=============================================================================
// TApplicationEventsのOnMessageイベント処理
// キーとマウスの操作を捕捉する
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
LIsDown : Boolean;
LKey : WORD;
LCode : Integer;
LPos : TPoint;
begin
if Edit1.Focused then begin
if Msg.message = WM_APP+110 then begin
//キーが押された時に処理
LIsDown := (Msg.LParam and (1 shl 31)) = 0;
if LIsDown then begin
//仮想キーコード
LKey := Msg.wParam;
LCode := LKey and $FF;
//キーコードを表示
Panel1.Caption := Chr(LCode) + Format(' %.2d ($%.2x)', [LCode, LCode]);
end;
end;
if Msg.message = WM_APP+100 then begin
if Msg.wParam = WM_LBUTTONDOWN then begin
LPos := Msg.pt;
//マウスの座標値を表示
Panel2.Caption := Format('[ X=%.4d Y=%.4d ]', [LPos.X, LPos.Y]);
end;
end;
end;
end;
ローカルキーフックだけですが、Halbow 資料館にコンポーネントのコードがあります。それを使用したサンプルです。メッセージがイベントで受け取ることができ、コードがシンプルになります。
|
 |
図4
設計時の画面
|
 |
図5
実行時の画面
- キー操作のフックなので、日本語 IME で入力中でも押下したキーのコードが取得できる
- ローマ字入力なので、[ん] のキーは [N]
|
リスト3
Halbow 資料館に掲載されているローカルキーフックのコンポーネントを使用する例 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, KeyHookUnit;
type
TForm1 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
KeyHook1: TKeyHook;
procedure KeyHook1KeyDown(virtualkey: Cardinal);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// キーフック開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
KeyHook1.Enabled := True;
end;
//=============================================================================
// キーフック終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
KeyHook1.Enabled := False;
end;
//=============================================================================
// KeyHook1のOnKeyDownイベント処理
//=============================================================================
procedure TForm1.KeyHook1KeyDown(virtualkey: Cardinal);
var
LText : string;
begin
if Edit1.Focused then begin
LText := Format(' %.2d ($%.2x)', [virtualkey, virtualkey]);
Panel1.Caption := Chr(virtualkey) + LText;
end;
end;
end.
| 04_ローカルキーフックによる特定のキー操作の無効化 |
最初のサンプルはキーコードとマウスカーソルの位置を表示するだけでした。
本サンプルでは、押下した特定のキーを無効にしてみます。
このサンプルでは、メインフォームから別のフォームをモーダル表示します。モーダル表示するフォームには Cancel プロパティを True にした TButton を配置しています。つまり、モーダル表示したフォームは、[ESC] キーで閉じることができます。この [ESC] キーを無効にして、[ESC] キーでは閉じないようにします。
キーフックのこの動作をモーダル表示したフォームだけに適用したいのであれば、モーダル表示するフォームを表示する時にフックを開始します。フォームを閉じたフックを終了します。
あるいは、モーダル表示するフォームがアクティブな時だけキー操作を禁止するコードを実行するようにしておきます。
|
[備考 1]
このようなローカルフックによる方法や、後述の、他のフォームのコンポーネント等、あるいはプロパティの操作は、他のプロジェクトでも共通に利用する目的で作成したフォームに変更を加えずに、その動作を変更することができます。 |
[備考 2]
入力コントロールで特定の文字の入力を無効化、つまりキー入力を禁止するのにローカルフックを使う必要はありません。以下のサンプルのように、OnKeyPress イベントで処理できます。あるいは入力した文字列を OnChange イベントで処理する方法もあります。
|
 |
図6
実行時の画面
- Button1 で Form2 を表示
- [ESC] キーで Form2 を閉じる
- [[ESC] 無効] をクリック後、再度 Form2 を表示する
- [ESC] キーでは閉じなくなる
|
リスト4
メインフォームのコード
ローカルキーフックを使用して、特定のキー押下を無効にする |
implementation
uses Unit2;
{$R *.DFM}
var
KeyHookHandle : HHOOK=0;
//-----------------------------------------------------------------------------
// キーフックのコールバック関数
// wPar : 仮想キーコード
// lPar : キーの状態(MSDNのKeyboardProc callbackiに説明あり)
//-----------------------------------------------------------------------------
function KeyHookProc(nCode:integer; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
begin
Result := 0;
if nCode < 0 then begin
Result := CallNextHookEx(KeyHookHandle, nCode, wPar, lPar);
exit;
end;
if nCode = HC_ACTION then begin
if (wPar = VK_ESCAPE) then begin
//本来動作を無効にする
Result := 1;
end;
end;
if Result = 0 then begin
Result := CallNextHookEx(KeyHookHandle, nCode, wPar, lPar);
end;
end;
//=============================================================================
// 別のフォームをモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Left := Left + 50;
Form2.Top := Top + 100;
Form2.ShowModal;
end;
//=============================================================================
// キーフック開始
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if KeyHookHandle = 0 then begin
KeyHookHandle := SetWindowsHookEx(WH_KEYBOARD,
@KeyHookProc,
0,
GetCurrentThreadId);
end;
end;
//=============================================================================
// キーフックを解除
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if KeyHookHandle <> 0 then begin
UnhookWindowsHookEx(KeyHookHandle);
KeyHookHandle := 0;
end;
end;
リスト5
メインフォームからモーダル表示するフォームのコード
フォームに配置した Button1 の Cancel プロパティの値は True |
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TForm2 }
end.
コールバック関数のキーコードの処理部分を以下のようにすると、キーボードの数字キーからは入力できなくなります。日本語 IME が有効な状態でも、これらのキーは使用できなくなります。
対象とするキーコードの値は、最初のサンプルを実行して確認できます。
|
if nCode = HC_ACTION then begin
//48-57は数字キーのキーコード
//96-105はテンキーの数字キーのキーコード
if wPar in ([48..57, 96..105]) then begin
//本来動作を無効にする
Result := 1;
end;
end;
| 05_特定のキー操作の無効化 - TApplicationEvents によるキーフック |
上のサンプルと同じ動作を TApplicationEvents の OnMessage イベントで処理する例です。
TApplicationEvents コンポーネントを利用すると、Halbow 資料館の記事にあるように、自アプリのキーやマウスの操作のほとんどを補足 (フック) することができます。
|
 |
図7
設計時の画面
- メインフォームに TApplicationEvents コンポーネントを配置して、OnMessage イベントを作成
|
リスト6
TApplicationEvents コンポーネントを使用して、特定のキー押下を無効にする |
implementation
uses Unit2;
{$R *.DFM}
//=============================================================================
// 別のフォームをモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Left := Left + 50;
Form2.Top := Top + 100;
Form2.ShowModal;
end;
//=============================================================================
// キーフック開始
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
FKeyHook := True;
end;
//=============================================================================
// キーフックを解除
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
FKeyHook := False;
end;
//=============================================================================
// ApplicationEvents1コンポのOnMessageイベント処理
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
LIsDown : Boolean;
begin
if Msg.message = WM_KEYDOWN then begin
//キーが押された時に処理(特に必要な条件ではない)
LIsDown := (Msg.LParam and (1 shl 31)) = 0;
if LIsDown then begin
if Msg.wParam = VK_ESCAPE then begin
Handled := FKeyHook;
end;
end;
end;
end;
| 06_特定のキー操作の無効化 - 対象フォーム限定 |
| 操作対象のフォームのコードを変更してもいいのであれば、一般的に使用するメッセージ処理で個別に検出することができます。その例です。上のサンプルと同じ動作をします。
本サンプルの動作対象フォームはモーダル表示する Form2 ですので、Form2 のユニットでメッセージ処理をしています。メインフォームから操作する変数を Form2 のプロパティとして実装しています。プロパティにしなくても、public な変数でも当然動作します。
|
リスト7
メインフォームのコード
モーダル表示するフォームのユニットのプロパティを設定する |
implementation
uses Unit2;
{$R *.DFM}
//=============================================================================
// 別のフォームをモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Left := Left + 50;
Form2.Top := Top + 100;
Form2.ShowModal;
end;
//=============================================================================
// キーフック開始
// Form2.KeyHookはプロパティとして実装している
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Form2.KeyHook := True;
end;
//=============================================================================
// キーフックを解除
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Form2.KeyHook := False;
end;
リスト8
メインフォームからモーダル表示するフォームのコード
プロパティ KeyHook の値をメインフォームである Form1 から変更する |
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
private
{ Private 宣言 }
FKeyHook: Boolean;
protected
procedure CMChildKey(var Message: TCMChildKey); message CM_CHILDKEY;
public
{ Public 宣言 }
property KeyHook : Boolean read FKeyHook write FKeyHook default False;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TForm2 }
//-----------------------------------------------------------------------------
// CM_CHILDKEYメッセージ処理
//
// FKeyHookはプロパティとして実装しているがpublicな変数でもよい
// プロパティとして実装すれば初期値設定、設定と取得時の処理が追加できる
//-----------------------------------------------------------------------------
procedure TForm2.CMChildKey(var Message: TCMChildKey);
begin
case Message.CharCode of
VK_ESCAPE :
begin
Message.Result := Ord(FKeyHook);
end;
end;
end;
end.
ここまでのキー操作を無効にする一連のサンプルは、メッセージ処理の参考してのサンプルです。実際には以下のように、モーダル表示するフォーム上に配置した TButton の Cancel プロパティの値を変更すれば済むことです。この方法でも、他のフォームのコードを変更することなく、そのフォームにおける動作を変更することができます。
必要であれば元のプロパティの値を退避しておいて、モーダル表示したフォームを閉じる時に元の値に戻しておきます。
|
リスト9
他のフォームの TButton のプロパティを変更 |
//=============================================================================
// 別のフォームをモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Left := Left + 50;
Form2.Top := Top + 100;
Form2.ShowModal;
end;
//=============================================================================
// Form2を[ESC]で閉じないようにする
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Form2.Button1.Cancel := False;
end;
//=============================================================================
// Form2を[ESC]で閉じるようにする
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Form2.Button1.Cancel := True;
end;
|