Creazione di componenti UI accessibili in Delphi

Question

Sto cercando di recuperare informazioni accessibili da un controllo VCL TEdit standard. I metodi get_accName() e Get_accDescription() restituiscono stringhe vuote, ma get_accValue() restituisce il valore di testo inserito nel TEdit.

Sto appena iniziando a cercare di capire il MSAA e sono un po 'perso a questo punto.

Il mio TEdit deve disporre di ulteriori proprietà pubblicate che verrebbero esposte al MSA? In tal caso, è necessario creare un nuovo componente che discenda da TEdit e aggiunge le proprietà aggiuntive pubblicate come "AccessibleName", "AccessibleDescription", ecc ...?

Inoltre, nota, ho guardato la componente VTVirtualTrees quali è suppone essere accessibili, ma la MS Active Accessibility oggetto Inspector continua a non vedere la proprietà AccessibleName pubblicato anche su quel controllo.

A questo punto io sono in perdita e sarei grato per qualsiasi consiglio o aiuto in questa materia.

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

I è stato in grado di farlo funzionare via

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. 

Answer 2

Lo stesso VCL non implementa nativamente alcun supporto per MSAA. Windows fornisce le implementazioni predefinite per i controlli dell'interfaccia utente standard, che includono molti componenti VCL standard. Se hai bisogno di più supporto MSAA di quello fornito da Windows, dovrai implementare l'interfaccia IAccessible da solo, e quindi avere il tuo controllo rispondere al messaggio WM_GETOBJECT in modo che possa restituire un puntatore a un'istanza della tua implementazione.

Update: Ad esempio, un modo per aggiungere MSAA a un TEdit esistente (se non si vuole ricavare il proprio componente) potrebbe essere simile a questa:

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 (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;