我正在尝试从标准的VCL TEdit控件中检索可访问的信息。 get_accName()和Get_accDescription()方法返回空字符串,但get_accValue()返回输入到TEdit中的文本值。
我刚刚开始尝试了解MSAA,我在这一点上有点迷失。
我的TEdit需要有其他已发布的属性才能暴露给MSA?如果是这样,就需要创建一个从TEdit下载的新组件,并添加其他已发布的属性,例如“AccessibleName”,“AccessibleDescription”等?
另外请注意,我已经看过了可以访问的VTVirtualTrees组件,但即使在该控件上,MS Active Accessibility对象检查器仍然看不到AccessibleName已发布的属性。
在这一点上,我感到失落,并将感谢任何建议或帮助。
- ...
- interface
- uses
- Winapi.Windows,Winapi.Messages,System.SysUtils,System.Variants,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Vcl.StdCtrls,Vcl.ComCtrls,Vcl.ExtCtrls,oleacc;
- const
- WM_GETOBJECT = $003D; // Windows MSAA message identifier
- OBJID_NATIVEOM = $FFFFFFF0;
- type
- TForm1 = class(TForm)
- lblFirstName: TLabel;
- edFirstName: TEdit;
- panel1: TPanel;
- btnGetAccInfo: TButton;
- accInfoOutput: TEdit;
- procedure btnGetAccInfoClick(Sender: TObject);
- procedure edFirstNameChange(Sender: TObject);
- private
- { Private declarations }
- FFocusedAccessibleObj: IAccessible;
- FvtChild: Variant;
- FAccProperties: TStringList;
- FAccName: string;
- FAccDesc: string;
- FAccValue: string;
- procedure DoGetAccessibleObjectFromPoint(aPoint: TPoint);
- public
- { Public declarations }
- procedure BeforeDestruction; override;
- property AccName: string read FAccName;
- property AccDescription: string read FAccName;
- property AccValue: string read FAccName;
- end;
- var
- Form1: TForm1;
- const
- cCRLF = #13#10;
- implementation
- {$R *.dfm}
- function AccessibleObjectFromPoint(ptScreen: TPoint;
- out ppacc: IAccessible;
- out pvarChildt: Variant): HRESULT; stdcall; external 'oleacc.dll' ;
- {------------------------------------------------------------------------------}
- procedure TForm1.BeforeDestruction;
- begin
- VarClear(FvtChild);
- FFocusedAccessibleObj := nil;
- end;
- {------------------------------------------------------------------------------}
- procedure TForm1.DoGetAccessibleObjectFromPoint(aPoint: TPoint);
- var
- pt: TPoint;
- bsName: WideString;
- bsDesc: WideString;
- bsValue: WideString;
- begin
- if (SUCCEEDED(AccessibleObjectFromPoint(aPoint,FFocusedAccessibleObj,FvtChild))) then
- try
- // get_accName returns an empty string
- bsName := '';
- FFocusedAccessibleObj.get_accName(FvtChild,bsName);
- FAccName := bsName;
- FAccProperties.Add('Acc Name: ' + FAccName + ' | ' + cCRLF);
- // Get_accDescription returns an empty string
- bsDesc := '';
- FFocusedAccessibleObj.Get_accDescription(FvtChild,bsDesc);
- FAccDesc := bsDesc;
- FAccProperties.Add('Acc Description: ' + FAccDesc + ' | ' + cCRLF);
- // this works
- bsValue := '';
- FFocusedAccessibleObj.get_accValue(FvtChild,bsValue);
- FAccValue := bsValue;
- FAccProperties.Add('Acc Value: ' + FAccValue + cCRLF);
- finally
- VarClear(FvtChild);
- FFocusedAccessibleObj := nil ;
- end;
- end;
- {------------------------------------------------------------------------------}
- procedure TForm1.btnGetAccInfoClick(Sender: TObject);
- begin
- FAccProperties := TStringList.Create;
- DoGetAccessibleObjectFromPoint(edFirstName.ClientOrigin);
- accInfoOutput.Text := FAccProperties.Text;
- end;
- end.
解决方法
VCL本身并没有为MSAA本地实现任何支持。 Windows为标准UI控件提供了默认实现,许多标准的VCL组件包装。如果您需要比Windows提供更多的MSAA支持,您将必须自己实现
IAccessible
界面,然后让您的控制响应
WM_GETOBJECT
消息,以便返回指向实现实例的指针。
更新:例如,将MSAA添加到现有TEdit的一种方法(如果您不想导出自己的组件)可能看起来像这样:
- uses
- ...,oleacc;
- type
- TMyAccessibleEdit = class(TInterfacedObject,IAccessible)
- private
- fEdit: TEdit;
- fDefAcc: IAccessible;
- public
- constructor Create(aEdit: TEdit; aDefAcc: IAccessible);
- function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
- function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
- function GetTypeInfo(Index,LocaleID: Integer; out TypeInfo): HResult; stdcall;
- function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
- function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr: Pointer): HResult; stdcall;
- function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
- function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
- function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
- function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
- function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
- function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
- function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
- function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
- function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
- function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
- function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
- function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
- function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
- function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
- function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
- function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
- function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
- function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
- function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
- function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
- function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
- end;
- constructor TMyAccessibleEdit.Create(aEdit: TEdit; aDefAcc: IAccessible);
- begin
- inherited Create;
- fEdit := aEdit;
- fDefAcc := aDefAcc;
- end;
- function TMyAccessibleEdit.QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
- begin
- if IID = IID_IAccessible then
- Result := inherited QueryInterface(IID,Obj)
- else
- Result := fDefAcc.QueryInterface(IID,Obj);
- end;
- function TMyAccessibleEdit.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
- begin
- Result := fDefAcc.GetTypeInfoCount(Count);
- end;
- function TMyAccessibleEdit.GetTypeInfo(Index,LocaleID: Integer; out TypeInfo): HResult; stdcall;
- begin
- Result := fDefAcc.GetTypeInfo(Index,LocaleID,TypeInfo);
- end;
- function TMyAccessibleEdit.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
- begin
- Result := fDefAcc.GetIDsOfNames(IID,Names,NameCount,DispIDs);
- end;
- function TMyAccessibleEdit.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult,ArgErr: Pointer): HResult; stdcall;
- begin
- Result := fDefAcc.Invoke(DispID,IID,Flags,Params,VarResult,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,MyAcc);
- end;
- end;
- end;