|
とりあえず，テストで使用したコードです．
動作確認は Windows 7 U64(SP1) + Delphi XE(UP1) Pro です．
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
hEventHook : THandle;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses OleAcc;
{$R *.dfm}
// Delphi XEにはないので定義
function AccessibleObjectFromEvent(hWnd : HWND; dwObjewctID : DWORD;
dwChildID : DWORD; out pacc : IAccessible; out pvarChild : OleVariant):
HResult; stdcall; external 'OLEACC.DLL';
function AccessibleObjectFromPoint(ptScreen: TPOINT; out ppAcc: IAccessible;
out pvarChild: OleVariant): HRESULT ; stdcall; external 'OLEACC.DLL';
//-----------------------------------------------------------------------------
// ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetClassNameStr(hWindow: HWND): String;
var
Buffer : array[0..MAX_PATH-1] of Char;
Len : Integer;
begin
System.FillChar(Buffer, SizeOf(Buffer), #0);
Len := Windows.GetClassName(hWindow, Buffer, Length(Buffer));
if Len > 0 then Result := Buffer else Result := '';
end;
//-----------------------------------------------------------------------------
// フック関数SetWinEventHookのコールバック関数
//-----------------------------------------------------------------------------
procedure WinEventProc(hWinEventHook: THandle; event: DWORD; hwnd: HWND;
idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;
var
LMousePos : TPoint;
LpAcc : IAccessible;
LText : WideString;
Lacc : IAccessible;
LvarChild : OleVariant;
begin
//イベントの引数からAcc(IAccessible)とvarChild(OleVariant)を取得
//#32774はシステムのツールチップのクラス名
if AccessibleObjectFromEvent(hwnd, idObject, idChild, Lacc, LvarChild) = S_OK then begin
if GetClassNameStr(hwnd) = '#32774' then begin
if event = EVENT_OBJECT_SHOW then begin
//マウスカーソル位置を取得
GetCursorPos(LMousePos);
//マウスカーソル位置のIAccessibleオブジェクトを取得
//AccessibleObjectFromPoint関数の戻り値のvarChildのvtは，常にVT_I4となっている
if AccessibleObjectFromPoint(LMousePos, LpAcc, LvarChild) = S_OK then begin
//Nameプロパティの値を取得
if LpAcc.Get_accName(LvarChild, LText) = S_OK then begin
Form1.Memo1.Lines.Add(LText);
end else begin
Form1.Memo1.Lines.Add('不明');
end;
end;
end;
end;
end;
end;
//=============================================================================
// [Start HOOK] フック開始
// hEventHook : フックのハンドル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Clear;
if hEventHook = 0 then begin
hEventHook := SetWinEventHook(
EVENT_MIN,
EVENT_MAX,
0,
WinEventProc,
0,
0,
WINEVENT_OUTOFCONTEXT);
if hEventHook = 0 then begin
Memo1.Lines.Add('フック関数の登録失敗');
end else begin
Memo1.Lines.Add('フック開始');
end;
end;
end;
//=============================================================================
// [Stop HOOK] フックの終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
if hEventHook <> 0 then begin
UnhookWinEvent(hEventHook);
hEventHook := 0;
Memo1.Lines.Add('フック終了');
end;
end;
//=============================================================================
// フォームの作成時 変数の初期化
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
hEventHook := 0;
end;
//=============================================================================
// フォームを閉じる時は，フックを終了させる
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if hEventHook <> 0 then UnhookWinEvent(hEventHook);
end;
end.
|
