source: cprs/trunk/VA/VA508Accessibility/VA508AccessibilityRouter.pas@ 1696

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

Upgrade to version 27

File size: 18.4 KB
Line 
1unit VA508AccessibilityRouter;
2
3interface
4
5uses
6 SysUtils, Windows, Registry, StrUtils, Classes, Controls, Dialogs,
7 Contnrs, DateUtils, Forms, ExtCtrls;
8
9type
10 TComponentDataNeededEvent = procedure(const WindowHandle: HWND; var DataStatus: LongInt;
11 var Caption: PChar; var Value: PChar; var Data: PChar; var ControlType: PChar;
12 var State: PChar; var Instructions: PChar; var ItemInstructions: PChar) of object;
13
14 TKeyMapProcedure = procedure;
15
16 TVA508ScreenReader = class(TObject)
17 protected
18 procedure RegisterCustomClassBehavior(Before, After: string); virtual; abstract;
19 procedure RegisterClassAsMSAA(ClassName: string); virtual; abstract;
20 procedure AddComponentDataNeededEventHandler(event: TComponentDataNeededEvent); virtual; abstract;
21 procedure RemoveComponentDataNeededEventHandler(event: TComponentDataNeededEvent); virtual; abstract;
22 public
23 procedure Speak(Text: string); virtual; abstract;
24 procedure RegisterDictionaryChange(Before, After: string); virtual; abstract;
25 procedure RegisterCustomKeyMapping(Key: string; proc: TKeyMapProcedure;
26 shortDescription, longDescription: string); virtual; abstract;
27 end;
28
29function GetScreenReader: TVA508ScreenReader;
30
31{ TODO -oJeremy Merrill -c508 :
32if ScreenReaderSystemActive is false, but there are valid DLLs, add a recheck every 30 seconds
33to see if the screen reader is running. in the timer event, see if DLL.IsRunning is running is true.
34if it is then pop up a message to the user (only once) and inform them that if they restart the app
35with the screen reader running it will work better. After the popup disable the timer event. }
36function ScreenReaderSystemActive: boolean;
37
38// Only guaranteed to be valid if called in an initialization section
39// all other components stored as .dfm files will be registered as a dialog
40// using the RegisterCustomClassBehavior
41procedure SpecifyFormIsNotADialog(FormClass: TClass);
42
43// do not call this routine - called by screen reader DLL
44procedure ComponentDataRequested(WindowHandle: HWND; DataRequest: LongInt); stdcall;
45
46implementation
47
48uses VAUtils, VA508ScreenReaderDLLLinker, VAClasses, VA508AccessibilityConst;
49
50type
51 TNullScreenReader = class(TVA508ScreenReader)
52 public
53 procedure Speak(Text: string); override;
54 procedure RegisterDictionaryChange(Before, After: string); override;
55 procedure RegisterCustomClassBehavior(Before, After: string); override;
56 procedure RegisterClassAsMSAA(ClassName: string); override;
57 procedure RegisterCustomKeyMapping(Key: string; proc: TKeyMapProcedure;
58 shortDescription, longDescription: string); override;
59 procedure AddComponentDataNeededEventHandler(event: TComponentDataNeededEvent); override;
60 procedure RemoveComponentDataNeededEventHandler(event: TComponentDataNeededEvent); override;
61 end;
62
63 TMasterScreenReader = class(TVA508ScreenReader)
64 strict private
65 FEventHandlers: TVAMethodList;
66 FCustomBehaviors: TStringList;
67 FInternalRegistration: boolean;
68 FDataHasBeenRegistered: boolean;
69 FTrying2Register: boolean;
70 FKeyProc: TList;
71 private
72 function EncodeBehavior(Before, After: string; Action: integer): string;
73 procedure DecodeBehavior(code: string; var Before, After: string;
74 var Action: integer);
75 function RegistrationAllowed: boolean;
76 procedure RegisterCustomData;
77 protected
78 procedure RegisterCustomBehavior(Str1, Str2: String; Action: integer; CheckIR: boolean = FALSE);
79 procedure ProcessCustomKeyCommand(DataRequest: integer);
80 property EventHandlers: TVAMethodList read FEventHandlers;
81 public
82 constructor Create;
83 destructor Destroy; override;
84 procedure HandleSRException(E: Exception);
85 procedure Speak(Text: string); override;
86 procedure RegisterDictionaryChange(Before, After: string); override;
87 procedure RegisterCustomClassBehavior(Before, After: string); override;
88 procedure RegisterClassAsMSAA(ClassName: string); override;
89 procedure RegisterCustomKeyMapping(Key: string; proc: TKeyMapProcedure;
90 shortDescription, longDescription: string); override;
91 procedure AddComponentDataNeededEventHandler(event: TComponentDataNeededEvent); override;
92 procedure RemoveComponentDataNeededEventHandler(event: TComponentDataNeededEvent); override;
93 end;
94
95var
96 ActiveScreenReader: TVA508ScreenReader = nil;
97 MasterScreenReader: TMasterScreenReader = nil;
98 uNonDialogClassNames: TStringList = nil;
99 SaveInitProc: Pointer = nil;
100 Need2RegisterData: boolean = FALSE;
101 OK2RegisterData: boolean = FALSE;
102 CheckScreenReaderSystemActive: boolean = TRUE;
103 uScreenReaderSystemActive: boolean = FALSE;
104 uPostScreenReaderActivationTimer: TTimer = nil;
105
106const
107// number of seconds between checks for a screen reader
108 POST_SCREEN_READER_ACTIVATION_CHECK_SECONDS = 30;
109
110 POST_SCREEN_READER_INFO_MESSAGE = ERROR_INTRO +
111 'The Accessibility Framework can only communicate with the screen' + CRLF +
112 'reader if the screen reader is running before you start this application.'+ CRLF +
113 'Please restart %s to take advantage of the enhanced'+ CRLF +
114 'accessibility features offered by the Accessibility Framework.';
115
116procedure VA508RouterInitProc;
117begin
118 if assigned(SaveInitProc) then
119 TProcedure(SaveInitProc);
120 OK2RegisterData := TRUE;
121 if Need2RegisterData then
122 begin
123 Need2RegisterData := FALSE;
124 if ScreenReaderSystemActive then
125 begin
126 TMasterScreenReader(GetScreenreader).RegisterCustomData;
127 end;
128 end;
129end;
130
131function GetScreenReader: TVA508ScreenReader;
132begin
133 if not assigned(ActiveScreenReader) then
134 begin
135 if ScreenReaderSystemActive then
136 begin
137 MasterScreenReader := TMasterScreenReader.Create;
138 ActiveScreenReader := MasterScreenReader;
139 end
140 else
141 ActiveScreenReader := TNullScreenReader.Create;
142 end;
143 Result := ActiveScreenReader;
144end;
145
146procedure PostScreenReaderCheckEvent(Self: TObject; Sender: TObject);
147var
148 AppName, ext, error: string;
149begin
150 if ScreenReaderActive then
151 begin
152 FreeAndNil(uPostScreenReaderActivationTimer);
153 if IsScreenReaderSupported(TRUE) then
154 begin
155 AppName := ExtractFileName(ParamStr(0));
156 ext := ExtractFileExt(AppName);
157 AppName := LeftStr(AppName, length(AppName) - Length(ext));
158 error := Format(POST_SCREEN_READER_INFO_MESSAGE, [AppName]);
159 MessageBox(0, PChar(error), 'Accessibility Component Information',
160 MB_OK or MB_ICONINFORMATION or MB_TASKMODAL or MB_TOPMOST);
161 end;
162 end;
163end;
164
165function ScreenReaderSystemActive: boolean;
166
167 procedure CreateTimer;
168 var
169 ptr: TMethod;
170 begin
171 uPostScreenReaderActivationTimer := TTimer.Create(nil);
172 with uPostScreenReaderActivationTimer do
173 begin
174 Enabled := FALSE;
175 Interval := 1000 * POST_SCREEN_READER_ACTIVATION_CHECK_SECONDS;
176 ptr.Code := @PostScreenReaderCheckEvent;
177 ptr.Data := @ptr;
178 OnTimer := TNotifyEvent(ptr);
179 Enabled := TRUE;
180 end;
181 end;
182
183begin
184 if CheckScreenReaderSystemActive then
185 begin
186 CheckScreenReaderSystemActive := FALSE;
187 // prevent Delphi IDE from running DLL
188 if LowerCase(ExtractFileName(ParamStr(0))) <> 'bds.exe' then
189 uScreenReaderSystemActive := ScreenReaderDLLsExist;
190 if uScreenReaderSystemActive then
191 begin
192 if ScreenReaderSupportEnabled then
193 begin
194 if IsScreenReaderSupported(FALSE) then
195 uScreenReaderSystemActive := InitializeScreenReaderLink
196 else
197 uScreenReaderSystemActive := FALSE;
198 end
199 else
200 begin
201 uScreenReaderSystemActive := FALSE;
202 CreateTimer;
203 end;
204 end;
205 end;
206 Result := uScreenReaderSystemActive;
207end;
208
209procedure SpecifyFormIsNotADialog(FormClass: TClass);
210var
211 lc: string;
212begin
213 if ScreenReaderSystemActive then
214 begin
215 lc := lowercase(FormClass.ClassName);
216 if not assigned(uNonDialogClassNames) then
217 uNonDialogClassNames := TStringList.Create;
218 if uNonDialogClassNames.IndexOf(lc) < 0 then
219 uNonDialogClassNames.Add(lc);
220 if assigned(MasterScreenReader) then
221 MasterScreenReader.RegisterCustomBehavior(FormClass.ClassName, '',
222 BEHAVIOR_REMOVE_COMPONENT_CLASS, TRUE);
223 end;
224end;
225
226{ TMasterScreenReader }
227
228procedure TMasterScreenReader.AddComponentDataNeededEventHandler(event: TComponentDataNeededEvent);
229begin
230 FEventHandlers.Add(TMethod(event));
231end;
232
233constructor TMasterScreenReader.Create;
234begin
235 FEventHandlers := TVAMethodList.Create;
236 FCustomBehaviors := TStringList.Create;
237 FInternalRegistration := FALSE;
238 FDataHasBeenRegistered := FALSE;
239 FKeyProc := TList.Create;
240end;
241
242procedure TMasterScreenReader.DecodeBehavior(code: string; var Before,
243 After: string; var Action: integer);
244
245 function Decode(var MasterString: string): string;
246 var
247 CodeLength: integer;
248 hex: string;
249
250 begin
251 Result := '';
252 if length(MasterString) > 1 then
253 begin
254 hex := copy(MasterString,1,2);
255 CodeLength := FastHexToByte(hex);
256 Result := copy(MasterString, 3, CodeLength);
257 delete(MasterString, 1, CodeLength + 2);
258 end;
259 end;
260
261begin
262 Action := StrToIntDef(Decode(code), 0);
263 Before := Decode(code);
264 After := Decode(code);
265 if code <> '' then
266 Raise TVA508Exception.Create('Corrupted Custom Behavior');
267end;
268
269destructor TMasterScreenReader.Destroy;
270begin
271 CloseScreenReaderLink;
272 FreeAndNil(FEventHandlers);
273 FreeAndNil(FCustomBehaviors);
274 FreeAndNil(FKeyProc);
275 inherited;
276end;
277
278function TMasterScreenReader.EncodeBehavior(Before, After: string;
279 Action: integer): string;
280
281 function Coded(str: string): string;
282 var
283 len: integer;
284 begin
285 len := length(str);
286 if len > 255 then
287 Raise TVA508Exception.Create('RegisterCustomBehavior parameter can not be more than 255 characters long');
288 Result := HexChars[len] + str;
289 end;
290
291begin
292 Result := Coded(IntToStr(Action)) + Coded(Before) + Coded(After);
293end;
294
295procedure TMasterScreenReader.HandleSRException(E: Exception);
296begin
297 if not E.ClassNameIs(TVA508Exception.ClassName) then
298 raise E;
299end;
300
301procedure TMasterScreenReader.ProcessCustomKeyCommand(DataRequest: integer);
302var
303 idx: integer;
304 proc: TKeyMapProcedure;
305begin
306 idx := (DataRequest AND DATA_CUSTOM_KEY_COMMAND_MASK) - 1;
307 if (idx < 0) or (idx >= FKeyProc.count) then exit;
308 proc := TKeyMapProcedure(FKeyProc[idx]);
309 proc;
310end;
311
312procedure TMasterScreenReader.RegisterClassAsMSAA(ClassName: string);
313begin
314 RegisterCustomBehavior(ClassName, '', BEHAVIOR_ADD_COMPONENT_MSAA, TRUE);
315 RegisterCustomBehavior(ClassName, '', BEHAVIOR_REMOVE_COMPONENT_CLASS, TRUE);
316end;
317
318procedure TMasterScreenReader.RegisterCustomBehavior(Str1, Str2: String;
319 Action: integer; CheckIR: boolean = FALSE);
320var
321 code: string;
322 idx: integer;
323 p2: PChar;
324 ok: boolean;
325begin
326 code := EncodeBehavior(Str1, Str2, Action);
327 idx := FCustomBehaviors.IndexOf(code);
328 if idx < 0 then
329 begin
330 FCustomBehaviors.add(code);
331 ok := RegistrationAllowed;
332 if ok and CheckIR then
333 ok := (not FInternalRegistration);
334 if ok then
335 begin
336 try
337 if Str2 = '' then
338 p2 := nil
339 else
340 p2 := PChar(Str2);
341 SRRegisterCustomBehavior(Action, PChar(Str1), P2);
342 except
343 on E: Exception do HandleSRException(E);
344 end;
345 end;
346 end;
347end;
348
349procedure TMasterScreenReader.RegisterCustomClassBehavior(Before,
350 After: string);
351begin
352 RegisterCustomBehavior(Before, After, BEHAVIOR_ADD_COMPONENT_CLASS, TRUE);
353 RegisterCustomBehavior(Before, After, BEHAVIOR_REMOVE_COMPONENT_MSAA, TRUE);
354end;
355
356function EnumResNameProc(module: HMODULE; lpszType: PChar; lpszName: PChar; var list: TStringList): BOOL; stdcall;
357var
358 name: string;
359
360begin
361 name := lpszName;
362 list.Add(name);
363 Result := TRUE;
364end;
365
366procedure TMasterScreenReader.RegisterCustomData;
367var
368 i, action: integer;
369 before, after, code: string;
370
371 procedure EnsureDialogAreSpecified;
372 var
373 list: TStringList;
374 i: integer;
375 stream: TResourceStream;
376 Reader: TReader;
377 ChildPos: Integer;
378 Flags: TFilerFlags;
379 clsName: string;
380 ok: boolean;
381 begin
382 FInternalRegistration := TRUE;
383 try
384 list := TStringList.Create;
385 try
386 if EnumResourceNames(HInstance, RT_RCDATA, @EnumResNameProc, integer(@list)) then
387 begin
388 for i := 0 to list.Count-1 do
389 begin
390 stream := TResourceStream.Create(HInstance, list[i], RT_RCDATA);
391 try
392 Reader := TReader.Create(stream, 512);
393 try
394 try
395 reader.ReadSignature;
396 reader.ReadPrefix(Flags, ChildPos);
397 clsName := reader.ReadStr;
398 ok := not assigned(uNonDialogClassNames);
399 if not ok then
400 ok := (uNonDialogClassNames.IndexOf(lowercase(clsName)) < 0);
401 if ok then
402 RegisterCustomClassBehavior(clsName, CLASS_BEHAVIOR_DIALOG);
403 except
404 end;
405 finally
406 Reader.Free;
407 end;
408 finally
409 stream.Free;
410 end;
411 end;
412 end;
413 finally
414 list.free;
415 end;
416 finally
417 FInternalRegistration := FALSE;
418 end;
419 end;
420
421begin
422 if FTrying2Register then exit;
423 FTrying2Register := TRUE;
424 try
425 if OK2RegisterData then
426 begin
427 try
428 EnsureDialogAreSpecified;
429 RegisterCustomBehavior('','',BEHAVIOR_PURGE_UNREGISTERED_KEY_MAPPINGS);
430 for i := 0 to FCustomBehaviors.Count-1 do
431 begin
432 code := FCustomBehaviors[i];
433 DecodeBehavior(code, before, after, action);
434 SRRegisterCustomBehavior(Action, PChar(Before), PChar(After));
435 end;
436 FDataHasBeenRegistered := TRUE;
437 except
438 on E: Exception do HandleSRException(E);
439 end;
440 end
441 else
442 Need2RegisterData := TRUE;
443 finally
444 FTrying2Register := FALSE;
445 end;
446end;
447
448procedure TMasterScreenReader.RegisterCustomKeyMapping(Key: string; proc: TKeyMapProcedure;
449 shortDescription, longDescription: string);
450var
451 idx: string;
452
453 procedure AddDescription(DescType, Desc: string);
454 var
455 temp: string;
456 begin
457 temp := DescType + idx + '=' + Desc;
458 if length(temp) > 255 then
459 raise TVA508Exception.Create('Key Mapping description for ' + Key + ' exceeds 255 characters');
460 RegisterCustomBehavior(DescType + idx, Desc, BEHAVIOR_ADD_CUSTOM_KEY_DESCRIPTION);
461 end;
462
463begin
464 FKeyProc.Add(@proc);
465 idx := inttostr(FKeyProc.Count);
466 RegisterCustomBehavior(Key, idx, BEHAVIOR_ADD_CUSTOM_KEY_MAPPING);
467 AddDescription('short', shortDescription);
468 AddDescription('long', longDescription);
469end;
470
471procedure TMasterScreenReader.RegisterDictionaryChange(Before, After: string);
472begin
473 RegisterCustomBehavior(Before, After, BEHAVIOR_ADD_DICTIONARY_CHANGE);
474end;
475
476function TMasterScreenReader.RegistrationAllowed: boolean;
477begin
478 Result := FDataHasBeenRegistered;
479 if not Result then
480 begin
481 RegisterCustomData;
482 Result := FDataHasBeenRegistered;
483 end;
484end;
485
486procedure TMasterScreenReader.RemoveComponentDataNeededEventHandler(event: TComponentDataNeededEvent);
487begin
488 FEventHandlers.Remove(TMethod(event));
489end;
490
491procedure TMasterScreenReader.Speak(Text: string);
492begin
493 if (not assigned(SRSpeakText)) or (Text = '') then exit;
494 try
495 SRSpeakText(PChar(Text));
496 except
497 on E: Exception do HandleSRException(E);
498 end;
499end;
500
501// need to post a message here - can't do direct call - this message is called before mouse
502// process messages are called that change a check box state
503procedure ComponentDataRequested(WindowHandle: HWND; DataRequest: LongInt); stdcall;
504var
505 i: integer;
506 Handle: HWND;
507 Caption: PChar;
508 Value: PChar;
509 Data: PChar;
510 ControlType: PChar;
511 State: PChar;
512 Instructions: PChar;
513 ItemInstructions: PChar;
514 DataStatus: LongInt;
515
516 handler: TComponentDataNeededEvent;
517
518begin
519 if assigned(MasterScreenReader) then
520 begin
521 try
522 if (DataRequest AND DATA_CUSTOM_KEY_COMMAND) <> 0 then
523 MasterScreenReader.ProcessCustomKeyCommand(DataRequest)
524 else
525 begin
526 Handle := WindowHandle;
527 Caption := nil;
528 Value := nil;
529 Data := nil;
530 ControlType := nil;
531 State := nil;
532 Instructions := nil;
533 ItemInstructions := nil;
534 DataStatus := DataRequest;
535 i := 0;
536 while (i < MasterScreenReader.EventHandlers.Count) do
537 begin
538 handler := TComponentDataNeededEvent(MasterScreenReader.EventHandlers.Methods[i]);
539 if assigned(handler) then
540 handler(Handle, DataStatus, Caption, Value, Data, ControlType, State,
541 Instructions, ItemInstructions);
542 inc(i);
543 end;
544 SRComponentData(WindowHandle, DataStatus, Caption, Value, Data, ControlType, State, Instructions, ItemInstructions);
545 end;
546 except
547 on E: Exception do MasterScreenReader.HandleSRException(E);
548 end;
549 end;
550end;
551
552{ TNullScreenReader }
553
554procedure TNullScreenReader.AddComponentDataNeededEventHandler(
555 event: TComponentDataNeededEvent);
556begin
557end;
558
559procedure TNullScreenReader.RegisterClassAsMSAA(ClassName: string);
560begin
561end;
562
563procedure TNullScreenReader.RegisterCustomClassBehavior(Before, After: string);
564begin
565end;
566
567procedure TNullScreenReader.RegisterCustomKeyMapping(Key: string; proc: TKeyMapProcedure;
568 shortDescription, longDescription: string);
569begin
570
571end;
572
573procedure TNullScreenReader.RegisterDictionaryChange(Before, After: string);
574begin
575end;
576
577procedure TNullScreenReader.RemoveComponentDataNeededEventHandler(
578 event: TComponentDataNeededEvent);
579begin
580end;
581
582procedure TNullScreenReader.Speak(Text: string);
583begin
584end;
585
586initialization
587 SaveInitProc := InitProc;
588 InitProc := @VA508RouterInitProc;
589
590finalization
591 if assigned(ActiveScreenReader) then
592 FreeAndNil(ActiveScreenReader);
593 if assigned(uNonDialogClassNames) then
594 FreeAndNil(uNonDialogClassNames);
595 if assigned(uPostScreenReaderActivationTimer) then
596 FreeAndNil(uPostScreenReaderActivationTimer);
597
598end.
Note: See TracBrowser for help on using the repository browser.