在Delphi中创建可访问的UI组件

前端之家收集整理的这篇文章主要介绍了在Delphi中创建可访问的UI组件前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我正在尝试从标准的VCL TEdit控件中检索可访问的信息。 get_accName()和Get_accDescription()方法返回空字符串,但get_accValue()返回输入到TEdit中的文本值。

我刚刚开始尝试了解MSAA,我在这一点上有点迷失。

我的TEdit需要有其他已发布的属性才能暴露给MSA?如果是这样,就需要创建一个从TEdit下载的新组件,并添加其他已发布的属性,例如“AccessibleName”,“AccessibleDescription”等?

另外请注意,我已经看过了可以访问的VTVirtualTrees组件,但即使在该控件上,MS Active Accessibility对象检查器仍然看不到AccessibleName已发布的属性

在这一点上,我感到失落,并将感谢任何建议或帮助。

  1. ...
  2. interface
  3. uses
  4. 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;
  5.  
  6. const
  7. WM_GETOBJECT = $003D; // Windows MSAA message identifier
  8. OBJID_NATIVEOM = $FFFFFFF0;
  9.  
  10. type
  11. TForm1 = class(TForm)
  12. lblFirstName: TLabel;
  13. edFirstName: TEdit;
  14. panel1: TPanel;
  15. btnGetAccInfo: TButton;
  16. accInfoOutput: TEdit;
  17. procedure btnGetAccInfoClick(Sender: TObject);
  18. procedure edFirstNameChange(Sender: TObject);
  19. private
  20. { Private declarations }
  21. FFocusedAccessibleObj: IAccessible;
  22. FvtChild: Variant;
  23. FAccProperties: TStringList;
  24. FAccName: string;
  25. FAccDesc: string;
  26. FAccValue: string;
  27. procedure DoGetAccessibleObjectFromPoint(aPoint: TPoint);
  28. public
  29. { Public declarations }
  30. procedure BeforeDestruction; override;
  31. property AccName: string read FAccName;
  32. property AccDescription: string read FAccName;
  33. property AccValue: string read FAccName;
  34. end;
  35.  
  36. var
  37. Form1: TForm1;
  38.  
  39. const
  40. cCRLF = #13#10;
  41.  
  42. implementation
  43.  
  44. {$R *.dfm}
  45.  
  46. function AccessibleObjectFromPoint(ptScreen: TPoint;
  47. out ppacc: IAccessible;
  48. out pvarChildt: Variant): HRESULT; stdcall; external 'oleacc.dll' ;
  49.  
  50. {------------------------------------------------------------------------------}
  51. procedure TForm1.BeforeDestruction;
  52. begin
  53. VarClear(FvtChild);
  54. FFocusedAccessibleObj := nil;
  55. end;
  56.  
  57. {------------------------------------------------------------------------------}
  58. procedure TForm1.DoGetAccessibleObjectFromPoint(aPoint: TPoint);
  59. var
  60. pt: TPoint;
  61. bsName: WideString;
  62. bsDesc: WideString;
  63. bsValue: WideString;
  64. begin
  65. if (SUCCEEDED(AccessibleObjectFromPoint(aPoint,FFocusedAccessibleObj,FvtChild))) then
  66. try
  67. // get_accName returns an empty string
  68. bsName := '';
  69. FFocusedAccessibleObj.get_accName(FvtChild,bsName);
  70. FAccName := bsName;
  71. FAccProperties.Add('Acc Name: ' + FAccName + ' | ' + cCRLF);
  72.  
  73. // Get_accDescription returns an empty string
  74. bsDesc := '';
  75. FFocusedAccessibleObj.Get_accDescription(FvtChild,bsDesc);
  76. FAccDesc := bsDesc;
  77. FAccProperties.Add('Acc Description: ' + FAccDesc + ' | ' + cCRLF);
  78.  
  79. // this works
  80. bsValue := '';
  81. FFocusedAccessibleObj.get_accValue(FvtChild,bsValue);
  82. FAccValue := bsValue;
  83. FAccProperties.Add('Acc Value: ' + FAccValue + cCRLF);
  84.  
  85. finally
  86. VarClear(FvtChild);
  87. FFocusedAccessibleObj := nil ;
  88. end;
  89. end;
  90.  
  91. {------------------------------------------------------------------------------}
  92. procedure TForm1.btnGetAccInfoClick(Sender: TObject);
  93. begin
  94. FAccProperties := TStringList.Create;
  95. DoGetAccessibleObjectFromPoint(edFirstName.ClientOrigin);
  96. accInfoOutput.Text := FAccProperties.Text;
  97. end;
  98. end.

解决方法

VCL本身并没有为MSAA本地实现任何支持。 Windows为标准UI控件提供了默认实现,许多标准的VCL组件包装。如果您需要比Windows提供更多的MSAA支持,您将必须自己实现 IAccessible界面,然后让您的控制响应 WM_GETOBJECT消息,以便返回指向实现实例的指针。

更新:例如,将MSAA添加到现有TEdit的一种方法(如果您不想导出自己的组件)可能看起来像这样:

  1. uses
  2. ...,oleacc;
  3.  
  4. type
  5. TMyAccessibleEdit = class(TInterfacedObject,IAccessible)
  6. private
  7. fEdit: TEdit;
  8. fDefAcc: IAccessible;
  9. public
  10. constructor Create(aEdit: TEdit; aDefAcc: IAccessible);
  11.  
  12. function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  13.  
  14. function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  15. function GetTypeInfo(Index,LocaleID: Integer; out TypeInfo): HResult; stdcall;
  16. function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  17. function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult,ExcepInfo,ArgErr: Pointer): HResult; stdcall;
  18.  
  19. function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
  20. function Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
  21. function Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
  22. function Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
  23. function Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
  24. function Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
  25. function Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
  26. function Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
  27. function Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
  28. function Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
  29. function Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
  30. function Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
  31. function Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
  32. function Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
  33. function accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
  34. function accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
  35. function accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
  36. function accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
  37. function accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
  38. function Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
  39. function Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
  40. end;
  1. constructor TMyAccessibleEdit.Create(aEdit: TEdit; aDefAcc: IAccessible);
  2. begin
  3. inherited Create;
  4. fEdit := aEdit;
  5. fDefAcc := aDefAcc;
  6. end;
  7.  
  8. function TMyAccessibleEdit.QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  9. begin
  10. if IID = IID_IAccessible then
  11. Result := inherited QueryInterface(IID,Obj)
  12. else
  13. Result := fDefAcc.QueryInterface(IID,Obj);
  14. end;
  15.  
  16. function TMyAccessibleEdit.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  17. begin
  18. Result := fDefAcc.GetTypeInfoCount(Count);
  19. end;
  20.  
  21. function TMyAccessibleEdit.GetTypeInfo(Index,LocaleID: Integer; out TypeInfo): HResult; stdcall;
  22. begin
  23. Result := fDefAcc.GetTypeInfo(Index,LocaleID,TypeInfo);
  24. end;
  25.  
  26. function TMyAccessibleEdit.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  27. begin
  28. Result := fDefAcc.GetIDsOfNames(IID,Names,NameCount,DispIDs);
  29. end;
  30.  
  31. function TMyAccessibleEdit.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult,ArgErr: Pointer): HResult; stdcall;
  32. begin
  33. Result := fDefAcc.Invoke(DispID,IID,Flags,Params,VarResult,ArgErr);
  34. end;
  35.  
  36. function TMyAccessibleEdit.Get_accParent(out ppdispParent: IDispatch): HResult; stdcall;
  37. begin
  38. Result := fDefAcc.Get_accParent(ppdispParent);
  39. end;
  40.  
  41. function TMyAccessibleEdit.Get_accChildCount(out pcountChildren: Integer): HResult; stdcall;
  42. begin
  43. Result := fDefAcc.Get_accChildCount(pcountChildren);
  44. end;
  45.  
  46. function TMyAccessibleEdit.Get_accChild(varChild: OleVariant; out ppdispChild: IDispatch): HResult; stdcall;
  47. begin
  48. Result := fDefAcc.Get_accChild(varChild,ppdispChild);
  49. end;
  50.  
  51. function TMyAccessibleEdit.Get_accName(varChild: OleVariant; out pszName: WideString): HResult; stdcall;
  52. begin
  53. Result := fDefAcc.Get_accName(varChild,pszName);
  54. if (Result = S_OK) and (pszName <> '') then Exit;
  55. if Integer(varChild) = CHILDID_SELF then begin
  56. pszName := fEdit.Name;
  57. Result := S_OK;
  58. end else
  59. Result := S_FALSE;
  60. end;
  61.  
  62. function TMyAccessibleEdit.Get_accValue(varChild: OleVariant; out pszValue: WideString): HResult; stdcall;
  63. begin
  64. Result := fDefAcc.Get_accValue(varChild,pszValue);
  65. end;
  66.  
  67. function TMyAccessibleEdit.Get_accDescription(varChild: OleVariant; out pszDescription: WideString): HResult; stdcall;
  68. begin
  69. Result := fDefAcc.Get_accDescription(varChild,pszDescription);
  70. if (Result = S_OK) and (pszDescription <> '') then Exit;
  71. if Integer(varChild) = CHILDID_SELF then begin
  72. pszDescription := fEdit.Hint;
  73. Result := S_OK;
  74. end else
  75. Result := S_FALSE;
  76. end;
  77.  
  78. function TMyAccessibleEdit.Get_accRole(varChild: OleVariant; out pvarRole: OleVariant): HResult; stdcall;
  79. begin
  80. Result := fDefAcc.Get_accRole(varChild,pvarRole);
  81. end;
  82.  
  83. function TMyAccessibleEdit.Get_accState(varChild: OleVariant; out pvarState: OleVariant): HResult; stdcall;
  84. begin
  85. Result := fDefAcc.Get_accState(varChild,pvarState);
  86. end;
  87.  
  88. function TMyAccessibleEdit.Get_accHelp(varChild: OleVariant; out pszHelp: WideString): HResult; stdcall;
  89. begin
  90. Result := fDefAcc.Get_accHelp(varChild,pszHelp);
  91. end;
  92.  
  93. function TMyAccessibleEdit.Get_accHelpTopic(out pszHelpFile: WideString; varChild: OleVariant; out pidTopic: Integer): HResult; stdcall;
  94. begin
  95. Result := fDefAcc.Get_accHelpTopic(pszHelpFile,varChild,pidTopic);
  96. end;
  97.  
  98. function TMyAccessibleEdit.Get_accKeyboardShortcut(varChild: OleVariant; out pszKeyboardShortcut: WideString): HResult; stdcall;
  99. begin
  100. Result := fDefAcc.Get_accKeyboardShortcut(varChild,pszKeyboardShortcut);
  101. end;
  102.  
  103. function TMyAccessibleEdit.Get_accFocus(out pvarChild: OleVariant): HResult; stdcall;
  104. begin
  105. Result := fDefAcc.Get_accFocus(pvarChild);
  106. end;
  107.  
  108. function TMyAccessibleEdit.Get_accSelection(out pvarChildren: OleVariant): HResult; stdcall;
  109. begin
  110. Result := fDefAcc.Get_accSelection(pvarChildren);
  111. end;
  112.  
  113. function TMyAccessibleEdit.Get_accDefaultAction(varChild: OleVariant; out pszDefaultAction: WideString): HResult; stdcall;
  114. begin
  115. Result := fDefAcc.Get_accDefaultAction(varChild,pszDefaultAction);
  116. end;
  117.  
  118. function TMyAccessibleEdit.accSelect(flagsSelect: Integer; varChild: OleVariant): HResult; stdcall;
  119. begin
  120. Result := fDefAcc.accSelect(flagsSelect,varChild);
  121. end;
  122.  
  123. function TMyAccessibleEdit.accLocation(out pxLeft: Integer; out pyTop: Integer; out pcxWidth: Integer; out pcyHeight: Integer; varChild: OleVariant): HResult; stdcall;
  124. begin
  125. Result := fDefAcc.accLocation(pxLeft,pyTop,pcxWidth,pcyHeight,varChild);
  126. end;
  127.  
  128. function TMyAccessibleEdit.accNavigate(navDir: Integer; varStart: OleVariant; out pvarEndUpAt: OleVariant): HResult; stdcall;
  129. begin
  130. Result := fDefAcc.accNavigate(navDir,varStart,pvarEndUpAt);
  131. end;
  132.  
  133. function TMyAccessibleEdit.accHitTest(xLeft: Integer; yTop: Integer; out pvarChild: OleVariant): HResult; stdcall;
  134. begin
  135. Result := fDefAcc.accHitTest(xLeft,yTop,pvarChild);
  136. end;
  137.  
  138. function TMyAccessibleEdit.accDoDefaultAction(varChild: OleVariant): HResult; stdcall;
  139. begin
  140. Result := fDefAcc.accDoDefaultAction(varChild);
  141. end;
  142.  
  143. function TMyAccessibleEdit.Set_accName(varChild: OleVariant; const pszName: WideString): HResult; stdcall;
  144. begin
  145. Result := fDefAcc.Set_accName(varChild,pszName);
  146. end;
  147.  
  148. function TMyAccessibleEdit.Set_accValue(varChild: OleVariant; const pszValue: WideString): HResult; stdcall;
  149. begin
  150. Result := fDefAcc.Set_accValue(varChild,pszValue);
  151. end;
  1. type
  2. TMyForm = class(TForm)
  3. procedure FormCreate(Sender: TObject);
  4. ...
  5. private
  6. DefEditWndProc: TWndMethod;
  7. procedure EditWndProc(var Message: TMessage);
  8. ...
  9. end;
  10.  
  11. procedure TMyForm.FormCreate(Sender: TObject);
  12. begin
  13. DefEditWndProc := Edit1.WindowProc;
  14. Edit1.WindowProc := EditWndProc;
  15. end;
  16.  
  17. procedure TMyForm.EditWndProc(var Message: TMessage);
  18. var
  19. DefAcc,MyAcc: IAccessible;
  20. Ret: LRESULT;
  21. begin
  22. DefEditWndProc(Message);
  23. if (Message.Msg = WM_GETOBJECT) and (Message.LParam = OBJID_CLIENT) and (Message.Result > 0) then
  24. begin
  25. if ObjectFromLresult(Message.Result,IAccessible,Message.WParam,DefAcc) = S_OK then
  26. begin
  27. MyAcc := TMyAccessibleEdit.Create(Edit1,DefAcc) as IAccessible;
  28. Message.Result := LresultFromObject(IAccessible,MyAcc);
  29. end;
  30. end;
  31. end;

猜你在找的Delphi相关文章