accessibility - Creating Accessible UI components in Delphi

Question

I am trying to retrieve accessible information from a standard VCL TEdit control. The get_accName() and Get_accDescription() methods return empty strings, but get_accValue() returns the text value entered into the TEdit.

I am just starting to try to understand the MSAA and I'm a bit lost at this point.

Does my TEdit need to have additional published properties that would be exposed to the MSA? If so would that necessitate creating a new component that descends from TEdit and adds the additional published properties such as "AccessibleName", "AccessibleDescription", etc... ?

Also, note, I have looked at the VTVirtualTrees component which is supposed to be accessible, but the MS Active Accessibility Object Inspector still does not see the AccessibleName published property even on that control.

At this point I am at a loss and would be grateful for any advice or help in this matter.

...
interface
uses
   Winapi.Windows,
   Winapi.Messages,
   System.SysUtils,
   System.Variants,
   System.Classes,
   Vcl.Graphics,
   Vcl.Controls,
   Vcl.Forms,
   Vcl.Dialogs,
   Vcl.StdCtrls,
   Vcl.ComCtrls,
   Vcl.ExtCtrls,
   oleacc;

const
  WM_GETOBJECT = $003D; // Windows MSAA message identifier
  OBJID_NATIVEOM = $FFFFFFF0;

type
  TForm1 = class(TForm)
    lblFirstName: TLabel;
    edFirstName: TEdit;
    panel1: TPanel;
    btnGetAccInfo: TButton;
    accInfoOutput: TEdit;
    procedure btnGetAccInfoClick(Sender: TObject);
    procedure edFirstNameChange(Sender: TObject);
  private
    { Private declarations }
    FFocusedAccessibleObj: IAccessible;
    FvtChild: Variant;
    FAccProperties: TStringList;
    FAccName: string;
    FAccDesc: string;
    FAccValue: string;
    procedure DoGetAccessibleObjectFromPoint(aPoint: TPoint);
  public
   { Public declarations }
   procedure BeforeDestruction; override;
   property AccName: string read FAccName;
   property AccDescription: string read FAccName;
   property AccValue: string read FAccName;
  end;

var
  Form1: TForm1;

const
  cCRLF = #13#10;

implementation

{$R *.dfm}

function AccessibleObjectFromPoint(ptScreen: TPoint;
                                   out ppacc: IAccessible;
                                   out pvarChildt: Variant): HRESULT; stdcall; external   'oleacc.dll' ;

{------------------------------------------------------------------------------}
procedure TForm1.BeforeDestruction;
begin
  VarClear(FvtChild);
  FFocusedAccessibleObj := nil;
end;

{------------------------------------------------------------------------------}
procedure TForm1.DoGetAccessibleObjectFromPoint(aPoint: TPoint);
var
  pt: TPoint;
  bsName: WideString;
  bsDesc: WideString;
  bsValue: WideString;
begin
  if (SUCCEEDED(AccessibleObjectFromPoint(aPoint, FFocusedAccessibleObj, FvtChild))) then
    try
      // get_accName  returns an empty string
      bsName := '';
      FFocusedAccessibleObj.get_accName(FvtChild, bsName);
      FAccName := bsName;
      FAccProperties.Add('Acc Name: ' + FAccName + '  |  ' + cCRLF);

      // Get_accDescription  returns an empty string
      bsDesc := '';
      FFocusedAccessibleObj.Get_accDescription(FvtChild, bsDesc);
      FAccDesc := bsDesc;
      FAccProperties.Add('Acc Description: ' + FAccDesc + '  |  ' + cCRLF);

      // this works
      bsValue := '';
      FFocusedAccessibleObj.get_accValue(FvtChild, bsValue);
      FAccValue := bsValue;
      FAccProperties.Add('Acc Value: ' + FAccValue  + cCRLF);

   finally
     VarClear(FvtChild);
     FFocusedAccessibleObj := nil ;
   end;
  end;

  {------------------------------------------------------------------------------}
  procedure TForm1.btnGetAccInfoClick(Sender: TObject);
  begin
    FAccProperties := TStringList.Create;
    DoGetAccessibleObjectFromPoint(edFirstName.ClientOrigin);
    accInfoOutput.Text := FAccProperties.Text;
  end;   
end.

Answer 1

The VCL itself does not natively implement any support for MSAA. Windows provides default implementations for standard UI controls, which many standard VCL components wrap. If you need more MSAA support than Windows provides, you will have to implement the IAccessible interface yourself, and then have your control respond to the WM_GETOBJECT message so it can return a pointer to an instance of your implementation.

Update: For example, one way to add MSAA to an existing TEdit (if you do not want to derive your own component) might look something like this:

uses
  ..., oleacc;

type
  TMyAccessibleEdit = class(TInterfacedObject, IAccessible)
  private
    fEdit: TEdit;
    fDefAcc: IAccessible;
  public
    constructor Create(aEdit: TEdit; aDefAcc: IAccessible);

    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;

    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;

    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;

constructor TMyAccessibleEdit.Create(aEdit: TEdit; aDefAcc: IAccessible);
begin
  inherited Create;
  fEdit := aEdit;
  fDefAcc := aDefAcc;
end;

function TMyAccessibleEdit.QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
begin
  if IID = IID_IAccessible then
    Result := inherited QueryInterface(IID, Obj)
  else
    Result := fDefAcc.QueryInterface(IID, Obj);
end;

function TMyAccessibleEdit.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
begin
  Result := fDefAcc.GetTypeInfoCount(Count);
end;

function TMyAccessibleEdit.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
begin
  Result := fDefAcc.GetTypeInfo(Index, LocaleID, TypeInfo);
end;

function TMyAccessibleEdit.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
begin
  Result := fDefAcc.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs);
end;

function TMyAccessibleEdit.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
begin
  Result := fDefAcc.Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
end;

function TMyAccessibleEdit.Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
begin
  Result := fDefAcc.Get_accParent(ppdispParent);
end;

function TMyAccessibleEdit.Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
begin
  Result := fDefAcc.Get_accChildCount(pcountChildren);
end;

function TMyAccessibleEdit.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
begin
  Result := fDefAcc.Get_accChild(varChild, ppdispChild);
end;

function TMyAccessibleEdit.Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Get_accName(varChild, pszName);
  if (Result = S_OK) and (pszName <> '') then Exit;
  if Integer(varChild) = CHILDID_SELF then begin
    pszName := fEdit.Name;
    Result := S_OK;
  end else
    Result := S_FALSE;
end;

function TMyAccessibleEdit.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Get_accValue(varChild, pszValue);
end;

function TMyAccessibleEdit.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Get_accDescription(varChild, pszDescription);
  if (Result = S_OK) and (pszDescription <> '') then Exit;
  if Integer(varChild) = CHILDID_SELF then begin
    pszDescription := fEdit.Hint;
    Result := S_OK;
  end else
    Result := S_FALSE;
end;

function TMyAccessibleEdit.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.Get_accRole(varChild, pvarRole);
end;

function TMyAccessibleEdit.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.Get_accState(varChild, pvarState);
end;

function TMyAccessibleEdit.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Get_accHelp(varChild, pszHelp);
end;

function TMyAccessibleEdit.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
begin
  Result := fDefAcc.Get_accHelpTopic(pszHelpFile, varChild, pidTopic);
end;

function TMyAccessibleEdit.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Get_accKeyboardShortcut(varChild, pszKeyboardShortcut);
end;

function TMyAccessibleEdit.Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.Get_accFocus(pvarChild);
end;

function TMyAccessibleEdit.Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.Get_accSelection(pvarChildren);
end;

function TMyAccessibleEdit.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Get_accDefaultAction(varChild, pszDefaultAction);
end;

function TMyAccessibleEdit.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.accSelect(flagsSelect, varChild);
end;

function TMyAccessibleEdit.accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
 begin
  Result := fDefAcc.accLocation(pxLeft, pyTop, pcxWidth, pcyHeight, varChild);
end;

function TMyAccessibleEdit.accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.accNavigate(navDir, varStart, pvarEndUpAt);
end;

function TMyAccessibleEdit.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.accHitTest(xLeft, yTop, pvarChild);
end;

function TMyAccessibleEdit.accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
begin
  Result := fDefAcc.accDoDefaultAction(varChild);
end;

function TMyAccessibleEdit.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Set_accName(varChild, pszName);
end;

function TMyAccessibleEdit.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
begin
  Result := fDefAcc.Set_accValue(varChild, pszValue);
end;

type
  TMyForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    ...
  private
    DefEditWndProc: TWndMethod;
    procedure EditWndProc(var Message: TMessage);
    ...
  end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  DefEditWndProc := Edit1.WindowProc;
  Edit1.WindowProc := EditWndProc;
end;

procedure TMyForm.EditWndProc(var Message: TMessage);
var
  DefAcc, MyAcc: IAccessible;
  Ret: LRESULT;
begin
  DefEditWndProc(Message);
  if (Message.Msg = WM_GETOBJECT) and (DWORD(Message.LParam) = OBJID_CLIENT) and (Message.Result > 0) then
  begin
    if ObjectFromLresult(Message.Result, IAccessible, Message.WParam, DefAcc) = S_OK then
    begin
      MyAcc := TMyAccessibleEdit.Create(Edit1, DefAcc) as IAccessible;
      Message.Result := LresultFromObject(IAccessible, Message.WParam, MyAcc);
    end;
  end;
end;