在 Delphi 中创建可访问的 UI 组件的问题答案

【问题标题】：Problems with Creating Accessible UI components in Delphi在 Delphi 中创建可访问的 UI 组件的问题
【发布时间】：2014-02-19 14:48:31
【问题描述】：

这个问题指的是 Creating Accessible UI components in Delphi中给出的解决方案

我尝试使用上述问题的解决方案来解决上一个问题 (here) 中描述的问题。如图所示实现 IAccessible 接口后，我进行了调试，很高兴看到当我尝试通过外部程序（在本例中为 Visual Studio 的编码 UI 测试记录工具）读取 WinForm-Properties 时可以访问该接口。

可访问的名称已按我的意愿设置，但不知何故丢失了，因为该名称仍未在 WinForm 属性中定义。

代码如下：

声明：

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;

重要的实现：

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;

创建的接口被 TEdit 的派生使用，这里是相关代码：

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;

顺便说一句，这只是一个调试解决方案，所以我稍后会更改消息处理之类的东西。

有人知道，为什么我在 WinForms-Properties 中仍然得到一个空名称？

【问题讨论】：

TXCustomEdit.WMGetMSAAObject 执行了吗？
是的，我也可以调试到 TXControlEigenschaften 的 get_accname 并设置名称
刚刚发生了一些奇怪的事情：当我在尝试读取对象属性后通过TXControlEigenschaften.WMGetMSAAObject 上的每个调用进行调试时，该名称出现在我的属性列表中。当我禁用断点时，它不显示名称。现在它变得荒谬......
还有一件事：这只工作一次，当我已经读出了应用程序的这个实例中的属性时，WMGetMSAAObject 的调用要少得多，即使有断点，名称也不会出现，之后重新启动应用程序它再次工作
只是通过将 IAccessible 的实现放在自己的类中来简化事情，因为我怀疑两个接口使用一个类是问题，但它没有改变任何东西

标签： winforms delphi delphi-xe2 ui-automation

【解决方案1】：

我通过在Get_accState 中返回DISP_E_MEMBERNOTFOUND 而不是采用this article 中提供的代码解决了这个问题。这适用于名称，但是通过 AutoIt 或 Visual Studio 测试生成器等工具选择组件来编码 UI 将更加困难。

所以它更多的是一种解决方法，而不是真正的解决方案。

我就这个问题here开了一个新问题，因为原来的问题已经解决了。

【讨论】：