在 Delphi 中创建可访问的 UI 组件 [英] Creating Accessible UI components in Delphi
本文介绍了在 Delphi 中创建可访问的 UI 组件的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在尝试从标准 VCL TEdit 控件中检索可访问信息.get_accName() 和 Get_accDescription() 方法返回空字符串，但 get_accValue() 返回输入到 TEdit 中的文本值.
I am trying to retrieve accessible information from a standard VCL TEdit control. The get_accName() and Get_accDescription() methods return empty strings, but get_accValue() returns the text value entered into the TEdit.
我刚刚开始尝试了解 MSAA，此时我有点不知所措.
I am just starting to try to understand the MSAA and I'm a bit lost at this point.
我的 TEdit 是否需要有额外的已发布属性来暴露给 MSA?如果是这样，那是否需要创建一个继承自 TEdit 的新组件并添加其他已发布的属性，例如AccessibleName"、AccessibleDescription"等...?
Does my TEdit need to have additional published properties that would be exposed to the MSA? If so would that necessitate creating a new component that descends from TEdit and adds the additional published properties such as "AccessibleName", "AccessibleDescription", etc... ?
另外，请注意，我已经查看了应该可访问的 VTVirtualTrees 组件，但是 MS Active Accessibility Object Inspector 仍然没有看到 AccessibleName 已发布的属性，即使在该控件上也是如此.
Also, note, I have looked at the VTVirtualTrees component which is supposed to be accessible, but the MS Active Accessibility Object Inspector still does not see the AccessibleName published property even on that control.
此时我不知所措，如果您在这件事上有任何建议或帮助，我将不胜感激.
At this point I am at a loss and would be grateful for any advice or help in this matter.
...
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.
推荐答案
我能够通过
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.
这篇关于在 Delphi 中创建可访问的 UI 组件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
