source: cprs/trunk/VA/VA508Accessibility/JAWS/fVA508DispatcherHiddenWindow.pas@ 1724

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

Upgrade to version 27

File size: 3.0 KB
RevLine 
[829]1unit fVA508DispatcherHiddenWindow;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ExtCtrls;
8
9type
10 TfrmVA508JawsDispatcherHiddenWindow = class(TForm)
11 tmrMain: TTimer;
12 procedure FormCreate(Sender: TObject);
13 procedure FormDestroy(Sender: TObject);
14 procedure tmrMainTimer(Sender: TObject);
15 private
16 FThreads: TStringList;
17 protected
18 procedure WndProc(var Msg: TMessage); override;
19 procedure UpdateThreadList;
20 public
21 { Public declarations }
22 end;
23
24var
25 frmVA508JawsDispatcherHiddenWindow: TfrmVA508JawsDispatcherHiddenWindow;
26
27implementation
28
29uses VAUtils, JAWSCommon;
30
31{$R *.dfm}
32
33procedure TfrmVA508JawsDispatcherHiddenWindow.FormCreate(Sender: TObject);
34begin
35 ErrorCheckClassName(Self, DISPATCHER_WINDOW_CLASS);
36 FThreads := TStringList.Create;
37 Caption := DISPATCHER_WINDOW_TITLE;
38 UpdateThreadList;
39end;
40
41procedure TfrmVA508JawsDispatcherHiddenWindow.FormDestroy(Sender: TObject);
42begin
43 FThreads.Free;
44end;
45
46procedure TfrmVA508JawsDispatcherHiddenWindow.tmrMainTimer(Sender: TObject);
47begin
48 tmrMain.Enabled := FALSE;
49 UpdateThreadList;
50 if FThreads.Count < 1 then
51 Application.Terminate
52 else
53 tmrMain.Enabled := TRUE;
54end;
55
56function WindowSearchProc(Handle: HWND; var FThreads: TStringList): BOOL; stdcall;
57var
58 cls: string;
59 test: string;
60 Thread: DWORD;
61 ThreadID: string;
62
63begin
64 cls := GetWindowClassName(Handle);
65 test := GetWindowTitle(handle);
66 if (cls = DLL_MAIN_WINDOW_CLASS) then
67 begin
68 if (copy(GetWindowTitle(Handle),1,DLL_WINDOW_TITLE_LEN) = DLL_WINDOW_TITLE) then
69 begin
70 Thread := GetWindowThreadProcessId(Handle, nil);
71 ThreadID := FastIntToHex(Thread);
72 FThreads.AddObject(ThreadID, TObject(Handle))
73 end;
74 end;
75 Result := TRUE;
76end;
77
78procedure TfrmVA508JawsDispatcherHiddenWindow.UpdateThreadList;
79begin
80 FThreads.Clear;
81 EnumWindows(@WindowSearchProc, Integer(@FThreads));
82end;
83
84procedure TfrmVA508JawsDispatcherHiddenWindow.WndProc(var Msg: TMessage);
85var
86 CurrentWindow: HWND;
87 Thread: DWORD;
88 ThreadID: string;
89 idx: integer;
90
91 procedure FindActiveWindow;
92 begin
93 CurrentWindow := GetForegroundWindow();
94 if IsWindow(CurrentWindow) then
95 begin
96 Thread := GetWindowThreadProcessId(CurrentWindow, nil);
97 ThreadID := FastIntToHex(Thread);
98 idx := FThreads.IndexOf(ThreadID);
99 if idx < 0 then
100 begin
101 UpdateThreadList;
102 idx := FThreads.IndexOf(ThreadID);
103 end;
104 if idx >= 0 then
105 begin
106 SendReturnValue(Handle, Integer(FThreads.Objects[idx]));
107 end;
108 end;
109 end;
110
111begin
112 if Msg.Msg = MessageID then
113 begin
114 Msg.Result := 1;
115 if assigned(Self) then // JAWS can detect the window before Delphi has finished creating it
116 begin
117 try
118 if Msg.WParam = JAWS_MESSAGE_GET_DLL_WITH_FOCUS then
119 FindActiveWindow;
120 except
121 end;
122 end;
123 end;
124 inherited WndProc(Msg);
125end;
126
127end.
Note: See TracBrowser for help on using the repository browser.