source: cprs/branches/foia-cprs/CPRS-Chart/uAccessibleListBox.pas@ 1325

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

Adding foia-cprs branch

File size: 9.0 KB
Line 
1unit uAccessibleListBox;
2
3interface
4
5uses
6 ComObj, ActiveX, CPRSChart_TLB, StdVcl, Accessibility_TLB, ORCtrls, Variants;
7
8type
9 TChildType = (ctInvalid, ctNoChild, ctChild);
10
11 TAccessibleListBox = class(TAutoObject, IAccessibleListBox, IAccessible)
12 private
13 FDefaultObject: IAccessible;
14 FDefaultObjectLoaded: boolean;
15 FControl: TORListBox;
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: TORListBox read FControl write FControl;
47 property DefaultObject: IAccessible read GetDefaultObject write FDefaultObject;
48 function ChildType( varChild: OleVariant): TChildType;
49 class procedure WrapControl( Control: TORComboBox); overload;
50 class procedure UnwrapControl( Control: TORComboBox); overload;
51 class procedure WrapControl( Control: TORListBox); overload;
52 class procedure UnwrapControl( Control: TORListBox); overload;
53 end;
54
55implementation
56
57uses uComServ, uAccessAPI, Windows, SysUtils;
58
59var
60 UserIsRestricted: boolean = False;
61
62function TAccessibleListBox.accHitTest(xLeft, yTop: Integer): OleVariant;
63begin
64 result := Null;
65 if Assigned(DefaultObject) then
66 result := DefaultObject.accHitTest(xLeft,yTop);
67end;
68
69function TAccessibleListBox.accNavigate(navDir: Integer;
70 varStart: OleVariant): OleVariant;
71begin
72 result := Null;
73 if Assigned(DefaultObject) then
74 result := DefaultObject.accNavigate(navDir, varStart);
75end;
76
77function TAccessibleListBox.Get_accChild(varChild: OleVariant): IDispatch;
78begin
79 result := nil;
80 if Assigned(DefaultObject) then
81 result := DefaultObject.Get_accChild(varChild);
82end;
83
84function TAccessibleListBox.Get_accChildCount: Integer;
85begin
86 result := 0;
87 if Assigned(DefaultObject) then
88 result := DefaultObject.Get_accChildCount;
89end;
90
91function TAccessibleListBox.Get_accDefaultAction(
92 varChild: OleVariant): WideString;
93begin
94 result := '';
95 if Assigned(DefaultObject) then
96 result := DefaultObject.Get_accDefaultAction(varChild);
97end;
98
99function TAccessibleListBox.Get_accDescription(
100 varChild: OleVariant): WideString;
101begin
102 result := '';
103 if Assigned(DefaultObject) then
104 result := DefaultObject.Get_accDescription(varChild);
105end;
106
107function TAccessibleListBox.Get_accFocus: OleVariant;
108begin
109 result := NULL;
110 if Assigned(DefaultObject) then
111 result := DefaultObject.Get_accFocus;
112end;
113
114function TAccessibleListBox.Get_accHelp(varChild: OleVariant): WideString;
115begin
116 result := '';
117 if Assigned(DefaultObject) then
118 result := DefaultObject.Get_accHelp(varChild);
119end;
120
121function TAccessibleListBox.Get_accHelpTopic(out pszHelpFile: WideString;
122 varChild: OleVariant): Integer;
123begin
124 result := 0;
125 if Assigned(DefaultObject) then
126 result := DefaultObject.Get_accHelpTopic(pszHelpFile, varChild);
127end;
128
129function TAccessibleListBox.Get_accKeyboardShortcut(
130 varChild: OleVariant): WideString;
131begin
132 result := '';
133 if Assigned(DefaultObject) then
134 result := DefaultObject.Get_accKeyboardShortcut(varChild);
135end;
136
137function TAccessibleListBox.Get_accName(varChild: OleVariant): WideString;
138var
139 LongName: string;
140 Previous: string;
141 i: integer;
142begin
143 if ChildType(varChild) = ctChild then
144 begin
145 result := '';
146 if Assigned(FControl) then
147 begin
148 i := varChild - 1;
149 LongName := FControl.DisplayText[i];
150 if i > 0 then
151 Previous := FControl.DisplayText[i-1]
152 else
153 Previous := '';
154 result := CalcShortName( LongName, Previous);
155 end;
156 end
157 else if Assigned(DefaultObject) then
158 result := DefaultObject.Get_accName(varChild);
159end;
160
161function TAccessibleListBox.Get_accParent: IDispatch;
162begin
163 result := nil;
164 if Assigned(DefaultObject) then
165 result := DefaultObject.Get_accParent;
166end;
167
168function TAccessibleListBox.Get_accRole(varChild: OleVariant): OleVariant;
169begin
170 result := NULL;
171 if Assigned(DefaultObject) then
172 result := DefaultObject.Get_accRole(varChild);
173end;
174
175function TAccessibleListBox.Get_accSelection: OleVariant;
176begin
177 result := NULL;
178 if Assigned(DefaultObject) then
179 result := DefaultObject.Get_accSelection;
180end;
181
182function TAccessibleListBox.Get_accState(varChild: OleVariant): OleVariant;
183begin
184 result := NULL;
185 if Assigned(DefaultObject) then
186 result := DefaultObject.Get_accState(varChild);
187end;
188
189function TAccessibleListBox.Get_accValue(varChild: OleVariant): WideString;
190begin
191 result := '';
192 if Assigned(DefaultObject) then
193 result := DefaultObject.Get_accValue(varChild);
194end;
195
196procedure TAccessibleListBox.accDoDefaultAction(varChild: OleVariant);
197begin
198 if Assigned(DefaultObject) then
199 DefaultObject.accDoDefaultAction(varChild);
200end;
201
202procedure TAccessibleListBox.accLocation(out pxLeft, pyTop, pcxWidth,
203 pcyHeight: Integer; varChild: OleVariant);
204begin
205 if Assigned(DefaultObject) then
206 DefaultObject.accLocation(pxLeft,pyTop,pcxWidth,pcyHeight,VarChild);
207end;
208
209procedure TAccessibleListBox.accSelect(flagsSelect: Integer;
210 varChild: OleVariant);
211begin
212 if Assigned(DefaultObject) then
213 DefaultObject.accSelect(flagsSelect, varChild);
214end;
215
216procedure TAccessibleListBox.Set_accName(varChild: OleVariant;
217 const pszName: WideString);
218begin
219 if Assigned(DefaultObject) then
220 DefaultObject.Set_accName(varChild, pszName);
221end;
222
223procedure TAccessibleListBox.Set_accValue(varChild: OleVariant;
224 const pszValue: WideString);
225begin
226 if Assigned(DefaultObject) then
227 DefaultObject.Set_accValue(varChild, pszValue);
228end;
229
230function TAccessibleListBox.GetDefaultObject: IAccessible;
231begin
232 if Assigned(FControl) and not FDefaultObjectLoaded then begin
233 FDefaultObject := uAccessAPI.GetDefaultObject(FControl);
234 FDefaultObjectLoaded := True;
235 end;
236 Result := FDefaultObject;
237end;
238
239function TAccessibleListBox.ChildType(varChild: OleVariant): TChildType;
240begin
241 if VarType(varChild) <> varInteger then
242 result := ctInvalid
243 else if varChild = CHILDID_SELF then
244 result := ctNoChild
245 else
246 result := ctChild;
247end;
248
249class procedure TAccessibleListBox.WrapControl(Control: TORComboBox);
250var
251 AccessibleListBox: TAccessibleListBox;
252 {Using Accessible here is probably just interface reference count paranoia}
253 Accessible: IAccessible;
254begin
255 if not UserIsRestricted then
256 begin
257 AccessibleListBox := TAccessibleListBox.Create;
258 Accessible := AccessibleListBox;
259 AccessibleListBox.Control := Control.MakeAccessible(Accessible);
260 end;
261end;
262
263class procedure TAccessibleListBox.UnwrapControl(Control: TORComboBox);
264begin
265 if not UserIsRestricted then
266 Control.MakeAccessible(nil);
267end;
268
269class procedure TAccessibleListBox.UnwrapControl(Control: TORListBox);
270begin
271 if not UserIsRestricted then
272 Control.MakeAccessible(nil);
273end;
274
275class procedure TAccessibleListBox.WrapControl(Control: TORListBox);
276var
277 AccessibleListBox: TAccessibleListBox;
278 {Using Accessible here is probably just interface reference count paranoia}
279 Accessible: IAccessible;
280begin
281 if not UserIsRestricted then
282 begin
283 AccessibleListBox := TAccessibleListBox.Create;
284 Accessible := AccessibleListBox;
285 AccessibleListBox.Control := Control;
286 Control.MakeAccessible(Accessible);
287 end;
288end;
289
290initialization
291 try
292 TAutoObjectFactory.Create(ComServer, TAccessibleListBox, Class_AccessibleListBox,
293 ciMultiInstance, tmApartment);
294 except
295 {Let the poor restricted users pass!}
296 UserIsRestricted := True;
297 end;
298end.
Note: See TracBrowser for help on using the repository browser.