Question

此问题涉及 Creating Accessible UI components in Delphi

中的给定解决方案

我尝试使用上述问题的解决方案解决上一个问题（here）中描述的问题。在实现了如图所示的IAccessible接口之后，我调试并且很高兴看到当我尝试通过外部程序（在这种情况下是Visual Studio的Coded UI-Test Recording-Tool）读取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中获得一个空名称？

Answer 1

我通过在DISP_E_MEMBERNOTFOUND中返回Get_accState而不是使用this article中提供的代码来解决问题。这适用于名称，但是通过工具（如AutoIt或Visual Studio Test-Generator）为编码UI选择组件将更加困难。

因此，它更像是一种解决方法，而是一种真正的解决方案。

我打开了一个关于此问题here的新问题，因为原来的问题已经解决了。

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

1 个答案: