创建在Delphi残疾人专用UI组件(Creating Accessible UI componen

2019-09-01 15:03发布

站内文章 / 前端开发

48 0

混吃等死

女 | 书童

私信

我正在尝试从一个标准的VCL TEdit控件访问的信息。该get_accName（）和Get_accDescription（）方法返回空字符串，但get_accValue（）返回进入TEDIT文本值。

我刚开始试着去了解MSAA，我有点在这一点上失去了。

请问我TEDIT需要有一个将被暴露在MSA额外发布的属性？如果是的话会使得需要创建一个从TEDIT下降，并增加了额外的公布属性，如“AccessibleName”，“AccessibleDescription”等新组件...？

此外，请注意，我已经看过这应该是访问的VTVirtualTrees组成部分，但MS Active Accessibility的Object Inspector中仍然没有看到，甚至对控制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.

Answer 1:

该VCL本身本身不实施任何MSAA支持。 Windows提供了默认的实现为标准的UI控件，其中很多标准的VCL组件包。如果您需要更多的支持MSAA比Windows提供，你将不得不实施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;

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.

文章来源: Creating Accessible UI components in Delphi