Problems with Creating Accessible UI components in Delphi

Question

This question refers to the given solution in Creating Accessible UI components in Delphi

I tried to solve my problem described in the last question (here) using the solution from the question above. After implementing the IAccessible Interface as shown, I debugged and was happy too see that the interface is accessed when I try to read the WinForm-Properties via an external program (in this case the Coded UI-Test Recording-Tool of Visual Studio).

The accessible name was set like i wanted, but it got lost somehow, because the name was still not defined in the WinForm properties.

---

Here the code:

Declaration:

TXControlEigenschaften = class (TInterfacedObject, IAccessible)
strict private
  FControl: IXControl;

  FAccessibleName: string;
  FAccessibleDescription: string;
  // IAccessible
  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;

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

public
  constructor Create(aControl: IXControl);

  procedure WMGetMSAAObject(var Message : TMessage); message WM_GETOBJECT;

  property AccessibleName: string read FAccessibleName write FAccessibleName;
  property AccessibleDescription: string read FAccessibleDescription write FAccessibleDescription;

end;

Implementation of the important ones:

procedure TXControlEigenschaften.WMGetMSAAObject(var Message: TMessage);
begin
    Message.Result := LresultFromObject(IID_IAccessible, Message.WParam, Self);
end;

function TXControlEigenschaften.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
begin
  pszName := '';
  Result := S_FALSE;
  if varChild = CHILDID_SELF then
  begin
    if AccessibleName <> '' then
      pszName := AccessibleName
    else
      pszName := FControl.Name;
    result := S_OK;
  end;
end;

---

The Interface created is used by a derivation of TEdit, here the regarding code:

TXCustomEdit = class(TCustomMaskEdit, IAccessible, IXControl, IXCtrlInterface, ITBXValidate, IXReadOnly, IXChange,
                   IXDelete, IXCut, IXPaste, IXSelectAll, IXVisible, IComboEdit
                   {$IFNDEF PACKAGE}, IXDPISkalierung, IExtrafeldControl{$ENDIF PACKAGE})

strict private
  procedure WMGetMSAAObject(var Message : TMessage); message WM_GETOBJECT;
  FAccessible: IAccessible;
...

implementation

constructor TXCustomEdit.Create(AOwner: TComponent);
var
  ce: TXControlEigenschaften;
begin
  ...
  FSkalierungsZustand := TSkalierungsZustand.Create(Self);
end;

...

procedure TXCustomEdit.WMGetMSAAObject(var Message: TMessage);
begin
  (FAccessible as TXControlEigenschaften).WMGetMSAAObject(Message);
end;

---

Btw, this is just a debug solution, so I will change things like the message handling later.

Does someone have an idea, why I still get an empty Name in the WinForms-Properties?

Answer 1

I solved the problem by just returning DISP_E_MEMBERNOTFOUND in Get_accState instead of taking the Code provided in this article. This works for the name, but the selection of Components via Tools like AutoIt or the Visual Studio Test-Generator for coded UI will be much more diffcult then.

So its more a workaround then a real solution.

I opened a new question regarding this problem here, because the original problem is solved.