Creando componentes UI accesibles en Delphi

accessibility delphi-xe3

Question

Estoy tratando de recuperar información accesible de un control estándar de VCL TEdit. Los métodos get_accName () y Get_accDescription () devuelven cadenas vacías, pero get_accValue () devuelve el valor de texto ingresado en TEdit.

Estoy empezando a tratar de entender el MSAA y estoy un poco perdido en este punto.

¿Mi TEdit necesita tener propiedades adicionales publicadas que estarían expuestas al MSA? Si es así, ¿sería necesario crear un nuevo componente que descienda de TEdit y agregue las propiedades publicadas adicionales como "AccessibleName", "AccessibleDescription", etc ...?

Además, tenga en cuenta que he visto el componente VTVirtualTrees que se supone que es accesible, pero el Inspector de objetos de accesibilidad activa de MS aún no ve la propiedad publicada AccessibleName incluso en ese control.

En este momento estoy perdido y agradecería cualquier consejo o ayuda en este asunto.

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

La propia VCL no implementa de forma nativa ningún soporte para MSAA. Windows proporciona implementaciones predeterminadas para los controles de IU estándar, que incluyen muchos componentes VCL estándar. Si necesita más soporte de MSAA que el que proporciona Windows, deberá implementar la interfaz IAccessible , y luego hacer que su control responda al mensaje WM_GETOBJECT para que pueda devolver un puntero a una instancia de su implementación.

Actualización: por ejemplo, una forma de agregar MSAA a un TEdit existente (si no desea derivar su propio componente) podría tener este aspecto:

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

Pude conseguir que esto funcione a través de

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.