source: cprs/trunk/VA/VA508Accessibility/VA508DelphiCompatibility.pas@ 1710

Last change on this file since 1710 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 15.4 KB
Line 
1unit VA508DelphiCompatibility;
2
3interface
4
5uses
6 SysUtils, Classes, Controls, Windows, StdCtrls, CheckLst, ExtCtrls, Forms,
7 ValEdit, DBGrids, Calendar, ComCtrls, VA508AccessibilityManager;
8
9function GetCheckBoxComponentName(AllowGrayed: boolean): string;
10function GetCheckBoxInstructionMessage(Checked: boolean): string;
11function GetCheckBoxStateText(State: TCheckBoxState): String;
12
13procedure ListViewIndexQueryProc(Sender: TObject; ItemIndex: integer; var Text: string);
14
15type
16 TVA508StaticTextManager = class(TVA508ManagedComponentClass)
17 public
18 constructor Create; override;
19 function GetComponentName(Component: TWinControl): string; override;
20 function GetCaption(Component: TWinControl): string; override;
21 function GetValue(Component: TWinControl): string; override;
22 end;
23
24implementation
25
26uses Grids, VA508AccessibilityRouter, VA508AccessibilityConst, VA508MSAASupport,
27 VAUtils;
28
29type
30 TCheckBox508Manager = class(TVA508ManagedComponentClass)
31 public
32 constructor Create; override;
33 function GetComponentName(Component: TWinControl): string; override;
34 function GetInstructions(Component: TWinControl): string; override;
35 function GetState(Component: TWinControl): string; override;
36 end;
37
38 TCheckListBox508Manager = class(TVA508ManagedComponentClass)
39 private
40 function GetIndex(Component: TWinControl): integer;
41 public
42 constructor Create; override;
43 function GetComponentName(Component: TWinControl): string; override;
44 function GetState(Component: TWinControl): string; override;
45 function GetItem(Component: TWinControl): TObject; override;
46 function GetItemInstructions(Component: TWinControl): string; override;
47 end;
48
49 TVA508EditManager = class(TVA508ManagedComponentClass)
50 public
51 constructor Create; override;
52 function GetValue(Component: TWinControl): string; override;
53 end;
54
55 TVA508ComboManager = class(TVA508ManagedComponentClass)
56 public
57 constructor Create; override;
58 function GetValue(Component: TWinControl): string; override;
59 end;
60
61 TCustomGrid508Manager = class(TVA508ManagedComponentClass)
62 private
63 public
64 constructor Create; override;
65 function GetComponentName(Component: TWinControl): string; override;
66 function GetInstructions(Component: TWinControl): string; override;
67 function GetValue(Component: TWinControl): string; override;
68 function GetItem(Component: TWinControl): TObject; override;
69// function GetData(Component: TWinControl; Value: string): string; override;
70 end;
71
72 TVA508RegistrationScreenReader = class(TVA508ScreenReader);
73
74function CustomComboAlternateHandle(Component: TWinControl): HWnd; forward;
75
76procedure ListViewIndexQueryProc(Sender: TObject; ItemIndex: integer; var Text: string);
77var
78 temp: string;
79 view: TListView;
80 item: TListItem;
81 i: integer;
82 include: boolean;
83
84 procedure Append(txt: string);
85 begin
86 if txt = '' then exit;
87 if text <> '' then
88 text := text + ' ';
89 text := text + txt + ',';
90 end;
91
92 procedure AppendHeader(txt: string);
93 begin
94 if txt = '' then
95 txt := 'blank header';
96 Append(txt);
97 end;
98
99begin
100 view := TListView(Sender);
101 Text := '';
102 include := TRUE;
103 if (ItemIndex < 0) or (ItemIndex >= view.Items.Count) then exit;
104 item := view.Items.Item[ItemIndex];
105 if (view.ViewStyle = vsReport) and (view.Columns.Count > 0) then
106 begin
107 if view.Columns[0].Width < 1 then
108 include := FALSE
109 else
110 AppendHeader(view.Columns[0].Caption);
111 end;
112 if include then
113 begin
114 temp := item.Caption;
115 if temp = '' then
116 temp := 'blank';
117 Append(temp);
118 end;
119
120 if view.ViewStyle = vsReport then
121 begin
122 for i := 1 to view.Columns.Count - 1 do
123 begin
124 if view.Columns[i].Width > 0 then
125 begin
126 AppendHeader(view.Columns[i].Caption);
127 if (i-1) < item.SubItems.Count then
128 temp := item.SubItems[i-1]
129 else
130 temp := '';
131 if temp = '' then
132 temp := 'blank';
133 Append(temp);
134 end;
135 end;
136 end;
137end;
138
139procedure RegisterStandardDelphiComponents;
140begin
141 RegisterAlternateHandleComponent(TCustomCombo, CustomComboAlternateHandle);
142 RegisterManagedComponentClass(TCheckBox508Manager.Create);
143 RegisterManagedComponentClass(TCheckListBox508Manager.Create);
144 RegisterManagedComponentClass(TCustomGrid508Manager.Create);
145 RegisterManagedComponentClass(TVA508StaticTextManager.Create);
146 RegisterManagedComponentClass(TVA508EditManager.Create);
147 RegisterManagedComponentClass(TVA508ComboManager.Create);
148
149 with TVA508RegistrationScreenReader(GetScreenReader) do
150 begin
151 // even though TListView is in Default.JCF, we add it here to clear out previous MSAA setting
152 RegisterCustomClassBehavior(TListView.ClassName, CLASS_BEHAVIOR_LIST_VIEW);
153 RegisterCustomClassBehavior(TVA508StaticText.ClassName, CLASS_BEHAVIOR_STATIC_TEXT);
154 end;
155
156 RegisterMSAAQueryListClassProc(TListView, ListViewIndexQueryProc);
157
158{ TODO -oJeremy Merrill -c508 :
159Add these components as ones that need an alternate handle
160TColorBox
161TValueListEditor ?? - may be fixed because it's a TStringGrid
162TCaptionStringGrid
163TToolBar (not needed when the tool bar doesn't have focus)
164TPageScroller
165
166add stuff for image processing
167descendents of TCustomTabControl
168
169
170}
171
172{ TODO -oJeremy Merrill -c508 :Need to create a fix for the list box stuff here}
173end;
174
175{ TCustomCombo Alternate Handle }
176
177type
178 TExposedCustomCombo = class(TCustomCombo)
179 public
180 property EditHandle;
181 end;
182
183function CustomComboAlternateHandle(Component: TWinControl): HWnd;
184begin
185 Result := TExposedCustomCombo(Component).EditHandle;
186end;
187
188{ Check Box Utils - used by multiple classes }
189
190function GetCheckBoxComponentName(AllowGrayed: boolean): string;
191begin
192 if AllowGrayed then
193 Result := 'Three State Check Box'
194 else
195 Result := 'Check Box';
196end;
197
198function GetCheckBoxInstructionMessage(Checked: boolean): string;
199begin
200 if not Checked then // handles clear and gray entries
201 Result := 'to check press space bar'
202 else
203 Result := 'to clear check mark press space bar';
204end;
205
206function GetCheckBoxStateText(State: TCheckBoxState): String;
207begin
208 case State of
209 cbUnchecked: Result := 'not checked';
210 cbChecked: Result := 'checked';
211 cbGrayed: Result := 'Partially Checked';
212 else Result := '';
213 end;
214end;
215{ TCheckBox508Manager }
216
217constructor TCheckBox508Manager.Create;
218begin
219 inherited Create(TCheckBox, [mtComponentName, mtInstructions, mtState, mtStateChange]);
220end;
221
222function TCheckBox508Manager.GetComponentName(Component: TWinControl): string;
223begin
224 Result := GetCheckBoxComponentName(TCheckBox(Component).AllowGrayed);
225end;
226
227function TCheckBox508Manager.GetInstructions(Component: TWinControl): string;
228begin
229 Result := GetCheckBoxInstructionMessage(TCheckBox(Component).Checked);
230end;
231
232function TCheckBox508Manager.GetState(Component: TWinControl): string;
233begin
234 Result := GetCheckBoxStateText(TCheckBox(Component).State);
235end;
236
237{ TCheckListBox508Manager }
238
239constructor TCheckListBox508Manager.Create;
240begin
241 inherited Create(TCheckListBox, [mtComponentName, mtState, mtStateChange, mtItemChange, mtItemInstructions]);
242end;
243
244function TCheckListBox508Manager.GetComponentName(
245 Component: TWinControl): string;
246var
247 lb : TCheckListBox;
248begin
249 lb := TCheckListBox(Component);
250 if lb.AllowGrayed then
251 Result := 'Three State Check List Box'
252 else
253 Result := 'Check List Box';
254end;
255
256function TCheckListBox508Manager.GetItemInstructions(
257 Component: TWinControl): string;
258var
259 lb : TCheckListBox;
260 idx: integer;
261begin
262 lb := TCheckListBox(Component);
263 idx := GetIndex(Component);
264 if (idx < 0) then
265 Result := ''
266 else
267 Result := GetCheckBoxInstructionMessage(lb.Checked[idx]);
268end;
269
270function TCheckListBox508Manager.GetIndex(Component: TWinControl): integer;
271var
272 lb : TCheckListBox;
273begin
274 lb := TCheckListBox(Component);
275 if (lb.ItemIndex < 0) then
276 begin
277 if lb.Count > 0 then
278 Result := 0
279 else
280 Result := -1
281 end
282 else
283 Result := lb.ItemIndex;
284end;
285
286function TCheckListBox508Manager.GetItem(Component: TWinControl): TObject;
287var
288 lb : TCheckListBox;
289begin
290 lb := TCheckListBox(Component);
291 Result := TObject((lb.items.Count * 10000) + (lb.ItemIndex + 2));
292end;
293
294function TCheckListBox508Manager.GetState(Component: TWinControl): string;
295var
296 lb : TCheckListBox;
297 idx: integer;
298begin
299 lb := TCheckListBox(Component);
300 idx := GetIndex(Component);
301 if idx < 0 then
302 Result := ''
303 else
304 Result := GetCheckBoxStateText(lb.State[idx]);
305end;
306
307{ TCustomForm508Manager }
308
309type
310 TAccessGrid = class(TCustomGrid);
311
312constructor TCustomGrid508Manager.Create;
313begin
314{ TODO : Add support for other string grid features - like state changes for editing or selecting cells }
315// inherited Create(TStringGrid, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE);
316 inherited Create(TCustomGrid, [mtComponentName, mtInstructions, mtValue, mtItemChange], TRUE);
317// FLastX := -1;
318// FLastY := -1;
319end;
320
321// Data pieces
322// 1 = Column header, if any
323// 2 = Column #
324// 3 = number of columns
325// 4 = Row header, if any
326// 5 = Row #
327// 6 = number of rows
328// 7 = Cell #
329// 8 = total # of cells
330// 9 = cell contents
331
332const
333 DELIM = '^';
334
335function TCustomGrid508Manager.GetComponentName(Component: TWinControl): string;
336begin
337 Result := ' grid ';
338 // don't use 'grid' - we're abandoning the special code in the JAWS scripts for
339 // grids - it's too messy, and based on the 'grid' component name
340end;
341{
342function TCustomGrid508Manager.GetData(Component: TWinControl; Value: string): string;
343
344var
345 grid: TAccessGrid;
346 row, col: integer;
347 cnt, x, y, max, mult: integer;
348 txt: string;
349
350 procedure Add(txt: integer); overload;
351 begin
352 Result := Result + inttostr(txt) + DELIM;
353 end;
354
355 procedure Add(txt: string); overload;
356 begin
357 Result := Result + Piece(txt,DELIM,1) + DELIM;
358 end;
359
360begin
361 grid := TAccessGrid(Component);
362 row := grid.Row;
363 col := grid.Col;
364 if (row >= 0) and (col >= 0) then
365 begin
366 if grid.FixedRows > 0 then
367 Add(grid.GetEditText(col, 0))
368 else
369 Add('');
370 Add(col - grid.FixedCols + 1);
371 Add(grid.ColCount - grid.FixedCols);
372
373 if grid.FixedCols > 0 then
374 Add(grid.GetEditText(0, row))
375 else
376 Add('');
377 Add(row - grid.FixedRows + 1);
378 Add(grid.RowCount - grid.FixedRows);
379
380 x := grid.ColCount - grid.FixedCols;
381 y := grid.RowCount - grid.FixedRows;
382 max := x * y;
383 x := grid.Col - grid.FixedCols;
384 y := grid.Row - grid.FixedRows;
385 mult := grid.ColCount - grid.FixedCols;
386
387 if (mult > 0) and
388 (x >= 0) and (x < grid.ColCount) and
389 (y >= 0) and (y < grid.RowCount) then
390 begin
391 cnt := (y * mult) + x + 1;
392 Add(cnt);
393 end
394 else
395 Add(0);
396 Add(max);
397
398 if Value = '' then
399 txt := grid.GetEditText(col, row)
400 else
401 txt := Value;
402
403 Add(txt);
404 delete(Result,length(Result),1); // remove trailing delimeter
405 end
406 else
407 Result := '';
408end; }
409
410function TCustomGrid508Manager.GetInstructions(Component: TWinControl): string;
411var
412 grid: TAccessGrid;
413// cnt, x, y, max, mult: integer;
414begin
415 Result := '';
416 grid := TAccessGrid(Component);
417// x := grid.ColCount - grid.FixedCols;
418// y := grid.RowCount - grid.FixedRows;
419// max := x * y;
420// x := grid.Col - grid.FixedCols;
421// y := grid.Row - grid.FixedRows;
422// mult := grid.ColCount - grid.FixedCols;
423//
424// if (mult > 0) and
425// (x >= 0) and (x < grid.ColCount) and
426// (y >= 0) and (y < grid.RowCount) then
427// begin
428// cnt := (y * mult) + x + 1;
429// Result := IntToStr(cnt) + ' of ' + inttostr(max) + ', ';
430// end;
431 Result := Result + 'To move to items use the arrow ';
432 if goTabs in grid.Options then
433 Result := Result + ' or tab ';
434 Result := Result + 'keys';
435end;
436
437// if
438// key
439//end;
440(*
441listbox
442column 120 row 430
443
444unavailable (text of cell?) read only
445
44620 or 81
447
448
449
450listbox
451column 3 of 10
452row 6 of 10
453
454unavailable (text of cell?) read only
455
45620 or 81
457
458
459
460with each navigation:
461
462column 3 of 10
463row 6 of 10
464
465unavailable (text of cell?) read only
466*)
467
468
469function TCustomGrid508Manager.GetItem(Component: TWinControl): TObject;
470var
471 grid: TAccessGrid;
472 row, col, maxRow: integer;
473begin
474 grid := TAccessGrid(Component);
475 row := grid.Row + 2;
476 col := grid.Col + 2;
477 MaxRow := grid.RowCount + 3;
478 if MaxRow < 1000 then
479 MaxRow := 1000;
480 Result := TObject((row * maxRow) + col);
481end;
482
483//function TCustomGrid508Manager.GetValue(Component: TWinControl): string;
484//var
485// grid: TAccessGrid;
486//begin
487// grid := TAccessGrid(Component);
488// Result := Piece(grid.GetEditText(grid.Col, grid.Row), DELIM, 1);
489//end;
490
491
492function TCustomGrid508Manager.GetValue(Component: TWinControl): string;
493var
494 grid: TAccessGrid;
495 row, col: integer;
496 colHdr, rowHdr, txt: string;
497
498begin
499 grid := TAccessGrid(Component);
500 row := grid.Row;
501 col := grid.Col;
502 if (row >= 0) and (col >= 0) then
503 begin
504// if col <> FLastX then
505// begin
506 if grid.FixedRows > 0 then
507 colHdr := Piece(grid.GetEditText(col, 0), DELIM, 1)
508 else
509 colHdr := '';
510 if colHdr = '' then
511 colHdr := inttostr(col+1-grid.FixedCols) + ' of ' + inttostr(grid.ColCount-grid.FixedCols);
512 colHdr := 'column ' + colhdr + ', ';
513// end
514// else
515// colHdr := '';
516// FLastX := col;
517
518// if row <> FLastY then
519// begin
520 if grid.FixedCols > 0 then
521 rowHdr := Piece(grid.GetEditText(0, row), DELIM, 1)
522 else
523 rowHdr := '';
524 if rowHdr = '' then
525 rowHdr := inttostr(row+1-grid.FixedRows) + ' of ' + inttostr(grid.RowCount-grid.FixedRows);
526 rowHdr := 'row ' + rowhdr + ', ';
527// end
528// else
529// rowHdr := '';
530// FLastY := row;
531
532 txt := Piece(grid.GetEditText(col, row), DELIM, 1);
533 if txt = '' then
534 txt := 'blank';
535 Result := colHdr + rowHdr + txt;
536 end
537 else
538 Result := ' ';
539end;
540
541
542{ TVA508StaticTextManager }
543
544constructor TVA508StaticTextManager.Create;
545begin
546 inherited Create(TVA508StaticText, [mtComponentName, mtCaption, mtValue], TRUE);
547end;
548
549function TVA508StaticTextManager.GetCaption(Component: TWinControl): string;
550begin
551 Result := ' ';
552end;
553
554function TVA508StaticTextManager.GetComponentName(
555 Component: TWinControl): string;
556begin
557 Result := 'label';
558end;
559
560function TVA508StaticTextManager.GetValue(Component: TWinControl): string;
561var
562 next: TVA508ChainedLabel;
563 comp: TVA508StaticText;
564begin
565 comp := TVA508StaticText(Component);
566 Result := comp.Caption;
567 next := comp.NextLabel;
568 while assigned(next) do
569 begin
570 Result := Result + ' ' + next.Caption;
571 next := next.NextLabel;
572 end;
573end;
574
575{ TVA508EditManager }
576
577constructor TVA508EditManager.Create;
578begin
579 inherited Create(TEdit, [mtValue], TRUE);
580end;
581
582function TVA508EditManager.GetValue(Component: TWinControl): string;
583begin
584 Result := TEdit(Component).Text;
585end;
586
587{ TVA508ComboManager }
588
589constructor TVA508ComboManager.Create;
590begin
591 inherited Create(TComboBox, [mtValue], TRUE);
592end;
593
594function TVA508ComboManager.GetValue(Component: TWinControl): string;
595begin
596 Result := TComboBox(Component).Text;
597end;
598
599initialization
600 RegisterStandardDelphiComponents;
601
602end.
Note: See TracBrowser for help on using the repository browser.