Создание доступных компонентов пользовательского интерфейса в Delphi
Я пытаюсь получить доступную информацию из стандартного элемента управления TEDIT VCL. Методы 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 = 3D; // 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.
2 ответов
сам 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;
я смог заставить это работать через
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.