source: cprs/branches/foia-cprs/CPRS-Chart/uAccessibleTreeView.pas@ 1381

Last change on this file since 1381 was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

File size: 8.2 KB
Line 
1unit uaccessibleTreeView;
2
3interface
4
5uses
6 ComObj, ActiveX, CPRSChart_TLB, StdVcl, ORCtrls, Accessibility_TLB, Variants;
7
8type
9 TChildType = (ctInvalid, ctNoChild, ctChild);
10
11 TAccessibleTreeView = class(TAutoObject, IaccessibleTreeView, IAccessible)
12 private
13 FDefaultObject: IAccessible;
14 FDefaultObjectLoaded: boolean;
15 FControl: TORTreeView;
16 function GetDefaultObject: IAccessible;
17 protected
18 function accHitTest(xLeft, yTop: Integer): OleVariant; safecall;
19 function accNavigate(navDir: Integer; varStart: OleVariant): OleVariant;
20 safecall;
21 function Get_accChild(varChild: OleVariant): IDispatch; safecall;
22 function Get_accChildCount: Integer; safecall;
23 function Get_accDefaultAction(varChild: OleVariant): WideString; safecall;
24 function Get_accDescription(varChild: OleVariant): WideString; safecall;
25 function Get_accFocus: OleVariant; safecall;
26 function Get_accHelp(varChild: OleVariant): WideString; safecall;
27 function Get_accHelpTopic(out pszHelpFile: WideString;
28 varChild: OleVariant): Integer; safecall;
29 function Get_accKeyboardShortcut(varChild: OleVariant): WideString;
30 safecall;
31 function Get_accName(varChild: OleVariant): WideString; safecall;
32 function Get_accParent: IDispatch; safecall;
33 function Get_accRole(varChild: OleVariant): OleVariant; safecall;
34 function Get_accSelection: OleVariant; safecall;
35 function Get_accState(varChild: OleVariant): OleVariant; safecall;
36 function Get_accValue(varChild: OleVariant): WideString; safecall;
37 procedure accDoDefaultAction(varChild: OleVariant); safecall;
38 procedure accLocation(out pxLeft, pyTop, pcxWidth, pcyHeight: Integer;
39 varChild: OleVariant); safecall;
40 procedure accSelect(flagsSelect: Integer; varChild: OleVariant); safecall;
41 procedure Set_accName(varChild: OleVariant; const pszName: WideString);
42 safecall;
43 procedure Set_accValue(varChild: OleVariant; const pszValue: WideString);
44 safecall;
45 public
46 property Control: TORtreeView read FControl write FControl;
47 property DefaultObject: IAccessible read GetDefaultObject write FDefaultObject;
48 function ChildType( varChild: OleVariant): TChildType;
49 class procedure WrapControl( Control: TORTreeView);
50 class procedure UnwrapControl( Control: TORTreeView);
51 end;
52
53implementation
54
55uses uComServ, uAccessAPI, Windows, CommCtrl;
56
57var
58 UserIsRestricted: boolean = False;
59
60function TAccessibleTreeView.accHitTest(xLeft, yTop: Integer): OleVariant;
61begin
62 result := Null;
63 if Assigned(DefaultObject) then
64 result := DefaultObject.accHitTest(xLeft,yTop);
65end;
66
67function TAccessibleTreeView.accNavigate(navDir: Integer;
68 varStart: OleVariant): OleVariant;
69begin
70 result := Null;
71 if Assigned(DefaultObject) then
72 result := DefaultObject.accNavigate(navDir, varStart);
73end;
74
75function TAccessibleTreeView.Get_accChild(varChild: OleVariant): IDispatch;
76begin
77 result := nil;
78 if Assigned(DefaultObject) then
79 result := DefaultObject.Get_accChild(varChild);
80end;
81
82function TAccessibleTreeView.Get_accChildCount: Integer;
83begin
84 result := 0;
85 if Assigned(DefaultObject) then
86 result := DefaultObject.Get_accChildCount;
87end;
88
89function TAccessibleTreeView.Get_accDefaultAction(
90 varChild: OleVariant): WideString;
91begin
92 result := '';
93 if Assigned(DefaultObject) then
94 result := DefaultObject.Get_accDefaultAction(varChild);
95end;
96
97function TAccessibleTreeView.Get_accDescription(
98 varChild: OleVariant): WideString;
99begin
100 result := '';
101 if Assigned(DefaultObject) then
102 result := DefaultObject.Get_accDescription(varChild);
103end;
104
105function TAccessibleTreeView.Get_accFocus: OleVariant;
106begin
107 result := NULL;
108 if Assigned(DefaultObject) then
109 result := DefaultObject.Get_accFocus;
110end;
111
112function TAccessibleTreeView.Get_accHelp(varChild: OleVariant): WideString;
113begin
114 result := '';
115 if Assigned(DefaultObject) then
116 result := DefaultObject.Get_accHelp(varChild);
117end;
118
119function TAccessibleTreeView.Get_accHelpTopic(out pszHelpFile: WideString;
120 varChild: OleVariant): Integer;
121begin
122 result := 0;
123 if Assigned(DefaultObject) then
124 result := DefaultObject.Get_accHelpTopic(pszHelpFile, varChild);
125end;
126
127function TAccessibleTreeView.Get_accKeyboardShortcut(
128 varChild: OleVariant): WideString;
129begin
130 result := '';
131 if Assigned(DefaultObject) then
132 result := DefaultObject.Get_accKeyboardShortcut(varChild);
133end;
134
135function TAccessibleTreeView.Get_accName(varChild: OleVariant): WideString;
136var
137 TheNode:TORTreeNode;
138begin
139 if ChildType(varChild) = ctChild then
140 begin
141 if Assigned(FControl) then
142 begin
143 TheNode := FControl.Items.GetNode(HTREEITEM(integer(varChild))) as TORTreeNode;
144 result := TheNode.Accessible.Get_accName(CHILDID_SELF);
145 end
146 else
147 result := '[No Data]';
148 end
149 else if Assigned(DefaultObject) then
150 result := DefaultObject.Get_accName(varChild);
151end;
152
153function TAccessibleTreeView.Get_accParent: IDispatch;
154begin
155 result := nil;
156 if Assigned(DefaultObject) then
157 result := DefaultObject.Get_accParent;
158end;
159
160function TAccessibleTreeView.Get_accRole(varChild: OleVariant): OleVariant;
161begin
162 result := NULL;
163 if Assigned(DefaultObject) then
164 result := DefaultObject.Get_accRole(varChild);
165end;
166
167function TAccessibleTreeView.Get_accSelection: OleVariant;
168begin
169 result := NULL;
170 if Assigned(DefaultObject) then
171 result := DefaultObject.Get_accSelection;
172end;
173
174function TAccessibleTreeView.Get_accState(varChild: OleVariant): OleVariant;
175begin
176 result := NULL;
177 if Assigned(DefaultObject) then
178 result := DefaultObject.Get_accState(varChild);
179end;
180
181function TAccessibleTreeView.Get_accValue(varChild: OleVariant): WideString;
182begin
183 result := '';
184 if Assigned(DefaultObject) then
185 result := DefaultObject.Get_accValue(varChild);
186end;
187
188procedure TAccessibleTreeView.accDoDefaultAction(varChild: OleVariant);
189begin
190 if Assigned(DefaultObject) then
191 DefaultObject.accDoDefaultAction(varChild);
192end;
193
194procedure TAccessibleTreeView.accLocation(out pxLeft, pyTop, pcxWidth,
195 pcyHeight: Integer; varChild: OleVariant);
196begin
197 if Assigned(DefaultObject) then
198 DefaultObject.accLocation(pxLeft,pyTop,pcxWidth,pcyHeight,VarChild);
199end;
200
201procedure TAccessibleTreeView.accSelect(flagsSelect: Integer;
202 varChild: OleVariant);
203begin
204 if Assigned(DefaultObject) then
205 DefaultObject.accSelect(flagsSelect, varChild);
206end;
207
208procedure TAccessibleTreeView.Set_accName(varChild: OleVariant;
209 const pszName: WideString);
210begin
211 if Assigned(DefaultObject) then
212 DefaultObject.Set_accName(varChild, pszName);
213end;
214
215procedure TAccessibleTreeView.Set_accValue(varChild: OleVariant;
216 const pszValue: WideString);
217begin
218 if Assigned(DefaultObject) then
219 DefaultObject.Set_accValue(varChild, pszValue);
220end;
221
222function TAccessibleTreeView.GetDefaultObject: IAccessible;
223begin
224 if Assigned(FControl) and not FDefaultObjectLoaded then begin
225 FDefaultObject := uAccessAPI.GetDefaultObject(FControl);
226 FDefaultObjectLoaded := True;
227 end;
228 Result := FDefaultObject;
229end;
230
231function TAccessibleTreeView.ChildType(varChild: OleVariant): TChildType;
232begin
233 if (VarType(varChild) <> varInteger) then
234 result := ctInvalid
235 else if varChild = CHILDID_SELF then
236 result := ctNoChild
237 else
238 result := ctChild;
239end;
240
241class procedure TAccessibleTreeView.WrapControl(Control: TORTreeView);
242var
243 AccessibleTreeView: TAccessibleTreeView;
244 {Using Accessible here is probably just interface reference count paranoia}
245 Accessible: IAccessible;
246begin
247 if not UserIsRestricted then
248 begin
249 AccessibleTreeView := TAccessibleTreeView.Create;
250 Accessible := AccessibleTreeView;
251 AccessibleTreeView.Control := Control;
252 Control.MakeAccessible(Accessible);
253 end;
254end;
255
256class procedure TAccessibleTreeView.UnwrapControl(Control: TORTreeView);
257begin
258 if not UserIsRestricted then
259 Control.MakeAccessible(nil);
260end;
261
262initialization
263 try
264 TAutoObjectFactory.Create(ComServer, TAccessibleTreeView, Class_accessibleTreeView,
265 ciMultiInstance, tmApartment);
266 except
267 {Let the poor restricted users pass!}
268 UserIsRestricted := True;
269 end;
270
271end.
Note: See TracBrowser for help on using the repository browser.