在Delphi中创建无障碍UI组件

Question

我正在尝试从标准的VCL TEdit控件中检索可访问信息。get_accName() 和 Get_accDescription() 方法返回空字符串，但 get_accValue() 返回输入到 TEdit 中的文本值。

我刚开始尝试理解MSAA，现在有点迷失了。

我的TEdit需要具有额外的已发布属性才能暴露给MSA吗？如果是这样的话，是否需要创建一个从TEdit继承并添加额外已发布属性（例如“AccessibleName”，“AccessibleDescription”等）的新组件？

还要注意的是，我已经查看了VTVirtualTrees组件，它应该是可访问的，但是MS Active Accessibility对象检查器甚至在那个控件上也看不到AccessibleName已发布属性。

目前我无法解决问题，非常感谢任何关于此事的建议或帮助。

...
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.

- Ostendo Nomen

Answer 1

VCL本身并不原生支持MSAA。Windows会为标准UI控件提供默认实现，而许多标准VCL组件则包装了这些实现。如果您需要比Windows提供的更多MSAA支持，则必须自己实现IAccessible接口，然后让您的控件响应WM_GETOBJECT消息，以便它可以返回指向您实现的实例的指针。

更新：例如，如果您不想派生自己的组件，一种将MSAA添加到现有的TEdit的方法可能如下所示：

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;

- Remy Lebeau

---

Remy，谢谢你的快速回复。在你的帮助下，我成功获取了我的控件的可访问属性。 - Ostendo Nomen

Remy，你构建了一个完整的项目来测试这个吗？如果是这样，你能使用ReportMemoryLeaksOnShutdown吗？我遇到了实现IAccessible接口的实例永远不会被释放的问题，我猜测是因为引用计数从未达到零。 - Dave Nottage

好的，我发现这是在使用Narrator（微软内置的屏幕阅读器）时出现的问题。例如，使用JAWS时似乎没有出现这个问题。 - Dave Nottage

您IP地址为143.198.54.68，由于运营成本限制，当前对于免费用户的使用频率限制为每个IP每72小时10次对话，如需解除限制，请点击左下角设置图标按钮（手机用户先点击左上角菜单按钮）。 - Remy Lebeau

看起来泄漏是由Narrator本身引起的： https://social.technet.microsoft.com/Forums/windows/en-US/7e5f9f4c-5673-46de-a9b7-d1254705106c/memory-leak-using-windows-accessibility-tools-microsoft-narrator-windows-speech-recognition-with?forum=w7itproperf 不过，如果有一个解决方法，那将会很有帮助，因为我们希望至少支持Narrator和JAWS。 - Dave Nottage

在我的示例中，我在每个WM_GETOBJECT消息上创建一个新的IAccessible对象，期望消息发送者释放它。这是典型的COM用法。然而，为了解决Narrator的泄漏问题，您可能需要使WM_GETOBJECT每次返回单例对象。要么禁用其引用计数，要么保留自己对其的引用。Narrator可以泄漏任意数量的对象，但内存中只会有一个对象，并且对于像JAWS这样的行为良好的客户端仍然会正确地运行。对于这种情况，我倾向于Ostendo的实现。 - Remy Lebeau

Answer 2

我能够通过以下方式使其工作：

unit mainAcc;

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;

type
    TForm1 = class(TForm)
        lblFirstName: TLabel;
        btnGetAccInfo: TButton;
        accInfoOutput: TEdit;
        procedure btnGetAccInfoClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
    private
        { Private declarations }
        aEdit: TTWEdit;
        FAccProperties: TStringList;
    public
        { Public declarations }
    end;

    TAccessibleEdit = class(TEdit, IAccessible)
    private
        FOwner: TComponent;
        FAccessibleItem: IAccessible;
        FAccessibleName: string;
        FAccessibleDescription: string;
        procedure WMGetMSAAObject(var Message : TMessage); message WM_GETOBJECT;
        // 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;
    protected
        function QueryInterface(const IID: TGUID; out Obj): HResult; override;
    public
        constructor Create(AOwner: TComponent); override;
    published
        property AccessibleItem: IAccessible read FAccessibleItem write FAccessibleItem;
        property AccessibleName: string read FAccessibleName write FAccessibleName;
        property AccessibleDescription: string read FAccessibleDescription write FAccessibleDescription;
    end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

{------------------------------------------------------------------------------}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    inherited;
    FreeAndNil(aEdit);
end;

{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
    aEdit := TAccessibleEdit.Create(self);
    aEdit.Visible := true;
    aEdit.Parent := Form1;
    aEdit.Left := 91;
    aEdit.Top := 17;
    aEdit.Height := 21;
    aEdit.Width := 204;
    aEdit.Hint := 'This is a custom accessible edit control hint';
end;

{------------------------------------------------------------------------------}
procedure TForm1.btnGetAccInfoClick(Sender: TObject);
var
    vWSTemp: WideString;
    vAccObj: IAccessible;
begin
    FAccProperties := TStringList.Create;
    if (AccessibleObjectFromWindow(aEdit.Handle, OBJID_CLIENT, IID_IAccessible, vAccObj) = S_OK) then
    begin
        vAccObj.Get_accName(CHILDID_SELF, vWSTemp);
        FAccProperties.Add('Name: ' + vWSTemp);
        vWSTemp := '';
        vAccObj.Get_accDescription(CHILDID_SELF, vWSTemp);
        FAccProperties.Add('Description: ' + vWSTemp);
        vWSTemp := '';
        vAccObj.Get_accValue(CHILDID_SELF, vWSTemp);
        FAccProperties.Add('Value: ' + vWSTemp);
    end;
    accInfoOutput.Text := FAccProperties.Text;
end;


        { TAccessibleEdit }
    {------------------------------------------------------------------------------}
    constructor TAccessibleEdit.Create(AOwner: TComponent);
    begin
        inherited Create(AOwner);
        FOwner := AOwner;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.QueryInterface(const IID: TGUID; out Obj): HResult;
    begin
        if GetInterface(IID, Obj) then
            Result := 0
        else
            Result := E_NOINTERFACE;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.accDoDefaultAction(varChild: OleVariant): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.accHitTest(xLeft, yTop: Integer;
        out pvarChild: OleVariant): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.accLocation(out pxLeft, pyTop, pcxWidth, pcyHeight: Integer;
        varChild: OleVariant): HResult;
    var
        P: TPoint;
    begin
        Result := S_FALSE;
        pxLeft := 0;
        pyTop := 0;
        pcxWidth := 0;
        pcyHeight := 0;
        if varChild = CHILDID_SELF then
        begin
            P := self.ClientToScreen(self.ClientRect.TopLeft);
            pxLeft := P.X;
            pyTop := P.Y;
            pcxWidth := self.Width;
            pcyHeight := self.Height;
            Result := S_OK;
        end
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.accNavigate(navDir: Integer; varStart: OleVariant;
        out pvarEndUpAt: OleVariant): HResult;
    begin
        result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accChild(varChild: OleVariant;
        out ppdispChild: IDispatch): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accChildCount(out pcountChildren: Integer): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accDefaultAction(varChild: OleVariant;
        out pszDefaultAction: WideString): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accDescription(varChild: OleVariant;
        out pszDescription: WideString): HResult;
    begin
        pszDescription := '';
        result := S_FALSE;
        if varChild = CHILDID_SELF then
        begin
            pszDescription := 'TAccessibleEdit_AccessibleDescription';
            Result := S_OK;
        end;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accFocus(out pvarChild: OleVariant): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accHelp(varChild: OleVariant;
        out pszHelp: WideString): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accHelpTopic(out pszHelpFile: WideString;
        varChild: OleVariant; out pidTopic: Integer): HResult;
    begin
        pszHelpFile := '';
        pidTopic := 0;
        Result := S_FALSE;
        if varChild = CHILDID_SELF then
        begin
            pszHelpFile := '';
            pidTopic := self.HelpContext;
            Result := S_OK;
        end;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accKeyboardShortcut(varChild: OleVariant;
        out pszKeyboardShortcut: WideString): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accName(varChild: OleVariant; out pszName: WideString): HResult;
    begin
        pszName := '';
        Result := S_FALSE;
        if varChild = CHILDID_SELF then
        begin
            pszName := 'TAccessibleEdit_AccessibleName';
            result := S_OK;
        end;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accParent(out ppdispParent: IDispatch): HResult;
    begin
        ppdispParent := nil;
        result := AccessibleObjectFromWindow(self.ParentWindow, CHILDID_SELF, IID_IAccessible, Pointer(ppDispParent));
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accRole(varChild: OleVariant;
        out pvarRole: OleVariant): HResult;
    begin
        Result := S_OK;
        if varChild = CHILDID_SELF then
            pvarRole := ROLE_SYSTEM_OUTLINE;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accSelection(out pvarChildren: OleVariant): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accState(varChild: OleVariant;
        out pvarState: OleVariant): HResult;
    begin
        Result := S_OK;
        if varChild = CHILDID_SELF then
            pvarState := STATE_SYSTEM_FOCUSED;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Get_accValue(varChild: OleVariant;
        out pszValue: WideString): HResult;
    begin
        pszValue := '';
        Result := S_FALSE;
        if varChild = CHILDID_SELF then
        begin
            pszValue := WideString(self.Text);
            result := S_OK;
        end;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Set_accName(varChild: OleVariant;
        const pszName: WideString): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    function TAccessibleEdit.Set_accValue(varChild: OleVariant;
        const pszValue: WideString): HResult;
    begin
        Result := DISP_E_MEMBERNOTFOUND;
    end;

    {------------------------------------------------------------------------------}
    procedure TAccessibleEdit.WMGetMSAAObject(var Message : TMessage);
    begin
        if (Message.Msg = WM_GETOBJECT) then
        begin
            QueryInterface(IID_IAccessible, FAccessibleItem);
            Message.Result := LresultFromObject(IID_IAccessible, Message.WParam, FAccessibleItem);
        end
        else
            Message.Result := DefWindowProc(Handle, Message.Msg, Message.WParam, Message.LParam);
    end;

    end. 

end.

- Ostendo Nomen

---

你竟然接受了自己的回答，而不是采纳 Remy 的解答，正是 Remy 的解答帮你解决了问题。你应该尊重他人的贡献并给予认可，Remy 细致的回答值得点赞和采纳。 - David Heffernan