unit Unit12;

interface

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

type
 TForm12 = class(TForm)
   Memo1: TMemo;
   Timer1: TTimer;
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
   FWindow: HWnd;
 public
   { Public declarations }
 end;

var
 Form12: TForm12;

implementation

{$R *.dfm}

uses
 ActiveX, ComObj, OleAcc;

function AccessibleObjectFromWindow(AHWnd: HWND; dwObjectID: DWORD;
          const riid: TGUID; out ppvObject):HResult; stdcall;
          external 'OLEACC.DLL' name 'AccessibleObjectFromWindow';

function AccessibleChildren(paccContainer: Pointer; iChildStart: LONGINT;
                           cChildren: LONGINT; out rgvarChildren: OleVariant;
                           out pcObtained: LONGINT): HRESULT; stdcall;
                           external 'OLEACC.DLL' name 'AccessibleChildren';

procedure TForm12.Timer1Timer(Sender: TObject);
var
 Lines: TStringList;

 procedure DisplayInfo(const aAccessible: IAccessible; const aOffset: string);

   procedure ProcessChild(const aChild: OleVariant);
   var
     ChildAccessible: IAccessible;
     ChildDispatch: IDispatch;
   begin
     ChildDispatch := nil;
     case VarType(aChild) of
       varInteger: aAccessible.Get_accChild(aChild, ChildDispatch);
       varDispatch: ChildDispatch := aChild;
     end;
     if (ChildDispatch <> nil) and (ChildDispatch.QueryInterface(IAccessible, ChildAccessible) = S_OK) then
       DisplayInfo(ChildAccessible, aOffset + '   ')
   end;

 var
   Child, CurrentChild: OleVariant;
   ChildArray: array of OleVariant;
   dwNum: DWord;
   Enum: IEnumVARIANT;
   i, iChildCount, iObtained: Integer;
   wsText: WideString;
 begin
   if aAccessible <> nil then begin
     if aAccessible.get_AccName(CHILDID_SELF, wsText) = S_OK then
       Lines.Add(aOffset + 'Name: ' + wsText)
     else
       Lines.Add(aOffset + 'Name: Empty');
     if aAccessible.get_AccValue(CHILDID_SELF, wsText) = S_OK then
       Lines.Add(aOffset + '  Value: ' + wsText);
     if aAccessible.get_AccDescription(CHILDID_SELF, wsText) = S_OK then
       Lines.Add(aOffset + '  Description: ' + wsText);

     if (aAccessible.Get_accChildCount(iChildCount) = S_OK) and (iChildCount > 0) then begin
       Lines.Add(aOffset + ' Children: ' + IntToStr(iChildCount));
       SetLength(ChildArray, iChildCount);
       if AccessibleChildren(Pointer(aAccessible), 0, iChildCount, ChildArray[0], iObtained) = S_OK then begin
         for i := 0 to iObtained - 1 do
           ProcessChild(ChildArray[i])
       end else if aAccessible.QueryInterface(IEnumVARIANT, Enum) = S_OK then begin
         Enum := aAccessible as IEnumVARIANT;
         for i := 0 to iChildCount - 1 do
           if Enum.Next(1, Child, dwNum) = S_OK then
             ProcessChild(Child);
       end else begin
         if aAccessible.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF, CurrentChild) = S_OK then begin
           repeat
             ProcessChild(CurrentChild)
           until aAccessible.accNavigate(NAVDIR_NEXT, CurrentChild, CurrentChild) <> S_OK;
         end
       end
     end
   end
 end;

var
 Accessible: IAccessible;
 hWindow: HWnd;
begin
 Timer1.Enabled := False;
 try
   hWindow := WindowFromPoint(Mouse.CursorPos);
   if FWindow <> hWindow then begin
     FWindow := hWindow;
     Memo1.Lines.Clear;
     Application.ProcessMessages;
     if AccessibleObjectFromWindow(hWindow, 0, IID_IAccessible, Accessible) = S_OK then begin
       Lines := TStringList.Create;
       try
         DisplayInfo(Accessible, '');
         Memo1.Lines.Assign(Lines);
       finally
         Lines.Free
       end
     end
   end
 finally
   Timer1.Enabled := True
 end
end;

end.

uses
 ActiveX, ComObj;

const
 IID_IAccessible: TGUID = '{618736E0-3C3D-11CF-810C-00AA00389B71}';
 
 NAVDIR_NEXT = $5 ;
 NAVDIR_FIRSTCHILD = $7 ;

type
 IAccessible = interface(IDispatch)
   ['{618736E0-3C3D-11CF-810C-00AA00389B71}']
   function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
   function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
   function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
   function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
   function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
   function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
   function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
   function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
   function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
   function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant;
                             out pidTopic: Integer): HResult; stdcall;
   function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
   function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
   function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
   function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
   function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
   function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer;
                        out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
   function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
   function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
   function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
   function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
   function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
 end;

function AccessibleObjectFromWindow(AHWnd: HWND; dwObjectID: DWORD;
          const riid: TGUID; out ppvObject):HResult; stdcall;
          external 'OLEACC.DLL' name 'AccessibleObjectFromWindow';

function AccessibleChildren(paccContainer: Pointer; iChildStart: LONGINT;
                           cChildren: LONGINT; out rgvarChildren: OleVariant;
                           out pcObtained: LONGINT): HRESULT; stdcall;
                           external 'OLEACC.DLL' name 'AccessibleChildren';