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

这个问题指的是本节中给出的解决方案

我试图用上述问题的解决方案解决上一个问题中描述的问题。在实现了如图所示的IAccessible接口之后，我进行了调试，并且很高兴看到当我试图通过一个外部程序（在本例中是Visual Studio的编码UI测试录制工具）读取WinForm属性时，可以访问该接口

可访问的名称是按我所希望的那样设置的，但不知何故它丢失了，因为该名称仍然没有在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;

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

---

有人知道为什么我在WinForms属性中仍然得到一个空名称吗？

我解决了这个问题，只返回get\u accState中的DISP\u E\u MEMBERNOTFOUND，而不是使用中提供的代码。这对名称有效，但通过AutoIt或Visual Studio Test Generator等工具选择用于编码UI的组件将更加困难

因此，这与其说是一个真正的解决方案，不如说是一个变通办法

---

关于这个问题，我提出了一个新问题，因为原来的问题已经解决了。

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

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;