[829] | 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.
|
---|