Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年05月15日] [更新 2015年04月26日] Delphi サンプルプログラム集
   
678_他のアプリの操作と IAccessible インターフェイス
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Firefox 13.0 以降
678_IAccessibleInterface.zip [4,127 KB] 2015年04月26日版(EXE同梱)



  • 2012年05月29日
  • Firefox のボタンをクリックするサンプルコードを修正
  • オブジェクトの階層をツリー表示するサンプルを追加
  • 2012年06月01日
  • イベントフックのサンプルコードを追加
  • 2012年06月16日
  • マウスカーソル下のオブジェクトの情報のサンプルを追加
  • 2015年04月26日
  • Firefox のボタンをクリックするサンプルコードを修正
    FireFox のウィンドウハンドルの取得を真面目なコード (?) に変更して,[戻る] [進む] [閉じる] の全ての操作を実行可能にした




他のアプリの操作と IAccessible インターフェイス


IAccessible インターフェイスのオブジェクトを使用した,他のアプリの操作サンプルです.
IAccessible インターフェイスを使用すると,ウィンドウハンドルを持たないコントロール等のオブジェクトの情報取得や操作が可能になります.
IAccessible インターフェイス関係は,uses に OleAcc を追加すると使用できます.

IAccessible のオブジェクトのプロパティの取得,設定は関数を使用しますが,実際には実装されていない関数もあるようです.また,IAccessible のオブジェクトやメソッドは,たとえ存在しても設定や取得,操作可能かは,アプリーケーション側の設定にもよります.詳しくは,各々の関数の説明で確認してください.

Delphi 2007 よりも前の Delphi で IAccessible インターフェイスの機能を使用するには,[IDL コンパイラを使用したタイプライブラリの作成と取り込み] の記事の方法で,Windows SDK の OleAcc.tlb から Accessibility_TLB.pas というユニットを作成します.
ただし,作成した Accessibility_TLB.pas で実装されているプロパティやメソッド類は,Delphi 2007 以降に実装されている OleAcc.pas と少し仕様が違っています.本ページのサンプルのコードの一部を修正する必要があります.
この種のファイルは,ネット上で同等のものが入手できることがあります.


[備考]
他のアプリの操作では,ともかく最初は対象のウィンドウのハンドルの取得が必要です.ウインドウのハンドルは,操作に有効なウィンドウのハンドルが必要です.本ページの [ブラウザ Firefox... ] を参考にしてください.FindWindow で取得したウインドウが必ずしも有効なウィンドウであるという保証はありません.





01_toolStrip コントロール上のボタンをクリック


添付の WPFApplication1.exe の toolStip コントロールの操作例です.
WPFApplication1.exe を起動してから操作します.この WPFApplication1.exe は C# で作成しています.ターゲットフレームワークを .NET Frameword 4.5 にしています.したがって,環境によっては動作しないかも知れません.


図1
起動画面
  • 右が自アプリ
  • 左が他のアプリ
図2
0 番のオブジェクト
  • 0 番目のオブジェクトはない
  • toolStrip 自身となる
  • 自アプリの TPanel の Caption は,他アプリの name プロパティの値
図3
1 番目のボタンをクリック
  • 2 番目のオブジェクトが最初のボタンとなっている

これ以降のサンプルでもそうですが,IAccessible の各関数の引数の説明にある VARIANT 型 (バリアント型) は,Delphi では,TVariantArg 型 (ActiveX.pasで定義) として扱うことができます.
また,System.pas の TVarData 型も使用できますが,TVarData では,VT_I4 という値ではなく,次の参考リンクにあるように,Delphi の Integer 型を意味する varInteger 等も使用できます.


TVarData 型を使用する例.ueses に ActiveX が必要
     TVarData(varChild).VType    := varInteger;
     TVarData(varChild).VInteger := SpinEdit1.Value;
     oAccessible.accDoDefaultAction(varChild);


TVariantArg 型を使用する例.uses に ActiveX が必要
     TVariantArg(varChild).vt   := VT_I4;
     TVariantArg(varChild).lVal := SpinEdit1.Value;
     oAccessible.accDoDefaultAction(varChild);




リスト1
他のアプリの toolStrip コントロールのボタンオブジェクトをクリック
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses oleacc, ActiveX;

{$R *.dfm}

var
  TargetClassName : String;

//-----------------------------------------------------------------------------
//  ウィンドウのクラス名を取得する関数
//-----------------------------------------------------------------------------
function GetWindowClassNameStr(hWindow: HWND): String;
var
  Buffer : array[0..MAX_PATH-1] of Char;
  Len    : Integer;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len > 0 then begin
    Result := Buffer;
  end else begin
    Result := '';
  end;
end;

//-----------------------------------------------------------------------------
//  EnumWindowsのコールバック関数
//  指定したウィンドウクラスのウィンドウを検索する
//-----------------------------------------------------------------------------
function EnumWindowProc(hWindow: HWND; lPalam: PNativeInt): Boolean; stdcall;
begin
  Result := True;

  if IsWindowVisible(hWindow) then begin
    if Pos(TargetClassName, GetWindowClassNameStr(hWindow)) > 0 then begin
      lPalam^ := hWindow;
      Result  := False;
    end;
  end;
end;

//=============================================================================
//  [toolStrip]のボタンをクリック
//  toolStripは.NET Framework(C#)用のコントロール
//  添付の操作対象アプリはC#で(.NET Framework 4 Client Profile)作成したもの
//
//  usesに oleacc, ActiveXが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  hTargetWnd  : HWND;
  hToolStrip  : HWND;
  oAccessible : IAccessible;
  varChild    : OleVariant;
  vValue      : OleVariant;
  StrText     : WideString;
begin
  //トップレベルのウィンドウからクラス名の一部が一致するウィンドウを検索
  TargetClassName := 'WindowsForms10.Window.8.app';
  hTargetWnd      := 0;
  EnumWindows(@EnumWindowProc, LPARAM(@hTargetWnd));
  //toolStripのハンドルを取得
  hToolStrip := FindWindowEx(hTargetWnd, 0, nil, 'toolStrip1');

  if hToolStrip = 0 then begin
    MessageDlg('操作対象コントロールが見つかりません', mtInformation, [mbOK], 0);
    exit;
  end;

  Panel1.Caption := '';
  //そのハンドルのIAccessibleオブジェクトを取得
  if AccessibleObjectFromWindow(hToolStrip,
                                OBJID_CLIENT,
                                IID_IAccessible,
                                oAccessible) = S_OK then begin

     //SpinEditの値と同じ番号のtoolStripオブジェクトのデフォルト動作を実行
     //オブジェクトの全てがボタンとは限らないので注意
     TVariantArg(varChild).vt   := VT_I4;
     TVariantArg(varChild).lVal := SpinEdit1.Value;
     oAccessible.accDoDefaultAction(varChild);

     //ついでにNameプロパティを取得して表示してみる
     oAccessible.Get_accName(varChild, StrText);
     Panel1.Caption := StrText;
  end;
  varChild := Unassigned;
  vValue   := Unassigned;
end;

end.




02_他のアプリの StatusBar のテキストを取得


Halbow 資料館の [第8章 他のアプリのウィンドウ情報の取得 - 共有メモリ] に Statusbar のテキストの取得と設定のサンプルがあります.
IAccessible を使用すると,取得だけであれば可能です.そのサンプルプログラムです.
put_accName というプロパティ設定用の関数がありますが,実装されていないようです.



図4
起動画面
  • 右が自アプリ
  • 左が他のアプリ
図5
[取得] ボタンをクリック
  • 他のアプリの Statusbar の文字列を取得して TMemo に表示

リスト2
他のアプリの Statusbar のテキストを取得して表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses OleAcc, ActiveX;

{$R *.dfm}

//=============================================================================
//  [取得]ボタンクリック
//  他のアプリのTStatusbarのテキストを取得して表示
//
//  usesにOleAcc, ActiveXが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  hTargetForm : HWND;
  hStatusbar  : HWND;
  oAccessible : IAccessible;
  ChildCount  : Integer;
  i           : Integer;
  varChild    : OleVariant;
  StrText     : WideString;
begin
  Memo1.Lines.Clear;

  //対象のStatusbarのハンドルを取得
  hTargetForm := FindWindow('TTargetForm', nil);
  hStatusbar  := FindWindowEx(hTargetForm, 0, 'TStatusbar', nil);

  if hStatusbar = 0 then begin
    MessageDlg('操作対象アプリが見つかりません', mtInformation, [mbOK], 0);
    exit;
  end;

  //そのハンドルのIAccessibleオブジェクトを取得
  if AccessibleObjectFromWindow(hStatusbar,
                                OBJID_CLIENT,
                                IID_IAccessible,
                                oAccessible) = S_OK then begin
    //その子オブジェクトの数を調査
    //本来は,AccessibleChildren関数で操作可能を調査すべきだが,ここでは間違い
    //なく操作可能であると判断
    oAccessible.Get_accChildCount(ChildCount);

    //オブジェクトの数だけテキストを取得
    TVariantArg(varChild).vt := VT_I4;
    for i := 1 to ChildCount do begin
      TVariantArg(varChild).lVal := i;
      oAccessible.Get_accName(varChild, StrText);
      Memo1.Lines.Add(StrText);
    end;
  end;
  varChild := Unassigned;
end;

end.




03_ブラウザ Firefox の [ 戻る ] [ 進む ] ボタンをクリック


Firefox ブラウザの [戻る] と [進む] ボタンを,Delphi から操作するサンプルです.
まず,Firefox のハンドルを取得します.これらのボタンオブジェクトの name プロパティは,[戻る] と [進む] となっています.Firefox のハンドルの階層下のオブジェクトから,これらの name プロパティを持つオブジェクトを探し出すわけですが,この部分は別ユニットにしています.

[閉じる] ボタンのテストコードがありますが,Windows XP(SP3) + Firefox 12.0 では動作しましたが,Windows 7 U64(SP1) + Firefox 12.0 では動作しませんでした.
FireFox はウィンドウの階層構造が,バージョンによって変更されています.そこで,2015年04月26日の更新で,FireFox のウィンドウハンドルを,EnumWindows のコールバック関数内で検出する方法に変更しました.この変更で,FireFox 37.0.2 では [戻る] [進む] [閉じる] が全て動作するようになっています.この変更がない場合,FireFox 37.0.2 では全てのボタンが機能しません.



図6
実行画面
  • Firefox の [←] [→] ボタンをクリック

リスト3
Firefox ブラウザの [戻る] と [進む] ボタンを,Delphi 側から操作
ボタンオブジェクトの検索には,添付のユニット内の関数を使用
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, OleAcc;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  plSearchIAccObjName;

{$R *.dfm}

//対象のウィンドウの情報を格納するレコード型の定義
type
  TTargetWndInfo = record
    hWindow   : HWND;
    ClassName : String;
  end;
  PTargetWndInfo = ^TTargetWndInfo;


//-----------------------------------------------------------------------------
//  EnumWindowsのコールバック関数
//  可視で他に所有されていないトップレベルのウィンドウだけを検出
//  PTargetWndInfoはウィンドウの情報を格納するレコード型のポインタ
//-----------------------------------------------------------------------------
function EnumVisbleNoOwnedWndProc(hWindow: HWND; lData: PTargetWndInfo): BOOL; stdcall;

  //---------------------------------------------------------------------------
  //  引数のウィンドウがオーナーウィンドウであるかを調査
  //---------------------------------------------------------------------------
  function IsOwnedWindow(hWindow: HWND): Boolean;
  begin
    Result := Windows.GetWindow(hWindow, GW_OWNER) <> 0;
  end;

  //-----------------------------------------------------------------------------
  //  ウィンドウハンドルからウィンドウクラス名を取得
  //-----------------------------------------------------------------------------
  function GetClassNameStr(hWindow: HWND): string;
  var
    Buffer : array[0..MAX_PATH-1] of Char;
    Len    : Integer;
  begin
    FillChar(Buffer, SizeOf(Buffer), #0);
    Len := GetClassName(hWindow, Buffer, Length(Buffer));
    if Len > 0 then Result := Buffer else Result := '';
  end;
  //-----------------------------------------------------------------------------

var
  LClassName : String;
begin
  Result := True;
  if IsOwnedWindow(hWindow) then exit;
  if not Windows.IsWindowVisible(hWindow) then exit;

  //クラス名が同じだったら,そのウィンドウハンドルをコールバックの引数に返す
  LClassName := UpperCase(GetClassNameStr(hWindow));
  if LClassName = UpperCase(lData^.ClassName) then begin
    lData^.hWindow := hWindow;
    Result := False;
  end;
end;

//=============================================================================
//  [戻る]ボタンクリック
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LWndInfo   : TTargetWndInfo;
  LTargetWnd : HWND;
  LBackAcc   : IAccessible;
  LChildID   : Integer;
begin
  //Firefoxのハンドルを取得
  LWndInfo.ClassName := 'MozillaWindowClass';
  LWndInfo.hWindow   := 0;
  //指定クラス名のウィンドウを検索
  EnumWindows(@EnumVisbleNoOwnedWndProc, LPARAM(@LWndInfo));
  LTargetWnd := LWndInfo.hWindow;

  if LTargetWnd = 0 then begin
    MessageDlg('Fire Foxが見つかりません', mtInformation, [mbOK], 0);
  end else begin
    //[戻る]ボタンのIAccessibleオブジェクトを取得
    if LBackAcc = nil then begin
      LBackAcc := SearchAccObjectFromWindow(LTargetWnd, '戻る', LChildID);
    end;

    if LBackAcc = nil then begin
      MessageDlg('操作できません', mtInformation, [mbOK], 0);
    end else begin
      //[戻る]ボタンのデフォルト動作を実行
      LBackAcc.accDoDefaultAction(LChildID);
    end;
  end;
end;

//=============================================================================
//  [進む]ボタンクリック
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LWndInfo     : TTargetWndInfo;
  LTargetWnd   : HWND;
  LForewordAcc : IAccessible;
  LChildID     : Integer;
begin
  //Firefoxのハンドルを取得
  LWndInfo.ClassName := 'MozillaWindowClass';
  LWndInfo.hWindow   := 0;
  //指定クラス名のウィンドウを検索
  EnumWindows(@EnumVisbleNoOwnedWndProc, LPARAM(@LWndInfo));
  LTargetWnd := LWndInfo.hWindow;

  if LTargetWnd = 0 then begin
    MessageDlg('Fire Foxが見つかりません', mtInformation, [mbOK], 0);
  end else begin
    if LForewordAcc = nil then begin
      LForewordAcc := SearchAccObjectFromWindow(LTargetWnd, '進む', LChildID);
    end;

    //[進む]ボタンのIAccessibleオブジェクトを取得
    if LForewordAcc = nil then begin
      MessageDlg('操作できません', mtInformation, [mbOK], 0);
    end else begin
      //[進む]ボタンのデフォルト動作を実行
      LForewordAcc.accDoDefaultAction(LChildID);
    end;
  end;
end;

//=============================================================================
//  [閉じる]ボタンクリック
//
//  Windows XP(SP3) + Firefox 12.0 では動作する
//  Windows 7 U64(SP1) + Firefox 12.0 てば動作しない
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LWndInfo   : TTargetWndInfo;
  LTargetWnd : HWND;
  LCloseAcc  : IAccessible;
  LChildID   : Integer;
begin
  //Firefoxのハンドルを取得
  LWndInfo.ClassName := 'MozillaWindowClass';
  LWndInfo.hWindow   := 0;
  //指定クラス名のウィンドウを検索
  EnumWindows(@EnumVisbleNoOwnedWndProc, LPARAM(@LWndInfo));
  LTargetWnd := LWndInfo.hWindow;

  if LTargetWnd = 0 then begin
    MessageDlg('Fire Foxが見つかりません', mtInformation, [mbOK], 0);
  end else begin
    if LCloseAcc = nil then begin
      LCloseAcc := SearchAccObjectFromWindow(LTargetWnd, '閉じる', LChildID);
    end;

    //[閉じる]ボタンのIAccessibleオブジェクトを取得
    if LCloseAcc = nil then begin
      MessageDlg('操作できません', mtInformation, [mbOK], 0);
    end else begin
      //[閉じる]ボタンのデフォルト動作を実行
      LCloseAcc.accDoDefaultAction(LChildID);
    end;
  end;
end;

end.


IAccessible には,特定のプロパティの値を持つオブジェクトを検索するメソッドはありません.
全オブジェクトの中から検索することになりますが,同じプロパティの値を持つオブジェクトが複数存在することもあります.例えば,今回のサンプルで扱っている [戻る] は,コンテキストメニューにもあります.
そこで,以下のコードでは,非可視のオブジェクトを検索対象から除外しています.
関数は 2 つあり,1 つはウィンドウハンドルから検索,もう1つは IAccessible オブジェクトから検索する関数です.


リスト4
指定ウィンドウ下のオブジェクトから,指定 Name プロパティのオブジェクトを検索する関数
unit plSearchIAccObjName;

interface

uses
  Windows, SysUtils, Forms, ActiveX, OleAcc, Variants;

  function SearchAccObjectFromWindow(Wnd: HWND; SearchName: String;
    var ChildID: Integer): IAccessible;
  function SearchAccChild(Acc: IAccessible; SearchName: String;
    var ID: Integer): IAccessible;

  //Delphi XEにないので定義
  function AccessibleChildren(paccContainer: IAccessible; iChildStart,
    cChildren: Longint; rgvarChildren: PVariantArg;
    pcObtained: PLongint): HRESULT; stdcall; external 'oleacc.dll';

implementation

//=============================================================================
//  引数で指定するウィンドウ階層下のオブジェクトから,指定Nameプロパティを持つ
//  オブジェクトを検索して返す関数
//  ただし,非表示のオブジェクトを除く
//
//  Wnd        : 検索対象ウィンドウのハンドル
//  SearchName : 検索文字列
//  ChildID    : 検索したオブジェクトの子オブジェクト番号(1,2,3, ...)
//               0の時は,戻り値は検索結果のオブジェクトのIAccessible
//               1以外の時の戻り値は,検索結果の直接の親のオブジェクト
//  戻り値は,検索結果のオブジェクトの直接の親のIAccessible
//  見つからなかった時はnilを返す
//
//  この関数の呼び出し側では,戻り値とChildIDの値でオブジェクトを操作する
//=============================================================================
function SearchAccObjectFromWindow(Wnd: HWND; SearchName: String;
  var ChildID: Integer): IAccessible;
var
  oAccessible : IAccessible;
begin
  Result := nil;

  //WndのIAccessibleオブジェクトを取得
  if AccessibleObjectFromWindow(
      Wnd,
      OBJID_WINDOW,
      IID_IAccessible,
      Pointer(oAccessible)) = S_OK then begin
    Result := SearchAccchild(oAccessible, SearchName, ChildID);
  end;
end;

//-----------------------------------------------------------------------------
//  検索対象の文字列かを検査する関数
//  非可視のオブジェクトは除外
//-----------------------------------------------------------------------------
function IsSearchName(AccChild: IAccessible; ChildID: Integer;
  SearchName: String): Boolean;
var
  varState : OleVariant;
  VState   : Cardinal;
  varChild : OleVariant;
  AccName  : WideString;
begin
  Result := False;

  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  if AccChild.Get_accState(varChild, varState) = S_OK then begin
    if TVariantArg(varState).vt = VT_I4 then begin
      VState :=  TVariantArg(varState).lVal;
      if (VState and STATE_SYSTEM_INVISIBLE) = 0 then begin
        if AccChild.get_accName(varChild, AccName) = S_OK then begin
          Result := UpperCase(Trim(AccName)) = UpperCase(SearchName);
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  引数で指定するIAccessibleオブジェクト階層下から,指定のNameプロパティを持つ
//  オブジェクトを検索して返す関数
//  ただし,非表示のオブジェクトを除く
//  この関数を再帰的に実行し,オブジェクトの階層下を検索していく
//
//  Acc        : 検索対象のIAccessibleオブジェクト
//  SearchName : 検索文字列
//  ID         : 検索したオブジェクトの子オブジェクト番号(1,2,3, ...)
//               0の時は,戻り値は検索結果のオブジェクトのIAccessible
//               1以外の時の戻り値は,検索結果の直接の親のオブジェクト
//  戻り値は,検索結果のオブジェクトの直接の親のIAccessible
//  見つからなかった時はnilを返す
//
//  この関数の呼び出し側では,戻り値とChildIDの値でオブジェクトを操作する
//=============================================================================
function SearchAccChild(Acc: IAccessible; SearchName: String;
  var ID: Integer): IAccessible;
var
  Children   : array of TVariantArg;
  ChildCount : Integer;
  Obtained   : Integer;
  AccChDisp  : IDispatch;
  AccChild   : IAccessible;
  ChildID    : Integer;
  i          : Integer;
  j          : Integer;
  HasChild   : Integer;
begin
  Result := nil;
  if Acc = nil then exit;

  //子オブジェクトの数を調べる
  if Acc.get_accChildCount(ChildCount) = S_OK then begin
    Application.ProcessMessages;
    SetLength(Children, ChildCount);

    //バリアント配列の初期化
    for i := 0 to ChildCount - 1 do begin
      VariantInit(OleVariant(Children[i]));
    end;

    //アクセス可能なオブジェクトの数を調査
    if AccessibleChildren(Acc, 0, ChildCount, @Children[0], @Obtained) = S_OK
        then begin
      for j := 0 to Obtained - 1 do begin
        HasChild := -1;
        ChildID  := CHILDID_SELF;

        //子オブジェクトがある
        if Children[j].vt = VT_DISPATCH then begin
          AccChDisp := IDispatch(Children[j].pdispVal);
          if Assigned(AccChDisp) then begin
            AccChDisp.QueryInterface(IID_IAccessible, AccChild);
            ChildID  := CHILDID_SELF;
            HasChild := 1;
          end;
        end else begin
          if Children[j].vt = VT_I4 then begin
            //子オブジェクトはない
            if Acc.get_accChild(OleVariant(Children[j]), AccChDisp) = S_FALSE
                then begin
              AccChild := Acc;
              ChildID  := Children[j].lVal;
              HasChild := 0;
            end else begin
               //子オブジェクトがある
              if Assigned(AccChDisp) then begin
                AccChDisp.QueryInterface(IID_IAccessible, AccChild);
                ChildID  := CHILDID_SELF;
                HasChild := 1;
              end;
            end;
          end;
        end;

        //処理を1か所にまとめるためにHasChildをフラグとして使用
        if HasChild >= 0 then begin
          if IsSearchName(AccChild, ChildID, SearchName) then begin
            ID     := ChildID;
            Result := AccChild;
            break;
          end;
          if (HasChild = 1) then begin
            Result := SearchAccChild(AccChild, SearchName, ID);
            if Result <> nil then Break;
          end;
        end;
      end;
    end;
    //バリアント配列の後始末
    for i := 0 to Obtained - 1 do begin
      VariantClear(OleVariant(Children[i]));
    end;
  end;
end;

end.




04_オブジェクトの階層をツリー表示


[645_ウィンドウの階層のツリー表示] で,オブジェクトのツリー表示をするプログラムを掲載していまが,これらは非可視のオブジェクトも表示します.
そこで,非可視のオブジェクトは対象外とし,可視状態のオブジェクトだけを表示するサンプルを作成してみました.テストしやすいように,ウィンドウを選択するダイアログを表示します.このダイアログは,[645_ウィンドウの階層のツリー表示] で使用している,WinSearch.pas をツリー表示部だけに変更したものです.選択ノードのウィンドウを赤線の枠で表示します.
また,オブジェクトのツリーでも,選択中のオブジェクトを赤い枠線で表示します.この枠線の表示には,透明なフォームを使用しています.

右のペインの TMemo には,現在選択中のノードに相当するオブジェクトの Name または Value プロパティの値を表示します.

[デフォルトアクション実行] と [値のセット] のボタンを追加していますが,対象のオブジェクトに対して,これらの機能が使用できるとは限りません.
[値のセット]は,TMemo に入力した値を,オブジェクトの Value プロパティに文字列を送信するものです.ただし,編集可能なテキストであって,且つ,読み出し専用となっていないオブジェクトに限ります.メモ帳等にはセットできます.ブラウザのページのテキストを変更することはできません.



図7
設計時画面

下図が実行例です.エクスプローラのオブジェクトをツリー展開しています.
そのエクスプローラのツリーの[ピクチャ] をマウスで選択している状態です.該当するオブジェクトが赤い枠線で表示されています.この赤い矩形は,キャプチャ画像に後から追加描画したものではありません.デスクトップのキャプチャ画像そのものです.

[デフォルトアクション実行] ボタンをクリックすると,この [ピクチャ] フォルダを展開することができますが,ツリー表示は [ツリー更新] ボタンをクリックしないと更新されません.


  • 図8
  • エクスプローラのオブジェクトをツリー表示
  • ツリー表示部の,エクスプローラの [ピクチャ] をクリック
  • 該当するオブジェクトが赤い枠線で囲まれる

リスト5
ウィンドウを選択して,IAccessible オブジェクトの階層をツリー表示
ただし,可視状態のオブジェクトのみ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, oleacc, ExtCtrls, ComCtrls, ActiveX, Menus,
  plWindowRectFormUnit, Buttons;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Panel1: TPanel;
    Button2: TButton;
    Splitter1: TSplitter;
    Panel2: TPanel;
    ListView1: TListView;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Panel3: TPanel;
    Button3: TButton;
    PopupMenu2: TPopupMenu;
    N2: TMenuItem;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure TreeView1Deletion(Sender: TObject; Node: TTreeNode);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure RadioGroup1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
  private
    { Private 宣言 }
    hTargetWnd       : HWND;
    TargetClassName  : String;
    RectForm         : TplWindowRectForm;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses plEnumAccInfos, WindowTreeUnit, Clipbrd;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.PopupMenu := nil;
  TreeView1.PopupMenu := nil;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Assigned(RectForm) then begin
    RectForm.Close;
    FreeAndNil(RectForm);
  end;
end;

//=============================================================================
//  [ウィンドウ選択]ボタン
//  ウィンドウのリスト表示用のフォームをモーダル表示して選択
//
//  hTargetWnd      : 対象のウィンドウのハンドル
//  TargetClassName : 対象のウィンドウのクラス名
//  は,モーダル表示したフォームから取得する
//  共にグローバル変数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AForm : TWindowTreeForm;
  dwID  : Cardinal;
  Ret   : Integer;
begin
  if Assigned(RectForm) then begin
    RectForm.Close;
    FreeAndNil(RectForm);
  end;
  TreeView1.PopupMenu := nil;
  ListView1.PopupMenu := nil;

  Ret := mrOk;
  if Sender <> nil then begin
    AForm := TWindowTreeForm.Create(Self);
    try
      Ret := AForm.ShowModal;
      if Ret = mrOk then begin
        Self.Update;
        hTargetWnd       := AForm.hTargetWnd;
        TargetClassName  := AForm.TargetClassName;
      end;
    finally
      FreeAndNil(AForm);
    end;
  end;

  if Ret = mrOk then begin
    Screen.Cursor := crHourGlass;

    TreeView1.Items.Clear;
    ListView1.Items.Clear;
    Memo1.Lines.Clear;

    dwID := OBJID_CLIENT;
    if RadioGroup1.ItemIndex = 0 then dwID := OBJID_WINDOW;
    if RadioGroup1.ItemIndex = 1 then dwID := OBJID_CLIENT;
    plEnumAccInfos.EnumAccObjectTree(hTargetWnd, TreeView1, dwID);

    Screen.Cursor := crDefault;
  end;
end;

//=============================================================================
//  [ツリー更新]ボタン
//  オブジェクトの再取得
//  ボップアップメニューの[このオブジェクトをルートにして再取得]と同じコードを実行
//  ただし,このオブジェクトは,トップノードのものとする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Assigned(RectForm) then begin
    RectForm.Close;
    FreeAndNil(RectForm);
  end;

  if TreeView1.Items.Count > 1 then begin
    N2Click(nil);
  end;
end;

//=============================================================================
//  [全て展開]ボタン
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(RectForm) then begin
    RectForm.Close;
    FreeAndNil(RectForm);
  end;

  if TreeView1.Items.Count = 0 then exit;

  TreeView1.Items.BeginUpdate;
  TreeView1.FullExpand;
  TreeView1.TopItem := TreeView1.Items[0];
  TreeView1.Items.EndUpdate;
end;

//=============================================================================
//  RadioGroup1のOnClickイベント
//  [ウィンドウ選択]ボタンと同じコードを実行
//=============================================================================
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  [デフォルトアクション実行]ボタン
//  オブジェクトのデフォルト動作を実行
//  全てのオブジェクトに対して有効なわけではない
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  pAccInfo : PplAccInfoRec;
  Acc      : IAccessible;
  ChildID  : Integer;
  varChild : OleVariant;
begin
  if TreeView1.Selected = nil then exit;

  //NodeのDataプロパティからオブジェクトのデータを取出す
  //このデータはレコード型に格納されている
  pAccInfo := TreeView1.Selected.Data;
  Acc      := pAccInfo.pAcc;
  ChildID  := pAccInfo.ChildID;

  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  Acc.accDoDefaultAction(varChild);
end;

//=============================================================================
//  [値のセット]ボタン
//  オブジェクトに対してput_accValue(DelphiではSet_accValue)メソッドを実行
//  オブジェクトに値をセットする.編集可能なオブジェクトが対象
//  全てのオブジェクトに対して有効なわけではない
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  pAccInfo : PplAccInfoRec;
  Acc      : IAccessible;
  ChildID  : Integer;
  StrSet   : WideString;
  varChild : OleVariant;
begin
  if TreeView1.Selected = nil then exit;

  //NodeのDataプロパティからオブジェクトのデータを取出す
  //このデータはレコード型に格納されている
  pAccInfo := TreeView1.Selected.Data;
  Acc      := pAccInfo.pAcc;
  ChildID  := pAccInfo.ChildID;

  //Memo1に入力した値を使用
  StrSet := Memo1.Text;
  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  Acc.Set_accValue(varChild, StrSet);
end;

//=============================================================================
//  TreeView1のOnChangeイベント処理
//
//  TreeView1の選択ノードが変更になったら,プロパティを取得して表示
//=============================================================================
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
  pAccInfo   : PplAccInfoRec;
  Acc        : IAccessible;
  ChildID    : Integer;
  StrText    : WideString;
  varChild   : OleVariant;
  RectWnd    : TRect;
  LineWidth  : Integer;
  LineColor  : TColor;
  ShowFlag   : Cardinal;
begin
  if Node = nil then begin
    TreeView1.PopupMenu := nil;
    exit;
  end else begin
    TreeView1.PopupMenu := PopupMenu2;
  end;

  if not Assigned(RectForm) then begin
    RectForm := TplWindowRectForm.Create(Self);
    RectForm.Show;
    TreeView1.SetFocus;
  end else begin
    RectForm.Canvas.FillRect(RectForm.ClientRect);
  end;
  ShowFlag := SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER;
  SetWindowPos(RectForm.Handle, HWND_TOPMOST, 0, 0, 0, 0, ShowFlag);

  //プロパティをListView1に表示するメソッドを実行
  plEnumAccInfos.AccObjectInfo(ListView1, Node);

  //NodeのDataプロパティからオブジェクトのデータを取出す
  //このデータはレコード型で格納されている
  pAccInfo := Node.Data;
  Acc      := pAccInfo.pAcc;
  ChildID  := pAccInfo.ChildID;

  Memo1.Clear;
  //Valueプロパティの値を取得
  StrText := plEnumAccInfos.GetAccObjectValue(Acc, ChildID);

  //Valueプロパティの値が空の時は,Nameプロパティの値を取得
  //複数行の場合があるのでTMemoに表示
  if Trim(StrText) = '' then begin
    TVariantArg(varChild).vt   := VT_I4;
    TVariantArg(varChild).lVal := ChildID;
    if Acc.get_accName(varChild, StrText) = S_OK then begin
      Memo1.Text := StrText;
      Panel3.Caption := 'Name property';
    end;
  end else begin
    Memo1.Text := StrText;
    Panel3.Caption := 'Value property';
  end;;


  //TreeViewで選択したNodeに該当するオブジェクト囲む枠線を表示
  //サイズと位置を取得
  RectWnd   := plEnumAccInfos.GetAccObjectRect(Acc, ChildID);
  LineWidth := 4;
  LineColor := clRed;

  //枠線を描画
  with RectForm.Canvas do begin
    Pen.Color := LineColor;
    Pen.Width := LineWidth;

    MoveTo (RectWnd.Left,  RectWnd.Top);
    LineTo (RectWnd.Right, RectWnd.Top);
    LineTo (RectWnd.Right, RectWnd.Bottom);
    LineTo (RectWnd.Left,  RectWnd.Bottom);
    LineTo (RectWnd.Left,  RectWnd.Top);
  end;
  Sleep(1);
end;

//=============================================================================
//  TreeView1のOnDeletionイベント処理
//
//  TreeViewのDataプロパティのデータを解放
//=============================================================================
procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode);
begin
  if Assigned(Node.Data) then begin
    Dispose(PplAccInfoRec(Node.Data));
    Node.Data := nil;
  end;
end;

//=============================================================================
//  ListView1のOnSelectItemイベント処理
//  Itemを選択したら,ポップアップメニューを使用可能にする
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Selected then begin
    ListView1.PopupMenu := PopupMenu1;
  end else begin
    ListView1.PopupMenu := nil;
  end;
end;

//=============================================================================
//  ListView1のボップアップメニューの[コピー]
//  PopupMenu1のAutoHotkeysとAutoLineReductionプロパティはmaManual
//=============================================================================
procedure TForm1.N1Click(Sender: TObject);
var
  AIndex  : Integer;
  StrText : String;
begin
  AIndex  := ListView1.ItemIndex;
  StrText := ListView1.Items[AIndex].Caption + Char(VK_TAB) +
             ListView1.Items[AIndex].SubItems[0];
  Clipboard.AsText := StrText;
end;

//=============================================================================
//  TreeView1のボップアップメニューの[このオブジェクトをルートにして再取得]
//  オブジェクトのカテゴリー(OBJID_WINDOW,OBJID_CLIENT)は現在の設定を使用
//  ツリー更新にもこのコードを使用する
//
//  PopupMenu2のAutoHotkeysとAutoLineReductionプロパティはmaManual
//=============================================================================
procedure TForm1.N2Click(Sender: TObject);
var
  pAccInfo : PplAccInfoRec;
  Acc      : IAccessible;
  ChildID  : Integer;
  RootNode : TTreeNode;
begin
  if Assigned(RectForm) then begin
    RectForm.Close;
    FreeAndNil(RectForm);
  end;
  TreeView1.PopupMenu := nil;
  ListView1.PopupMenu := nil;

  Screen.Cursor := crHourGlass;
  TreeView1.Items.BeginUpdate;

  //全体の更新の場合
  //ルートノードに該当するオブジェクトとする
  if Sender = nil then begin
    TreeView1.Selected := TreeView1.Items[0];
  end;

  //NodeのDataプロパティからオブジェクトのデータを取出す
  //このデータはレコード型で格納されている
  pAccInfo := TreeView1.Selected.Data;
  Acc      := pAccInfo.pAcc;
  ChildID  := pAccInfo.ChildID;

  TreeView1.Items.Clear;
  ListView1.Items.Clear;
  Memo1.Lines.Clear;

  //ルートノード
  RootNode := plEnumAccInfos.AddChildNode(Acc, ChildID, TreeView1, nil);

  //EnumAccTreeItems関数は,Acc階層下のオブジェクトを列挙するので子オブジェクト
  //がない場合は実行しない
  if (RootNode <> nil) and (ChildID = 0) then begin
    //列挙実行
    plEnumAccInfos.EnumAccTreeItems(Acc, TreeView1, RootNode);
    RootNode.HasChildren := TreeView1.Items.Count > 1;
    TreeView1.TopItem.Expand(False);
  end;
  TreeView1.Items.EndUpdate;
  Screen.Cursor := crDefault;
end;

end.



次のコードが実際にオブジェクトの階層を検索する関数類です.関数の説明は省略します.上のサンプルコードやコード内のコメントで確認してください.
関数に WideString 型を使用しているのは,Delphi 2007 でも共通に使用可能にするためです.


リスト6
指定ウィンドウまたは指定 IAccessible オブジェクトの階層をツリー表示するための関数類
unit plEnumAccInfos;

interface

uses
  Windows, SysUtils, Forms, ActiveX, OleAcc, Variants, ComCtrls;

type
  //オブジェクトの情報用のレコード型
  //各ノードのDataぷパティに代入する
  TplAccInfoRec = record
    ChildID : Integer;
    pAcc    : IAccessible;
  end;
  PplAccInfoRec = ^TplAccInfoRec;

  //公開関数類
  procedure EnumAccObjectTree(hWindow: HWND; Tree: TTreeView; dwID: Cardinal);
  procedure EnumAccTreeItems(Acc: IAccessible; ATree: TTreeView; ANode: TTreeNode);
  function AddChildNode(AccChild: IAccessible; ChildID: Integer; ATree: TTreeView;
    ANode: TTreeNode): TTreeNode;
  procedure AccObjectInfo(LV : TListView; Node: TTreeNode);
  function GetAccObjectValue(Acc: IAccessible; ChildID: Integer): String;
  function GetAccObjectRect(Acc: IAccessible; ChildID: Integer): TRect;
  function IsAccObjectVisible(Acc: IAccessible; ChildID: Integer): Boolean;

  //以下の関数は,Delphi XEにないので定義
  function WindowFromAccessibleObject(paccContainer: IAccessible; var phwnd: HWND):
    HRESULT;stdcall; external 'oleacc.dll';
  function AccessibleChildren(paccContainer: IAccessible; iChildStart,
    cChildren: Longint; rgvarChildren: PVariantArg;
    pcObtained: PLongint): HRESULT; stdcall; external 'oleacc.dll';
  function AccessibleObjectFromPoint(ptScreen: TPoint; out ppacc: IAccessible;
    out pvarChild): HRESULT; stdcall; external 'oleacc.dll';
  function GetRoleTextW(dwRole: DWORD; lpszRole: PWideChar;
    cchRoleMax: UINT): UINT; stdcall; external 'oleacc.dll';
  function GetStateTextW(dwStateBit: DWORD; lpszStateBit: PWideChar;
    cchStateBitMax: UINT): UINT; stdcall; external 'oleacc.dll';

implementation

var
  //可視状態のオブジェクトのみを対象とする
  OnlyVisible : Boolean = True;

//=============================================================================
//  ハンドル値がhWindowのウィンドウのオブジェクトを再帰的に検索して列挙
//  TreeViewのNodeに追加していく
//
//  hWindow     : ウィンドウのハンドル
//  Tree        : TreeView
//  dwID        : オブジェクトのカテゴリー
//=============================================================================
procedure EnumAccObjectTree(hWindow: HWND; Tree: TTreeView; dwID: Cardinal);
var
  oAccessible : IAccessible;
  RootNode    : TTreeNode;
begin
  Tree.Items.Clear;

  //ウィンドウハンドルからIAccessibleオブジェクトを取得
  if AccessibleObjectFromWindow(hWindow,
                                dwID,
                                IID_IAccessible,
                                Pointer(oAccessible)) <> S_OK then exit;

  //ルートノード
  RootNode := AddChildNode(oAccessible, CHILDID_SELF, Tree, nil);

  Tree.Items.BeginUpdate;
  //列挙実行
  EnumAccTreeItems(oAccessible, Tree, RootNode);
  Tree.Items.EndUpdate;
  Tree.TopItem.Expand(False);
end;

//=============================================================================
//  Acc階層下の子オブジェクトを列挙
//  TreeViewにツリー表示する
//=============================================================================
procedure EnumAccTreeItems(Acc: IAccessible; ATree: TTreeView; ANode: TTreeNode);
var
  Children   : array of TVariantArg;
  ChildCount : Integer;
  Obtained   : Integer;
  AccChDisp  : IDispatch;
  AccChild   : IAccessible;
  ChildID    : Integer;
  i          : Integer;
  j          : Integer;
  AddNode    : TTreeNode;
  HasChild   : Integer;
begin
  if Acc = nil then exit;

  //子オブジェクトの数を調べる
  if (Acc.get_accChildCount(ChildCount) = S_OK) then begin
    Application.ProcessMessages;
    SetLength(Children, ChildCount);

    //バリアント配列の初期化
    for i := 0 to ChildCount - 1 do begin
      VariantInit(OleVariant(Children[i]));
    end;

    //アクセス可能な子オブジェクトの数を調査
    if AccessibleChildren(Acc, 0, ChildCount, @Children[0], @Obtained) = S_OK
        then begin
      for j := 0 to Obtained - 1 do begin
        HasChild := -1;
        ChildID  := CHILDID_SELF;

        //子オブジェクトがある
        if Children[j].vt = VT_DISPATCH then begin
          AccChDisp := IDispatch(Children[j].pdispVal);
          if Assigned(AccChDisp) then begin
            AccChDisp.QueryInterface(IID_IAccessible, AccChild);
            ChildID  := CHILDID_SELF;
            HasChild := 1;
          end;
        end else begin
          if Children[j].vt = VT_I4 then begin
            //子オブジェクトはない
            if Acc.get_accChild(OleVariant(Children[j]), AccChDisp) = S_FALSE
                then begin
              AccChild := Acc;
              ChildID  := Children[j].lVal;
              HasChild := 0;
            end else begin
               //子オブジェクトがある
              if Assigned(AccChDisp) then begin
                AccChDisp.QueryInterface(IID_IAccessible, AccChild);
                ChildID  := CHILDID_SELF;
                HasChild := 1;
              end;
            end;
          end;
        end;

        //処理を1か所にまとめるためにHasChildをフラグとして使用
        if HasChild >= 0 then begin
          AddNode := AddChildNode(AccChild, ChildID, ATree, ANode);
          if (AddNode <> nil) and (HasChild = 1) then begin
            EnumAccTreeItems(AccChild, ATree, AddNode);
          end;
        end;
      end;
    end;
    //バリアント配列の後始末
    for i := 0 to Obtained - 1 do begin
      VariantClear(OleVariant(Children[i]));
    end;
  end;
end;

//=============================================================================
//  以下の処理を行う関数
//
//  TreeViewのノードに表示するテキスト作成
//  TreeViewにノードを追加
//  ノードのDataプロパティにオブジェクトの情報を,レコード型で代入
//
//  戻り値は,追加したノードのインスタンス
//  非可視のオブジェクトはノードに追加しないで,戻り値にnilを返す
//=============================================================================
function AddChildNode(AccChild: IAccessible; ChildID: Integer; ATree: TTreeView;
  ANode: TTreeNode): TTreeNode;
var
  AName    : WideString;
  varRole  : OleVariant;
  Len      : Cardinal;
  TmpStr   : WideString;
  varID    : OleVariant;
  StrText  : WideString;
  pAccInfo : PplAccInfoRec;
begin
  Result  := nil;
  StrText := '';

  //可視状態のオブジェクトのみの場合,非可視のオブジェクトは追加しない
  if OnlyVisible then begin
    if not IsAccObjectVisible(AccChild, ChildID) then exit;
  end;

  //Role(オブジェクトの機能,役割)プロパティを文字列として取得
  TVariantArg(varID).vt   := VT_I4;
  TVariantArg(varID).lVal := ChildID;
  if AccChild.get_accRole(varID, varRole) = S_OK then begin
    if TVariantArg(varRole).vt = VT_I4 then begin
      Len := GetRoleTextW(TVariantArg(varRole).lVal, nil, 0);
      SetLength(TmpStr, Len);
      GetRoleTextW(TVariantArg(varRole).lVal, PWideChar(TmpStr), Len + 1);
      StrText := '[' + TmpStr + ']';
    end else begin
      StrText := '[' + String(varRole) + ']';
    end;
  end else begin
    StrText := '[]';
  end;

  //Nameプロパティを取得して追加
  //Roleプロパティの文字列の後ろに追加
  if AccChild.get_accName(varID, AName) <> S_OK then AName := '';
  StrText := StrText + ' "' + AName + '"';

  //オブジェクトが可視か非可視かの文字列を追加
  //もしかしたら,非可視のオブジェクトもツリー表示するテストをしたい人がいるかも
  //しれないので追加
  if not OnlyVisible then begin
    if IsAccObjectVisible(AccChild, ChildID) then begin
      StrText := StrText + ' ' + 'Visible';
    end else begin
      StrText := StrText + ' ' + 'InVisible';
    end;
  end;

  Result := ATree.Items.AddChild(ANode, StrText);

  //NodeのDataプロパティにオブジェクトの情報を代入
  if Result <> nil then begin
    New(pAccInfo);
    pAccInfo.ChildID := ChildID;
    pAccInfo.pAcc    := AccChild;
    Result.Data      := pAccInfo;
  end;
end;

//=============================================================================
//  オブジェクトのプロパティの値を取得して,ListViewに追加していく
//  get_accFocus関数とget_accSelection関数による値は省略
//
//  ListViewのViewStyleがvsReportで,カラムが2つあると仮定している時のコード
//=============================================================================
procedure AccObjectInfo(LV : TListView; Node: TTreeNode);

  //---------------------------------------------------------------------------
  //  ウィンドウのクラス名を取得する関数
  //---------------------------------------------------------------------------
  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;

  //---------------------------------------------------------------------------
  //  ListViewにItemを追加するメソッド
  //---------------------------------------------------------------------------
  procedure ListViewItemAdd(LV: TListView; ACaption, SubItem: String);
  var
    LVItem : TListItem;
  begin
    LVItem               := LV.Items.Add;
    LVItem.Caption       := ACaption;
    LVItem.SubItems.Text := SubItem;
  end;
  //---------------------------------------------------------------------------

var
  pAccInfo : PplAccInfoRec;
  Acc      : IAccessible;
  ChildID  : Integer;
  hWindow  : HWND;
  StrText  : WideString;
  ATop     : Integer;
  ALeft    : Integer;
  AWidth   : Integer;
  AHeight  : Integer;
  varChild : OleVariant;
  varState : OleVariant;
  varRole  : OleVariant;
  TmpInt   : Integer;
  Len      : Cardinal;
  i        : Integer;
  StateID  : Integer;
  TmpStr   : String;
begin
  if Node.Data = nil then exit;

  LV.Items.Clear;
  //NodeのDataプロパティからオブジェクトのデータを取出す
  pAccInfo := Node.Data;
  Acc      := pAccInfo.pAcc;
  ChildID  := pAccInfo.ChildID;

  LV.Items.BeginUpdate;

  StrText := '';
  hWindow := 0;
  if WindowFromAccessibleObject(Acc, hWindow) = S_OK then begin
    ListViewItemAdd (LV, 'Class Name', GetClassNameStr(hWindow));
  end;

  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  if Acc.Get_accName(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Name', StrText);
  end else begin
    ListViewItemAdd (LV, 'Name', '-');
  end;

  StrText := '-';
  if Acc.get_accRole(varChild, varRole) = S_OK then begin
    if TVariantArg(varRole).vt = VT_I4 then begin
      Len := GetRoleTextW(TVariantArg(varRole).lVal, nil, 0);
      SetLength(StrText, Len);
      GetRoleTextW(TVariantArg(varRole).lVal, PWideChar(StrText), Len + 1);
    end;
  end;
  ListViewItemAdd (LV, 'Role', StrText);

  if Acc.accLocation(ALeft, ATop, AWidth, AHeight, varChild) = S_OK then begin
    if AWidth * AHeight <> 0 then begin
      StrText := '( ' + IntToStr(ALeft) + ', ' +
                        IntToStr(ATop)  + ', ' +
                        IntToStr(ALeft  + AWidth)  + ', ' +
                        IntToStr(ATop   + AHeight) + ' )';
      ListViewItemAdd (LV, 'Location', StrText);
    end else begin
      ListViewItemAdd (LV, 'Location', '-');
    end;
  end else begin
    ListViewItemAdd (LV, 'Location', '-');
  end;

  //Get_accChildCount関数で取得すると非可視のオブジェクトも含まれるので
  //ここではTreeViewの子ノードの数を表示
  ListViewItemAdd (LV, 'ChildCount', IntToStr(Node.Count));

  if Acc.Get_accDefaultAction(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'DefaultAction', StrText);
  end else begin
    ListViewItemAdd (LV, 'DefaultAction', '-');
  end;

  if Acc.Get_accDescription(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Description', StrText);
  end else begin
    ListViewItemAdd (LV, 'Description', '-');
  end;

  if Acc.Get_accHelp(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Help', StrText);
  end else begin
    ListViewItemAdd (LV, 'Help', '-');
  end;

  if Acc.Get_accHelpTopic(StrText, varChild, TmpInt) = S_OK then begin
    ListViewItemAdd (LV, 'HelpTopic', StrText + ' ( ' + IntToStr(TmpInt) + ' )');
  end else begin
    ListViewItemAdd (LV, 'HelpTopic', '-');
  end;

  if Acc.Get_accKeyboardShortcut(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'KeyboardShortcut', StrText);
  end else begin
    ListViewItemAdd (LV, 'KeyboardShortcut', '-');
  end;

  //Stateプロパティの値を取得して,GetStateTextW関数で説明文字列に変換
  //Stateは複数の場合がある
  //Stateプロパティの値が2の倍数で増加していくことを利用してループ処理
  StrText := '';
  StateID := 1;
  if Acc.Get_accState(varChild, varState) = S_OK then begin
    if TVariantArg(varState).vt = VT_I4 then begin
      TmpInt := TVariantArg(varState).lVal;
      for i := 1 to 29 do begin
        if (TmpInt and StateID) <> 0 then begin
          Len := GetStateTextW(StateID, nil, 0);
          SetLength(TmpStr, Len);
          GetStateTextW(StateID, PWideChar(TmpStr), Len);
          StrText := StrText + Trim(TmpStr) + '。' ;
        end;
        StateID := StateID * 2;
      end;
    end;
  end;
  ListViewItemAdd (LV, 'State', StrText);

  //最初の1行のみの表示となる(出力先がTListViewなので複数行表示は不可)
  if Acc.Get_accValue(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Value', StrText);
  end else begin
    ListViewItemAdd (LV, 'Value', '-');
  end;

  ListViewItemAdd (LV, 'ChildID', IntToStr(ChildID));

  LV.Items.EndUpdate;
end;

//=============================================================================
//  Valueプロパティ取得専用の関数
//=============================================================================
function GetAccObjectValue(Acc: IAccessible; ChildID: Integer): String;
var
  varChild : OleVariant;
  StrText  : WideString;
begin
  Result := '';

  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  if Acc.Get_accValue(varChild, StrText) = S_OK then begin
    Result := StrText;
  end;
end;

//=============================================================================
//  オブジェクトの位置とサイズを,TRectレコード型に取得する関数
//=============================================================================
function GetAccObjectRect(Acc: IAccessible; ChildID: Integer): TRect;
var
  ATop     : Integer;
  ALeft    : Integer;
  AWidth   : Integer;
  AHeight  : Integer;
  varChild : OleVariant;
begin
  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  if Acc.accLocation(ALeft, ATop, AWidth, AHeight, varChild) = S_OK then begin
    Result.Top    := ATop;
    Result.Left   := ALeft;
    Result.Right  := ALeft + AWidth;
    Result.Bottom := ATop  + AHeight;
  end;
end;

//=============================================================================
//  オブジェクトの可視状態を取得する関数
//  可視状態ならTrue,非可視であればFlaseを返す
//  MSDNによれば,この値は必ずしも正確ではないようだ
//  親オブジェクトの状態も考慮すべきとある
//=============================================================================
function IsAccObjectVisible(Acc: IAccessible; ChildID: Integer): Boolean;
var
  varChild : OleVariant;
  varState : OleVariant;
  VState   : Cardinal;
begin
  Result := True;

  TVariantArg(varChild).vt   := VT_I4;
  TVariantArg(varChild).lVal := ChildID;

  if Acc.Get_accState(varChild, varState) = S_OK then begin
    if TVariantArg(varState).vt = VT_I4 then begin
      VState :=  TVariantArg(varState).lVal;
      Result := (VState and STATE_SYSTEM_INVISIBLE) = 0;
    end;
  end;
end;

end.




05_オブジェクトのイベントフック - エクセルの起動と終了等を監視


IAccessible のイベントをフックするサンプルです.イベントのフックは,
  • (1) SetWinEventHook 関数でコールバック関数を指定してフックを開始
  • (2) コールバック関数内で処理を行う
    必要であれば,AccessibleObjectFromEvent 関数を使用する
  • (3) UnhookWinEvent 関数でフックを終了する
という手順になります.ここでは,アプリケーションの起動,終了,ウインドウの最小化を監視します.対象アプリをエクセルとしました.この他,どのようなことが可能であるかは,オブジェクトの階層をツリー表示のサンプルを操作して確認してください.


図9
設計時画面
図10
実行例
  • フック開始後,最初に起動したエクセルが監視対象

リスト7
エクセルの起動,終了,ウィンドウの最小化を監視
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;
    hTargetWnd : HWND;
  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 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のコールバック関数
//
//  AccessibleObjectFromEventは使う必要がなければ使わない方がよい
//  オブジェクトの数が多いアプリだと,初回の処理に時間がかかることがある
//  ここではサンプルとして,使用する場面を考慮して書いてある
//-----------------------------------------------------------------------------
procedure WinEventProc(hWinEventHook: THandle; event: DWORD; hwnd: HWND;
  idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;
var
  acc      : IAccessible;
  varChild : OleVariant;
begin
  //イベントの引数からAcc(IAccessible)とvarChild(OleVariant)を取得
  //このサンプルでは,実際にはこれらの値を使用していない
  if AccessibleObjectFromEvent(hwnd, idObject, idChild, acc, varChild) = S_OK
    then begin

    if Form1.hTargetWnd = 0 then begin
      if GetClassNameStr(hwnd) = 'XLMAIN' then begin
        if event = EVENT_OBJECT_CREATE then begin
          Form1.hTargetWnd := hwnd;
          Form1.Memo1.Lines.Add('エクセルが起動しました');
        end;
      end;
    end else begin
      if Form1.hTargetWnd = hwnd then begin
        if event = EVENT_SYSTEM_MINIMIZESTART then begin
          Form1.Memo1.Lines.Add('エクセル最小化されました');
        end else
        if event = EVENT_SYSTEM_MINIMIZEEND then begin
          Form1.Memo1.Lines.Add('エクセルが元のサイズに戻りました');
        end;
      end else
      if Form1.hTargetWnd <> 0 then begin
        if GetClassNameStr(Form1.hTargetWnd) = '' then begin
          Form1.hTargetWnd := 0;
          Form1.Memo1.Lines.Add('エクセルが終了しました');
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  [Start HOOK] フック開始
//  hTargetWnd  : 対象アプリのハンドル(このサンプルではエクセル)
//  hEventHook  : フックのハンドル
//
//  このサンプルでは,フック開始後,最初に起動したエクセルだけを対象にしている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  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('フック開始');
      Memo1.Lines.Clear;
    end;
  end;
end;

//=============================================================================
//  [Stop HOOK] フックの終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if hEventHook = 0 then begin
    Memo1.Lines.Add('フックは終了しています');
  end else begin
    UnhookWinEvent(hEventHook);
    hEventHook := 0;
    hTargetWnd := 0;
    Memo1.Lines.Add('フック終了');
  end;
end;

//=============================================================================
//  フォームの作成時 変数の初期化
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  hEventHook := 0;
  hTargetWnd := 0;
end;

//=============================================================================
//  フォームを閉じる時は,フックを終了させる
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if hEventHook <> 0 then UnhookWinEvent(hEventHook);
end;

end.




06_マウスカーソル下のオブジェクトの情報


今度は,マウスカーソル下のオブジェクトの情報を取得してみます.
マウスカーソル下ですから,本来はマウスフックということになりますが,無理やり IAccessible のフックを使ってみることにします.

前のサンプルの [オブジェクトの階層をツリー表示] では,ツリー表示のオブジェクト名をマウスで選択し,そのオブジェクトを赤い枠線で囲みましたが,その逆の動作とも言えます.

IAccessible のフックでは,マウスの移動を捕らえることはできません.そこで,フックのコールバック関数内で,GetCursorPos 関数でマウスカーソル位置を取得して処理しています.
全画面サイズの透明なフォームを表示します.このフォームに.マウスカーソル下のオブジェクトを赤い枠線で表示するようにしています.また,[F11] キーをホットキーに登録しています,したがって,[F11] を押すとフックが終了して,そのオブジェクトの情報を確認することができます.

[370] キャプチャの範囲 - [マウスカーソル下のオブジェクト]] では,この方法を利用して,マウスカーソル下のオブジェクトのキャプチャを実装しています.




図11
設計時画面
図12
マウスカーソル下の情報実行例
  • 対象のオブジェクトを赤い枠線で表示
  • [Stop Hook] または [F11] キーで終了

リスト8
マウスカーソル下のオブジェクトを赤い枠線で表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, OleAcc, ActiveX, plWindowRectFormUnit;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListView1: TListView;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  protected
    procedure WMHotKey(var Message: TWMHotKey); message WM_HOTKEY;
  private
    { Private 宣言 }
    hEventHook     : THandle;
    RectForm       : TplWindowRectForm;
    hRectFormWnd   : HWND;
    OldRectWnd     : TRect;
    FlagEvent      : Boolean;
    RegistHotKeyID : Integer;
    procedure AccObjectInfoToListView(Acc: IAccessible; varChild: OleVariant;
      LV: TListView);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$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 WindowFromAccessibleObject(paccContainer: IAccessible; var phwnd: HWND):
  HRESULT;stdcall; external 'OLEACC.DLL';
function GetRoleTextW(dwRole: DWORD; lpszRole: PWideChar;
  cchRoleMax: UINT): UINT; stdcall; external 'OLEACC.DLL';


//-----------------------------------------------------------------------------
//  フック関数SetWinEventHookのコールバック関数
//
//  マウスポイント下のオブジェクトを検出して,そのオブジェクトを囲む矩形を描画
//-----------------------------------------------------------------------------
procedure WinEventProc(hWinEventHook: THandle; event: DWORD; hwnd: HWND;
  idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;

  //---------------------------------------------------------------------------
  //  関数内関数
  //  オブジェクトAccの位置とサイズを取得
  //---------------------------------------------------------------------------
  function GetAccObjectRect(Acc: IAccessible; varChild: OleVariant): TRect;
  var
    ATop    : Integer;
    ALeft   : Integer;
    AWidth  : Integer;
    AHeight : Integer;
  begin
    if Acc.accLocation(ALeft, ATop, AWidth, AHeight, varChild) = S_OK then begin
      Result := Rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight);
    end else begin
      SetRectEmpty(Result);
    end;
  end;
  //---------------------------------------------------------------------------

var
  MousePos   : TPoint;
  pAcc       : IAccessible;
  varChild   : OleVariant;
  hTargetWnd : Windows.HWND;
  RectAcc    : TRect;
  LineWidth  : Integer;
  LineColor  : TColor;
begin
  //イベント内の処理中は,イベント処理をしない
  if Form1.FlagEvent then exit;
  Form1.FlagEvent  := True;

  //マウスカーソル位置を取得
  GetCursorPos(MousePos);

  //マウスカーソル位置のIAccessibleオブジェクトを取得
  //AccessibleObjectFromPoint関数の戻り値のvarChildのvtは,常にVT_I4となっている
  if AccessibleObjectFromPoint(MousePos, pAcc, varChild) = S_OK then begin

    //オブジェクトのサイズと位置を検出して,前のサイズと位置が異なっていれば処理
    RectAcc := GetAccObjectRect(pAcc, varChild);
    if not EqualRect(RectAcc, Form1.OldRectWnd) then begin

      //このサンプルでは,オブジェクトを囲む矩形描画に透明なフォームを使用している
      //このフォームを対象外とするため,マウスカーソル下のハンドルを比較
      //オブジェクトを囲む矩形描画用のフォームだったら処理しない
      if WindowFromAccessibleObject(pAcc, hTargetWnd) = S_OK then begin
        if hTargetWnd <> Form1.hRectFormWnd then begin
          Form1.OldRectWnd := RectAcc;
          Form1.RectForm.Canvas.FillRect(Form1.RectForm.ClientRect);

          //枠線のサイズと色を指定して描画
          LineWidth := 4;
          LineColor := clRed;
          with Form1.RectForm.Canvas do begin
            Pen.Color := LineColor;
            Pen.Width := LineWidth;

            MoveTo (RectAcc.Left,  RectAcc.Top);
            LineTo (RectAcc.Right, RectAcc.Top);
            LineTo (RectAcc.Right, RectAcc.Bottom);
            LineTo (RectAcc.Left,  RectAcc.Bottom);
            LineTo (RectAcc.Left,  RectAcc.Top);
          end;
          //ListViewにオブジェクトの情報を表示
          Form1.AccObjectInfoToListView(pAcc, varChild, Form1.ListView1);
          Form1.RectForm.BringToFront;
        end;
      end;
    end;
  end;

  Form1.FlagEvent := False;
  varChild := Unassigned;
end;

//=============================================================================
//  このフォームのOnCreateイベント
//  フォームの作成時 変数の初期化
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  hEventHook := 0;

  Button1.Enabled := True;
  Button2.Enabled := False;
end;

//=============================================================================
//  このフォームのOnCloseQueryイベント
//  フォームを閉じる時は,フックを終了させる
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Button2Click(nil);
end;

//=============================================================================
//  WM_HOTKEYメッセージ処理
//  登録したホットキーを検出したら,フック終了
//=============================================================================
procedure TForm1.WMHotKey(var Message: TWMHotKey);
begin
  if Message.HotKey = RegistHotKeyID then begin
    Button2Click(nil);
  end;
end;

//=============================================================================
//  [Start HOOK]ボタン
//  フック開始
//  hEventHook   : フックのハンドル
//  hRectFormWnd : オブジェクトを囲む枠線を描画するためのフォームのハンドル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetRectEmpty(OldRectWnd);
  FlagEvent := False;

  ListView1.Items.Clear;
  if hEventHook = 0 then begin
    hEventHook := SetWinEventHook(
                             EVENT_MIN,
                             EVENT_MAX,
                             0,
                             WinEventProc,
                             0,
                             0,
                             WINEVENT_OUTOFCONTEXT);
    if hEventHook = 0 then begin
      MessageDlg('フック関数の登録失敗', mtInformation, [mbOK], 0);
    end else begin
      //オブジェクトの周囲を囲む枠線用のフォームを作成して表示
      //このフォームは透明なので,実際には見えない
      if not Assigned(RectForm) then begin
        RectForm := TplWindowRectForm.Create(Self);
        RectForm.Show;
        Sleep(100);
        //そのフォームのハンドルを取得しておく
        hRectFormWnd := FindWindow('TplWindowRectForm', nil);
      end else begin
        //表示中であれば,オブジェクトを囲む枠線を消去
        RectForm.Canvas.FillRect(RectForm.ClientRect);
      end;

      Button1.Enabled := False;
      Button2.Enabled := True;

      //アトムテーブルに文字列(ホットキーを識別する文字列)を登録
      //以後のホットキーの操作はこのResistHokkeyで行うことになる
      RegistHotKeyID := GlobalAddAtom('plObjectInfoUnderMouse');

      //ホットキーにとして[F11]を登録
      //本サンプルが終了するとこの設定は無効となる
      RegisterHotkey(Handle, RegistHotKeyID, 0, VK_F11);
    end;
  end;
end;

//=============================================================================
//  [Stop HOOK]ボタン
//  フックの終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  UnhookWinEvent(hEventHook);
  hEventHook := 0;
  FlagEvent  := False;

  Button1.Enabled := True;
  Button2.Enabled := False;

  if RegistHotKeyID <> 0 then begin
    //アトムテーブルから関連した文字列を削除
    GlobalDeleteAtom(RegistHotKeyID);
    //ホットキーの登録解除
    UnregisterHotKey(Handle, RegistHotKeyID);
  end;

  //オブジェクトの周囲を囲む枠線用のフォームを解放
  if Assigned(RectForm) then begin
    RectForm.Close;
    FreeAndNil(RectForm);
  end;
end;

//=============================================================================
//  ListViewにオブジェクトAccの情報を取得して表示
//
//  ListView1のViewStyleはvsReportで,カラムは2つ
//  ListView1.Columns[1].AutoSize := Trueにしている
//=============================================================================
procedure TForm1.AccObjectInfoToListView(Acc: IAccessible; varChild: OleVariant;
  LV: TListView);

  //---------------------------------------------------------------------------
  //  関数内関数
  //  ウィンドウのクラス名を取得する関数
  //---------------------------------------------------------------------------
  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;

  //---------------------------------------------------------------------------
  //  関数内関数
  //  ListViewにItemを追加するメソッド
  //---------------------------------------------------------------------------
  procedure ListViewItemAdd(LV: TListView; ACaption, SubItem: String);
  var
    LVItem : TListItem;
  begin
    LVItem               := LV.Items.Add;
    LVItem.Caption       := ACaption;
    LVItem.SubItems.Text := SubItem;
  end;
  //---------------------------------------------------------------------------

var
  hWindow : HWND;
  StrText : WideString;
  ATop    : Integer;
  ALeft   : Integer;
  AWidth  : Integer;
  AHeight : Integer;
  varRole : OleVariant;
  Len     : Cardinal;
begin
  LV.Items.Clear;

  LV.Items.BeginUpdate;

  //このオブジェクトを有するウィンドウのハンドル
  StrText := '';
  hWindow := 0;
  if WindowFromAccessibleObject(Acc, hWindow) = S_OK then begin
    ListViewItemAdd (LV, 'Class Name', GetClassNameStr(hWindow));
  end;

  //Roleプロパティ
  StrText := '-';
  if Acc.get_accRole(varChild, varRole) = S_OK then begin
    if TVariantArg(varRole).vt = VT_I4 then begin
      Len := GetRoleTextW(TVariantArg(varRole).lVal, nil, 0);
      SetLength(StrText, Len);
      GetRoleTextW(TVariantArg(varRole).lVal, PWideChar(StrText), Len + 1);
    end;
  end;
  ListViewItemAdd (LV, 'Role', StrText);

  //Nameプロパティ
  if Acc.Get_accName(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Name', StrText);
  end else begin

    ListViewItemAdd (LV, 'Name', '-');
  end;

  //Valueプロパティ
  if Acc.Get_accValue(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Value', StrText);
  end else begin
    ListViewItemAdd (LV, 'Value', '-');
  end;

  //Descriptionプロパティ
  if Acc.Get_accDescription(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'Description', StrText);
  end else begin
    ListViewItemAdd (LV, 'Description', '-');
  end;

  //オブジェクトの幅と高さ
  AWidth  := 0;
  AHeight := 0;
  if Acc.accLocation(ALeft, ATop, AWidth, AHeight, varChild) = S_OK then begin
    ListViewItemAdd (LV, 'X',  IntToStr(ALeft));
    ListViewItemAdd (LV, 'Y',  IntToStr(ATop));
    ListViewItemAdd (LV, 'Width',  IntToStr(AWidth));
    ListViewItemAdd (LV, 'Height', IntToStr(AHeight));
  end;

  if Acc.Get_accDefaultAction(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'DefaultAction', StrText);
  end else begin
    ListViewItemAdd (LV, 'DefaultAction', '-');
  end;

  //キーボードショートカット
  if Acc.Get_accKeyboardShortcut(varChild, StrText) = S_OK then begin
    ListViewItemAdd (LV, 'KeyboardShortcut', StrText);
  end else begin
    ListViewItemAdd (LV, 'KeyboardShortcut', '-');
  end;

  varRole := Unassigned;
  LV.Items.EndUpdate;
  Sleep(1);
end;

end.


下のコードが,オブジェクトの周囲に赤い枠線を描画するフォームのコードです.
このフォームは透明にしています.マウスイベントは捕捉できません.マウスイベントも透過してしまいます.

このフォームの OnPaint イベント内で赤い枠線を描画した方が効率がいいかも知れません. この透明なフォームは,タスクバー上のオブジェクトも選択可能にするために,常に最前面に表示するようにしています.ただし,同じ様に,常に最前面に表示するようなアプリケーションが起動している場合,動作の保障はありません.



[備考]
透明なフォームでも描画はできるわけです.したがって,見かけ上は「デスクトップにお絵かき」といったこともできます.しかも,意識的に消去しないかぎり,永続的に描画内容を表示できます.マウスやキーイベントは透過してしまいますから,グローバルフックを使用しないと捕捉できません.



リスト9
オブジェクトの周囲に赤い枠線を描画するための透明なフォーム
全画面表示で,タスクバー上にも表示する
unit plWindowRectFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TplWindowRectForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    OriginalProc: TWndMethod;
    procedure SubClassProc(var Message: TMessage);
  public
    { Public 宣言 }
  end;

var
  plWindowRectForm: TplWindowRectForm;

implementation

{$R *.dfm}

//=============================================================================
//  元のWindowsProcを退避して新しいWindowProcを定義
//  この設定は用途によってはOnShowで設定する必要があるかも知れない
//  OnShow設定の場合は,OnCloseでWindowProcを元に戻しておいた方がいいだろう
//
//  このフォームはオブジェクトインスペクタで以下の設定をしている
//  この設定は,タスクバーの上にもこのフォームを重ねて表示する
//    RectForm.BorderIcons           := [biSystemMenu];
//    RectForm.BorderStyle           := bsNone;
//    RectForm.Color                 := clWhite;
//    RectForm.FormStyle             := fsStayOnTop;
//    RectForm.Position              := poDesigned;
//    RectForm.TransparentColor      := True;
//    RectForm.TransparentColorValue := clWhite;
//    RectForm.WindowState           := wsMaximized;
//=============================================================================
procedure TplWindowRectForm.FormCreate(Sender: TObject);
begin
  SetWindowLong(Handle, GWL_STYLE, WS_POPUP);

  OriginalProc    := Self.WindowProc;
  Self.WindowProc := SubClassProc;
end;

//=============================================================================
//  WindowsProcを元に戻しておく
//  このサンプルではOnCreateでWindowProcを設定しているので実際には不要
//=============================================================================
procedure TplWindowRectForm.FormDestroy(Sender: TObject);
begin
  Self.WindowProc := OriginalProc;
end;

//=============================================================================
//  WindowProcのサブクラス関数
//  このフォームがZオーダのトップかを監視して設定
//=============================================================================
procedure TplWindowRectForm.SubClassProc(var Message: TMessage);

  //Targetが最前面かを判定する関数
  function IsTopMost(Target: HWND): boolean;
  begin
    Result := ((GetWindowLong(Target, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0);
  end;

begin
  //元のWindowProcを実行
  OriginalProc(Message);

  //このフォームが最前面でなければ最前面にする
  if IsTopMost(Self.Handle) = False then begin
    SetWindowPos(Self.Handle,
                 HWND_TOPMOST,
                 0,
                 0,
                 0,
                 0,
                 SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER);
  end;
end;

end.




07_SetWinEventHook 関数と UnhookWinEvent 関数


上のサンプルで使用している,フックの登録と解除の関数の引数と定数値の説明です.
詳しい内容は,参考リンク等,MSDNの記事を参考にしてください.



SetWinEventHook (eventMin,
                 eventMax,
                 hmodWinEventProc,
                 pfnWinEventProc,
                 idProcess,
                 idThread,
                 dwFlags): THandle


引数 説明
eventMin DWORD 表 1 の何れかの値.検出するイベント定数の最小値
eventMax DWORD 表 1 のいずれかの値.検出するイベント定数の最大値
hmodWinEventProc HMODULE コールバック関数がDLL内にある場合は,DLLのハンドル
それ以外は0とする
pfnWinEventProc TFNWinEventProc コールバック関数へのポインタ
idProcess DWORD イベントを検出するプロセスの ID の指定
0 にすると現在のデスクトップ上の全てが対象
idThread DWORD イベントを検出するスレッドの ID の指定
0 にすると,現在のデスクトップ上の全てが対象
dwFlags DWORD フック関数の場所と,イベントスキップ動作の指定
表 2 の値の組み合わせ
戻り値 THandle フック関数のハンドル
フック解除時に,UnhookWinEvent 関数の引数に使用


UnhookWinEvent (hWinEventHook): BOOL 

引数 説明
hWinEventHook THandle SetWinEventHook 関数の戻り値を与える
戻り値 BOOL 成功した場合は True.それ以外は False を返す


表1
イベントの定数値
Delphi XE の Windows.pas 内の定義リスト (EVENT_MINとEVENT_MAX 以外は値の小さい順)
UIA 関係 (Microsoft Windows User Interface Automation) は除く

EVENT_MIN ( = $00000001 )
EVENT_MAX ( = $7FFFFFFF )
イベント値の最小値と最大値.この値を指定すると,可能な全てのイベント検出となる

EVENT_SYSTEM_SOUND サウンドの再生
EVENT_SYSTEM_ALERT アラートの生成
EVENT_SYSTEM_FOREGROUND フォアグラウンドウィンドウの変更
EVENT_SYSTEM_MENUSTART メニューバーのメニュー項目の選択
EVENT_SYSTEM_MENUEND メニューバーからメニューが閉じられる
EVENT_SYSTEM_MENUPOPUPSTART ポップアップメニューの表示
EVENT_SYSTEM_MENUPOPUPEND ポップアップメニューが閉じるイベント
EVENT_SYSTEM_CAPTURESTART マウスキャプチャの開始
EVENT_SYSTEM_CAPTUREEND マウスキャプチャの解除
EVENT_SYSTEM_MOVESIZESTART ウィンドウの移動またはサイズ変更
EVENT_SYSTEM_MOVESIZEEND ウィンドウの移動やサイズ変更完了
EVENT_SYSTEM_CONTEXTHELPSTART コンテキスト依存ヘルプモード開始
EVENT_SYSTEM_CONTEXTHELPEND コンテキスト依存ヘルプモードの終了
EVENT_SYSTEM_DRAGDROPSTART ドラッグアンドドロップモードの開始
EVENT_SYSTEM_DRAGDROPEND ドラッグアンドドロップモードの終了
EVENT_SYSTEM_DIALOGSTART ダイアログボックスの表示
EVENT_SYSTEM_DIALOGEND ダイアログボックスの閉じるイベント
EVENT_SYSTEM_SCROLLINGSTART スクロールバーのスクロール開始
EVENT_SYSTEM_SCROLLINGEND スクロールバーのスクロール終了
EVENT_SYSTEM_SWITCHSTART [Alt] + [Tab] キー押下の検出
EVENT_SYSTEM_SWITCHEND [Alt] + [Tab] キー操作により切換えの検出
EVENT_SYSTEM_MINIMIZESTART ウィンドウの最小化
EVENT_SYSTEM_MINIMIZEEND ウィンドウの最小化からの復元
EVENT_SYSTEM_DESKTOPSWITCH アクティブデスクトップの切り替え
EVENT_SYSTEM_END システムイベントの最大値
EVENT_OEM_DEFINED_START OEM 用の予約値
EVENT_OEM_DEFINED_END OEM 用の予約値
EVENT_OBJECT_CREATE オブジェクトの作成
EVENT_OBJECT_DESTROY オブジェクトの破棄
EVENT_OBJECT_SHOW 非可視オブジェクトの表示 (可視化)
EVENT_OBJECT_HIDE オブジェクトの非可視
EVENT_OBJECT_REORDER コンテナオブジェクトの子オブジェクトの追加,削除,または配置変更
IE のページ内容の変更も含まれる
EVENT_OBJECT_FOCUS キーボードフォーカスの検出
EVENT_OBJECT_SELECTION コンテナオブジェクト内の選択要素の変更
EVENT_OBJECT_SELECTIONADD 選択されているコンテナオブジェクトへのオブジェクトの追加
EVENT_OBJECT_SELECTIONREMOVE コンテナオブジェクト内の子オブジェクトの削除
EVENT_OBJECT_SELECTIONWITHIN コンテナオブジェクト内の複数選択の変更
コールバック関数の引数はコンテナオブジェクトの値
EVENT_OBJECT_STATECHANGE オブジェクトのStateプロパティの変更
IEのページ内容変更も検出
EVENT_OBJECT_LOCATIONCHANGE 位置,形状,サイズ等の変更
IE のページの内容変更も含む
EVENT_OBJECT_NAMECHANGE オブジェクトの Name プロパティの変更
EVENT_OBJECT_DESCRIPTIONCHANGE オブジェクトの Description プロパティの変更
EVENT_OBJECT_VALUECHANGE オブジェクトの Value プロパティの変更
IE のウェブページの要素の内容変更等
EVENT_OBJECT_PARENTCHANGE オブジェクトの親オブジェクトの変更
EVENT_OBJECT_HELPCHANGE Help プロパティの変更
EVENT_OBJECT_DEFACTIONCHANGE オブジェクトの DefaultAction プロパティの変更
EVENT_OBJECT_ACCELERATORCHANGE オブジェクトの KeyboardShortcut プロパティの変更
EVENT_OBJECT_INVOKED オブジェクトの操作
例えばボタンクリック等の検出
EVENT_OBJECT_TEXTSELECTIONCHANGED オブジェクトのテキストの選択変更
EVENT_OBJECT_CONTENTSCROLLED スクロールウィンドウに関連付けされたオブジェクトのスクロール終了
EVENT_SYSTEM_ARRANGMENTPREVIEW プレビュー用の四角形表示
EVENT_OBJECT_END OBJECT イベント値のもっとも大きい値


コールバック関数の場所と,イベントのスキップ関係の設定である,dwFlag の指定は,以下のいずれかの組み合わせとなります.
SKIP 関係のフラグは,MSDN の記事が解読できませんでした.おそらく,コールバック関数の再登録の防止ではないかと思われます.動作の確認はしていません.

    dwFlags := WINEVENT_INCONTEXT;
    dwFlags := WINEVENT_OUTOFCONTEXT;
    dwFlags := WINEVENT_INCONTEXT or WINEVENT_SKIPOWNPROCESS;
    dwFlags := WINEVENT_INCONTEXT or WINEVENT_SKIPOWNTHREAD;
    dwFlags := WINEVENT_OUTOFCONTEXT or WINEVENT_SKIPOWNPROCESS;
    dwFlags := WINEVENT_OUTOFCONTEXT or WINEVENT_SKIPOWNTHREAD; 

表2
コールバック関数の場所と,イベントのスキップ関係の指定

WINEVENT_INCONTEXT コールバック関数を DLL 内に置く場合の指定
WINEVENT_OUTOFCONTEXT コールバック関数を同一プロセス内で実行する場合の指定
WINEVENT_SKIPOWNPROCESS フックを登録したプロセス内で発生したイベントを受信してから,このフックのインスタンスを防止する (?)
WINEVENT_SKIPOWNTHREAD フックを登録したスレッド内で発生したイベントを受信してから,このフックのインスタンスを防止する(?)




08_WinEventProc コールバック関数


フックのコールバック関数の引数と,定数値等の説明です.他のフックのコールバック関数同様,関数の名前は任意ですが,引数の順番と型は一致させなければなりません.
引数,定数値の詳しい内容は,MSDNの記事等を参考にしてください.
必要であれば,イベント内で,AccessibleObjectFromEvent 関数を使用して,IAccessible オブジェクトのインスタンスや子オブジェクトを VARIANT 型として取得することができます.



WinEventProc(hWinEventHook,
             event,
             hwnd,
             idObject,
             idChild,
             idEventThread,
             dwmsEventTime)

引数 説明
hWinEventHook THandle SetWinEventHook フック関数のハンドル
event DWORD 発生したイベント.表 1 のいずれかの値
hwnd HWND イベントを発生したウィンドウのハンドル
idObject LONG イベントを発生したオブジェクトのカテゴリ.表 3 のいずれかの値
idChild LONG イベントを発生した子オブジェクトのID値
CHILDID_SELF の時はオブジェクト自身
dwEventThread DWORD イベントを発生したスレッド
またはイベントを発生したウィンドウのスレッド
dwmsEventTime DWORD イベントの生成時刻で,ミリ秒単位
戻り値 - なし


表3
イベントが発生したオブジェクトのカテゴリ

OBJID_ALERT ウィンドウまたはアプリ関連付けのアラート
OBJID_CARET テキストエリアのキャレット
OBJID_CLIENT ウィンドウのクライアント領域のオブジェクト
OBJID_CURSOR マウスのポインタ
OBJID_HSCROLL ウィンドウの水平スクロールバー
OBJID_NATIVEOM サードパーティ独自の COM インターフェイス用
OBJID_MENU ウィンドウのメニューバー
OBJID_QUERYCLASSNAMEIDX Oleacc.dll が内部で使用するオブジェクト識別子
OBJID_SIZEGRIP ウィンドウのサイズグリップ(ウィンドウの右下隅)
OBJID_SOUND サウンドを再生しているアプリケーションの子オブジェクト
OBJID_SYSMENU ウィンドウのシステムメニュー
OBJID_TITLEBAR ウィンドウのタイトルバー
OBJID_VSCROLL ウィンドウの垂直スクロールバー
OBJID_WINDOW ウィンドウの子オブジェクト