1 | unit fVA508DispatcherHiddenWindow;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
7 | Dialogs, ExtCtrls;
|
---|
8 |
|
---|
9 | type
|
---|
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 |
|
---|
24 | var
|
---|
25 | frmVA508JawsDispatcherHiddenWindow: TfrmVA508JawsDispatcherHiddenWindow;
|
---|
26 |
|
---|
27 | implementation
|
---|
28 |
|
---|
29 | uses VAUtils, JAWSCommon;
|
---|
30 |
|
---|
31 | {$R *.dfm}
|
---|
32 |
|
---|
33 | procedure TfrmVA508JawsDispatcherHiddenWindow.FormCreate(Sender: TObject);
|
---|
34 | begin
|
---|
35 | ErrorCheckClassName(Self, DISPATCHER_WINDOW_CLASS);
|
---|
36 | FThreads := TStringList.Create;
|
---|
37 | Caption := DISPATCHER_WINDOW_TITLE;
|
---|
38 | UpdateThreadList;
|
---|
39 | end;
|
---|
40 |
|
---|
41 | procedure TfrmVA508JawsDispatcherHiddenWindow.FormDestroy(Sender: TObject);
|
---|
42 | begin
|
---|
43 | FThreads.Free;
|
---|
44 | end;
|
---|
45 |
|
---|
46 | procedure TfrmVA508JawsDispatcherHiddenWindow.tmrMainTimer(Sender: TObject);
|
---|
47 | begin
|
---|
48 | tmrMain.Enabled := FALSE;
|
---|
49 | UpdateThreadList;
|
---|
50 | if FThreads.Count < 1 then
|
---|
51 | Application.Terminate
|
---|
52 | else
|
---|
53 | tmrMain.Enabled := TRUE;
|
---|
54 | end;
|
---|
55 |
|
---|
56 | function WindowSearchProc(Handle: HWND; var FThreads: TStringList): BOOL; stdcall;
|
---|
57 | var
|
---|
58 | cls: string;
|
---|
59 | test: string;
|
---|
60 | Thread: DWORD;
|
---|
61 | ThreadID: string;
|
---|
62 |
|
---|
63 | begin
|
---|
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;
|
---|
76 | end;
|
---|
77 |
|
---|
78 | procedure TfrmVA508JawsDispatcherHiddenWindow.UpdateThreadList;
|
---|
79 | begin
|
---|
80 | FThreads.Clear;
|
---|
81 | EnumWindows(@WindowSearchProc, Integer(@FThreads));
|
---|
82 | end;
|
---|
83 |
|
---|
84 | procedure TfrmVA508JawsDispatcherHiddenWindow.WndProc(var Msg: TMessage);
|
---|
85 | var
|
---|
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 |
|
---|
111 | begin
|
---|
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);
|
---|
125 | end;
|
---|
126 |
|
---|
127 | end.
|
---|