1 | //kt -- Modified with SourceScanner on 8/21/2007
|
---|
2 | unit uAccessibleStringGrid;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | ComObj, ActiveX, AxCtrls, Classes, CPRSChart_TLB, StdVcl, Accessibility_TLB,
|
---|
8 | ORCtrls, Variants;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TChildType = (ctInvalid, ctNoChild, ctChild);
|
---|
12 |
|
---|
13 | TAccessibleStringGrid = class(TAutoObject, IAccessibleStringGrid, IAccessible)
|
---|
14 | private
|
---|
15 | FDefaultObject: IAccessible;
|
---|
16 | FDefaultObjectLoaded: boolean;
|
---|
17 | FControl: TCaptionStringGrid;
|
---|
18 | function GetDefaultObject: IAccessible;
|
---|
19 | protected {IAccessible}
|
---|
20 | function accHitTest(xLeft, yTop: Integer): OleVariant; safecall;
|
---|
21 | function accNavigate(navDir: Integer; varStart: OleVariant): OleVariant;
|
---|
22 | safecall;
|
---|
23 | function Get_accChild(varChild: OleVariant): IDispatch; safecall;
|
---|
24 | function Get_accChildCount: Integer; safecall;
|
---|
25 | function Get_accDefaultAction(varChild: OleVariant): WideString; safecall;
|
---|
26 | function Get_accDescription(varChild: OleVariant): WideString; safecall;
|
---|
27 | function Get_accFocus: OleVariant; safecall;
|
---|
28 | function Get_accHelp(varChild: OleVariant): WideString; safecall;
|
---|
29 | function Get_accHelpTopic(out pszHelpFile: WideString;
|
---|
30 | varChild: OleVariant): Integer; safecall;
|
---|
31 | function Get_accKeyboardShortcut(varChild: OleVariant): WideString;
|
---|
32 | safecall;
|
---|
33 | function Get_accName(varChild: OleVariant): WideString; safecall;
|
---|
34 | function Get_accParent: IDispatch; safecall;
|
---|
35 | function Get_accRole(varChild: OleVariant): OleVariant; safecall;
|
---|
36 | function Get_accSelection: OleVariant; safecall;
|
---|
37 | function Get_accState(varChild: OleVariant): OleVariant; safecall;
|
---|
38 | function Get_accValue(varChild: OleVariant): WideString; safecall;
|
---|
39 | procedure accDoDefaultAction(varChild: OleVariant); safecall;
|
---|
40 | procedure accLocation(out pxLeft, pyTop, pcxWidth, pcyHeight: Integer;
|
---|
41 | varChild: OleVariant); safecall;
|
---|
42 | procedure accSelect(flagsSelect: Integer; varChild: OleVariant); safecall;
|
---|
43 | procedure Set_accName(varChild: OleVariant; const pszName: WideString);
|
---|
44 | safecall;
|
---|
45 | procedure Set_accValue(varChild: OleVariant; const pszValue: WideString);
|
---|
46 | safecall;
|
---|
47 | protected
|
---|
48 | property DefaultObject: IAccessible read GetDefaultObject write FDefaultObject;
|
---|
49 | public
|
---|
50 | property Control: TCaptionStringGrid read FControl write FControl;
|
---|
51 | function ChildType( varChild: OleVariant): TChildType;
|
---|
52 | class procedure WrapControl( Control: TCaptionStringGrid);
|
---|
53 | class procedure UnwrapControl( Control: TCaptionStringGrid);
|
---|
54 | public {but it wouldn't be in a perfect world}
|
---|
55 | function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
|
---|
56 | end;
|
---|
57 |
|
---|
58 | implementation
|
---|
59 |
|
---|
60 | uses uComServ, SysUtils, uAccessAPI, Windows, Controls,
|
---|
61 | DKLang //kt
|
---|
62 | ;
|
---|
63 |
|
---|
64 | var
|
---|
65 | UserIsRestricted: boolean = False;
|
---|
66 |
|
---|
67 | function TAccessibleStringGrid.accHitTest(xLeft,
|
---|
68 | yTop: Integer): OleVariant;
|
---|
69 | var
|
---|
70 | ACol: integer;
|
---|
71 | ARow: integer;
|
---|
72 | P: TPoint;
|
---|
73 | begin
|
---|
74 | result := Null;
|
---|
75 | if Assigned(FControl) then
|
---|
76 | begin
|
---|
77 | P.X := xLeft;
|
---|
78 | P.Y := yTop;
|
---|
79 | P := FControl.ScreenToClient(P);
|
---|
80 | FControl.MouseToCell(P.X, P.Y, ACol, ARow);
|
---|
81 | if (ACol = -1) or (ARow = -1) then
|
---|
82 | result := NULL
|
---|
83 | else
|
---|
84 | result := FControl.ColRowToIndex( ACol, ARow);
|
---|
85 | end
|
---|
86 | else
|
---|
87 | result := CHILDID_SELF;
|
---|
88 | end;
|
---|
89 |
|
---|
90 | function TAccessibleStringGrid.accNavigate(navDir: Integer;
|
---|
91 | varStart: OleVariant): OleVariant;
|
---|
92 | begin
|
---|
93 | result := Null;
|
---|
94 | if Assigned(FControl) then
|
---|
95 | begin
|
---|
96 | case ChildType(varStart) of
|
---|
97 | ctNoChild:
|
---|
98 | case navDir of
|
---|
99 | NAVDIR_FIRSTCHILD:
|
---|
100 | result := 1;
|
---|
101 | NAVDIR_LASTCHILD:
|
---|
102 | result := Get_AccChildCount;
|
---|
103 | NAVDIR_DOWN,
|
---|
104 | NAVDIR_LEFT,
|
---|
105 | NAVDIR_NEXT,
|
---|
106 | NAVDIR_PREVIOUS,
|
---|
107 | NAVDIR_RIGHT,
|
---|
108 | NAVDIR_UP:
|
---|
109 | result := varStart;
|
---|
110 | end;
|
---|
111 | ctChild:
|
---|
112 | case NavDir of
|
---|
113 | NAVDIR_FIRSTCHILD,
|
---|
114 | NAVDIR_LASTCHILD:
|
---|
115 | result := varStart;
|
---|
116 | NAVDIR_DOWN:
|
---|
117 | result := varStart + (FControl.ColCount - FControl.FixedCols);
|
---|
118 | NAVDIR_LEFT,
|
---|
119 | NAVDIR_NEXT:
|
---|
120 | result := varStart + 1;
|
---|
121 | NAVDIR_PREVIOUS,
|
---|
122 | NAVDIR_RIGHT:
|
---|
123 | result := varStart - 1;
|
---|
124 | NAVDIR_UP:
|
---|
125 | result := varStart - (FControl.ColCount - FControl.FixedCols);
|
---|
126 | end;
|
---|
127 | end;
|
---|
128 | //revert if index is invalid
|
---|
129 | if ChildType(result) = ctChild then
|
---|
130 | begin
|
---|
131 | if (result > Get_AccChildCount) or (result < 1) then
|
---|
132 | result := varStart;
|
---|
133 | end;
|
---|
134 | end;
|
---|
135 | end;
|
---|
136 |
|
---|
137 | function TAccessibleStringGrid.Get_accChild(
|
---|
138 | varChild: OleVariant): IDispatch;
|
---|
139 | begin
|
---|
140 | result := nil;
|
---|
141 | OleError(S_FALSE);
|
---|
142 | end;
|
---|
143 |
|
---|
144 | function TAccessibleStringGrid.Get_accChildCount: Integer;
|
---|
145 | begin
|
---|
146 | if Assigned(FControl) then
|
---|
147 | result := (FControl.RowCount - FControl.FixedRows) * (FControl.ColCount - FControl.FixedCols)
|
---|
148 | else
|
---|
149 | result := 0;
|
---|
150 | end;
|
---|
151 |
|
---|
152 | function TAccessibleStringGrid.Get_accDefaultAction(
|
---|
153 | varChild: OleVariant): WideString;
|
---|
154 | begin
|
---|
155 | result := '';
|
---|
156 | if Assigned(DefaultObject) then
|
---|
157 | result := DefaultObject.Get_accDefaultAction(varChild);
|
---|
158 | end;
|
---|
159 |
|
---|
160 | function TAccessibleStringGrid.Get_accDescription(
|
---|
161 | varChild: OleVariant): WideString;
|
---|
162 | begin
|
---|
163 | result := '';
|
---|
164 | if Assigned(DefaultObject) then
|
---|
165 | result := DefaultObject.Get_accDescription(varChild);
|
---|
166 | end;
|
---|
167 |
|
---|
168 | function TAccessibleStringGrid.Get_accFocus: OleVariant;
|
---|
169 | begin
|
---|
170 | if Assigned(FControl) and FControl.Focused then
|
---|
171 | result := FControl.ColRowToIndex(FControl.Col, FControl.Row)
|
---|
172 | else
|
---|
173 | result := NULL;
|
---|
174 | end;
|
---|
175 |
|
---|
176 | function TAccessibleStringGrid.Get_accHelp(
|
---|
177 | varChild: OleVariant): WideString;
|
---|
178 | begin
|
---|
179 | result := '';
|
---|
180 | if Assigned(DefaultObject) then
|
---|
181 | result := DefaultObject.Get_accHelp(varChild);
|
---|
182 | end;
|
---|
183 |
|
---|
184 | function TAccessibleStringGrid.Get_accHelpTopic(
|
---|
185 | out pszHelpFile: WideString; varChild: OleVariant): Integer;
|
---|
186 | begin
|
---|
187 | result := 0;
|
---|
188 | if Assigned(DefaultObject) then
|
---|
189 | result := DefaultObject.Get_accHelpTopic(pszHelpFile, varChild);
|
---|
190 | end;
|
---|
191 |
|
---|
192 | function TAccessibleStringGrid.Get_accKeyboardShortcut(
|
---|
193 | varChild: OleVariant): WideString;
|
---|
194 | begin
|
---|
195 | result := '';
|
---|
196 | if Assigned(DefaultObject) then
|
---|
197 | result := DefaultObject.Get_accKeyboardShortcut(varChild);
|
---|
198 | end;
|
---|
199 |
|
---|
200 | function TAccessibleStringGrid.Get_accName(
|
---|
201 | varChild: OleVariant): WideString;
|
---|
202 | var
|
---|
203 | Row,Col: integer;
|
---|
204 | ColumnName: string;
|
---|
205 | RowName: string;
|
---|
206 | begin
|
---|
207 | case ChildType(varChild) of
|
---|
208 | ctNoChild:
|
---|
209 | result := FControl.Caption;
|
---|
210 | ctChild:
|
---|
211 | begin
|
---|
212 | if Assigned(FControl) then
|
---|
213 | begin
|
---|
214 | FControl.IndexToColRow(varChild,Col,Row);
|
---|
215 | if (FControl.FixedRows = 1) and (FControl.Cells[Col,0] <> '') then
|
---|
216 | ColumnName := FControl.Cells[Col,0]
|
---|
217 | else
|
---|
218 | ColumnName := IntToStr(Col-FControl.FixedCols+1);
|
---|
219 | if (FControl.FixedCols = 1) and ((FControl.Cells[0,Row] <> '')) then
|
---|
220 | RowName := FControl.Cells[0,Row]
|
---|
221 | else
|
---|
222 | // RowName := IntToStr(Row-FControl.FixedRows+1) + ' of ' + <-- original line. //kt 8/21/2007
|
---|
223 | RowName := IntToStr(Row-FControl.FixedRows+1) + DKLangConstW('uAccessibleStringGrid_of') + //kt added 8/21/2007
|
---|
224 | IntToStr(FControl.RowCount - FControl.FixedRows);
|
---|
225 | // result := 'Column ' + ColumnName + ', Row ' + RowName; <-- original line. //kt 8/21/2007
|
---|
226 | result := DKLangConstW('uAccessibleStringGrid_Column')+' ' + ColumnName + DKLangConstW('uAccessibleStringGrid_x_Row') + RowName; //kt added 8/21/2007
|
---|
227 | end
|
---|
228 | else
|
---|
229 | // result := 'Unknown Property'; <-- original line. //kt 8/21/2007
|
---|
230 | result := DKLangConstW('uAccessibleStringGrid_Unknown_Property'); //kt added 8/21/2007
|
---|
231 | end;
|
---|
232 | else
|
---|
233 | // result := 'Unknown Property'; <-- original line. //kt 8/21/2007
|
---|
234 | result := DKLangConstW('uAccessibleStringGrid_Unknown_Property'); //kt added 8/21/2007
|
---|
235 | end;
|
---|
236 | end;
|
---|
237 |
|
---|
238 | function TAccessibleStringGrid.Get_accParent: IDispatch;
|
---|
239 | begin
|
---|
240 | result := nil;
|
---|
241 | if Assigned(DefaultObject) then
|
---|
242 | result := DefaultObject.Get_accParent;
|
---|
243 | end;
|
---|
244 |
|
---|
245 | function TAccessibleStringGrid.Get_accRole(
|
---|
246 | varChild: OleVariant): OleVariant;
|
---|
247 | begin
|
---|
248 | case ChildType(varChild) of
|
---|
249 | ctNoChild:
|
---|
250 | result := ROLE_SYSTEM_LIST;
|
---|
251 | ctChild:
|
---|
252 | result := ROLE_SYSTEM_LISTITEM;
|
---|
253 | else
|
---|
254 | result := ROLE_SYSTEM_CLIENT;
|
---|
255 | end;
|
---|
256 | end;
|
---|
257 |
|
---|
258 | function TAccessibleStringGrid.Get_accSelection: OleVariant;
|
---|
259 | begin
|
---|
260 | //We are assuming single-selection for this control
|
---|
261 | if Assigned(FControl) then
|
---|
262 | result := FControl.ColRowToIndex(FControl.Col, FControl.Row)
|
---|
263 | else
|
---|
264 | result := NULL;
|
---|
265 | end;
|
---|
266 |
|
---|
267 | function TAccessibleStringGrid.Get_accState(
|
---|
268 | varChild: OleVariant): OleVariant;
|
---|
269 | begin
|
---|
270 | if Assigned(FControl) then
|
---|
271 | begin
|
---|
272 | result := STATE_SYSTEM_FOCUSABLE or STATE_SYSTEM_READONLY or STATE_SYSTEM_SELECTABLE;
|
---|
273 | case ChildType(varChild) of
|
---|
274 | ctNoChild:
|
---|
275 | if FControl.Focused then
|
---|
276 | result := result or STATE_SYSTEM_FOCUSED;
|
---|
277 | ctChild:
|
---|
278 | begin
|
---|
279 | if FControl.ColRowToIndex(FControl.Col, FControl.Row) = varChild then
|
---|
280 | begin
|
---|
281 | result := result or STATE_SYSTEM_SELECTED;
|
---|
282 | if FControl.Focused then
|
---|
283 | result := result or STATE_SYSTEM_FOCUSED;
|
---|
284 | end;
|
---|
285 | end;
|
---|
286 | end;
|
---|
287 | if ([csCreating,csDestroyingHandle] * FControl.ControlState <> []) or
|
---|
288 | ([csDestroying,csFreeNotification,csLoading,csWriting] * FControl.ComponentState <> []) then
|
---|
289 | result := result or STATE_SYSTEM_UNAVAILABLE;
|
---|
290 | end
|
---|
291 | else
|
---|
292 | result := STATE_SYSTEM_UNAVAILABLE;
|
---|
293 | end;
|
---|
294 |
|
---|
295 | function TAccessibleStringGrid.Get_accValue(
|
---|
296 | varChild: OleVariant): WideString;
|
---|
297 | var
|
---|
298 | Row,Col: integer;
|
---|
299 | begin
|
---|
300 | case ChildType(varChild) of
|
---|
301 | ctNoChild:
|
---|
302 | result := '';
|
---|
303 | ctChild:
|
---|
304 | begin
|
---|
305 | if Assigned(FControl) then
|
---|
306 | begin
|
---|
307 | FControl.IndexToColRow(varChild,Col,Row);
|
---|
308 | result := FControl.Cells[Col,Row];
|
---|
309 | if FControl.JustToTab then
|
---|
310 | result := Copy(result, 1, pos(#9{Tab},Result) -1);
|
---|
311 | end
|
---|
312 | else
|
---|
313 | // result := 'Unknown Property'; <-- original line. //kt 8/21/2007
|
---|
314 | result := DKLangConstW('uAccessibleStringGrid_Unknown_Property'); //kt added 8/21/2007
|
---|
315 | end;
|
---|
316 | else
|
---|
317 | // result := 'Unknown Property'; <-- original line. //kt 8/21/2007
|
---|
318 | result := DKLangConstW('uAccessibleStringGrid_Unknown_Property'); //kt added 8/21/2007
|
---|
319 | end;
|
---|
320 | end;
|
---|
321 |
|
---|
322 | procedure TAccessibleStringGrid.accDoDefaultAction(varChild: OleVariant);
|
---|
323 | begin
|
---|
324 | if Assigned(DefaultObject) then
|
---|
325 | DefaultObject.accDoDefaultAction(varChild);
|
---|
326 | end;
|
---|
327 |
|
---|
328 | procedure TAccessibleStringGrid.accLocation(out pxLeft, pyTop, pcxWidth,
|
---|
329 | pcyHeight: Integer; varChild: OleVariant);
|
---|
330 | var
|
---|
331 | P: TPoint;
|
---|
332 | R: TRect;
|
---|
333 | begin
|
---|
334 | if Assigned(FControl) then
|
---|
335 | begin
|
---|
336 | case ChildType(varChild) of
|
---|
337 | ctNoChild:
|
---|
338 | begin
|
---|
339 | P.X := 0;
|
---|
340 | P.Y := 0;
|
---|
341 | with FControl.ClientToScreen(P) do begin
|
---|
342 | pxLeft := X;
|
---|
343 | pyTop := Y;
|
---|
344 | end;
|
---|
345 | pcxWidth := FControl.Width;
|
---|
346 | pcyHeight := FControl.Height;
|
---|
347 | end;
|
---|
348 | ctChild:
|
---|
349 | begin
|
---|
350 | R := FControl.CellRect(FControl.Col,FControl.Row);
|
---|
351 | with FControl.ClientToScreen(R.TopLeft) do begin
|
---|
352 | pxLeft := X;
|
---|
353 | pyTop := Y;
|
---|
354 | end;
|
---|
355 | pcxWidth := R.Right - R.Left;
|
---|
356 | pcyHeight := R.Bottom - R.Top;
|
---|
357 | end;
|
---|
358 | else
|
---|
359 | begin
|
---|
360 | pxLeft := 0;
|
---|
361 | pyTop := 0;
|
---|
362 | pcxWidth := 0;
|
---|
363 | pcyHeight := 0;
|
---|
364 | end;
|
---|
365 | end;
|
---|
366 | end;
|
---|
367 | end;
|
---|
368 |
|
---|
369 | procedure TAccessibleStringGrid.accSelect(flagsSelect: Integer;
|
---|
370 | varChild: OleVariant);
|
---|
371 | begin
|
---|
372 | if Assigned(DefaultObject) then
|
---|
373 | DefaultObject.accSelect(flagsSelect, varChild);
|
---|
374 | end;
|
---|
375 |
|
---|
376 | procedure TAccessibleStringGrid.Set_accName(varChild: OleVariant;
|
---|
377 | const pszName: WideString);
|
---|
378 | begin
|
---|
379 | if Assigned(DefaultObject) then
|
---|
380 | DefaultObject.Set_accName(varChild, pszName);
|
---|
381 | end;
|
---|
382 |
|
---|
383 | procedure TAccessibleStringGrid.Set_accValue(varChild: OleVariant;
|
---|
384 | const pszValue: WideString);
|
---|
385 | var
|
---|
386 | Row,Col: integer;
|
---|
387 | begin
|
---|
388 | case ChildType(varChild) of
|
---|
389 | ctChild:
|
---|
390 | begin
|
---|
391 | if Assigned(FControl) then
|
---|
392 | begin
|
---|
393 | FControl.IndexToColRow(varChild,Col,Row);
|
---|
394 | FControl.Cells[Col,Row] := pszValue;
|
---|
395 | end;
|
---|
396 | end;
|
---|
397 | end;
|
---|
398 | end;
|
---|
399 |
|
---|
400 | function TAccessibleStringGrid.ChildType(varChild: OleVariant): TChildType;
|
---|
401 | begin
|
---|
402 | if VarType(varChild) <> varInteger then
|
---|
403 | result := ctInvalid
|
---|
404 | else if varChild = CHILDID_SELF then
|
---|
405 | result := ctNoChild
|
---|
406 | else
|
---|
407 | result := ctChild;
|
---|
408 | end;
|
---|
409 |
|
---|
410 | function TAccessibleStringGrid.GetDefaultObject: IAccessible;
|
---|
411 | begin
|
---|
412 | if Assigned(FControl) and not FDefaultObjectLoaded then begin
|
---|
413 | FDefaultObject := uAccessAPI.GetDefaultObject(FControl);
|
---|
414 | FDefaultObjectLoaded := True;
|
---|
415 | end;
|
---|
416 | Result := FDefaultObject;
|
---|
417 | end;
|
---|
418 |
|
---|
419 | function TAccessibleStringGrid.SafeCallException(ExceptObject: TObject;
|
---|
420 | ExceptAddr: Pointer): HResult;
|
---|
421 | begin
|
---|
422 | if (ExceptObject is EOleSysError) then
|
---|
423 | result := EOleSysError(ExceptObject).ErrorCode
|
---|
424 | else
|
---|
425 | result := inherited SafeCallException(ExceptObject, ExceptAddr);
|
---|
426 | end;
|
---|
427 |
|
---|
428 | class procedure TAccessibleStringGrid.UnwrapControl(
|
---|
429 | Control: TCaptionStringGrid);
|
---|
430 | begin
|
---|
431 | if not UserIsRestricted then
|
---|
432 | Control.MakeAccessible(nil);
|
---|
433 | end;
|
---|
434 |
|
---|
435 | class procedure TAccessibleStringGrid.WrapControl(
|
---|
436 | Control: TCaptionStringGrid);
|
---|
437 | var
|
---|
438 | AccessibleStringGrid: TAccessibleStringGrid;
|
---|
439 | {Using Accessible here is probably just interface reference count paranoia}
|
---|
440 | Accessible: IAccessible;
|
---|
441 | begin
|
---|
442 | if not UserIsRestricted then
|
---|
443 | begin
|
---|
444 | AccessibleStringGrid := TAccessibleStringGrid.Create;
|
---|
445 | Accessible := AccessibleStringGrid;
|
---|
446 | AccessibleStringGrid.Control := Control;
|
---|
447 | Control.MakeAccessible(Accessible);
|
---|
448 | end;
|
---|
449 | end;
|
---|
450 |
|
---|
451 | initialization
|
---|
452 | try
|
---|
453 | TAutoObjectFactory.Create(ComServer, TAccessibleStringGrid, Class_AccessibleStringGrid,
|
---|
454 | ciMultiInstance, tmApartment);
|
---|
455 | except
|
---|
456 | {Let the poor restricted users pass!}
|
---|
457 | UserIsRestricted := True;
|
---|
458 | end;
|
---|
459 | end.
|
---|