名前
題名
▼ Mr.XRAYさん > とりあえず，テストで使用したコードです． > 動作確認は 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.
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link