source: cprs/trunk/CPRS-Chart/uFormMonitor.pas@ 795

Last change on this file since 795 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 15.0 KB
Line 
1unit uFormMonitor;
2
3interface
4
5uses
6 SysUtils, Forms, Classes, Windows, Messages, ExtCtrls, Contnrs, DateUtils;
7
8procedure SetFormMonitoring(activate: boolean);
9
10procedure MarkFormAsStayOnTop(Form: TForm; IsStayOnTop: Boolean);
11
12// Some forms have display tasks when first displayed that are messed up by the
13// form monitor - such as making a combo box automatically drop down. These forms
14// should call FormMonitorBringToFrontEvent, which will be called when the
15// form monitor calls the form's BringToFront method. The Seconds parameter is the
16// amount of time that must transpire before the form monitor will call
17// BringToFront again, unless another form has received focus since the event was called.
18
19procedure FormMonitorBringToFrontEvent(Form: TForm; AEvent: TNotifyEvent; Seconds: integer = 3);
20
21implementation
22
23type
24 TFormMonitor = class
25 private
26 FOldActiveFormChangeEvent: TNotifyEvent;
27 FOldActivateEvent: TNotifyEvent;
28 FOldRestore: TNotifyEvent;
29 FModifyingZOrder: boolean;
30 FModifyPending: boolean;
31 FActiveForm: TForm;
32 FZOrderHandles: TList;
33 FLastModal: boolean;
34 fTopOnList: TList;
35 fTopOffList: TList;
36 fTimer: TTimer;
37 FTimerCount: integer;
38 FMenuPending: boolean;
39 FWindowsHook: HHOOK;
40 FRunning: boolean;
41 FFormEvents: TObjectList;
42 FLastActiveFormHandle: HWND;
43 procedure ManageForms;
44 function FormValid(form: TForm): boolean;
45 function HandleValid(handle: HWND): boolean;
46 procedure MoveOnTop(Handle: HWND);
47 procedure MoveOffTop(Handle: HWND);
48 procedure Normalize(Handle: HWND; Yes: boolean);
49 procedure NormalizeReset;
50 function IsNormalized(Handle: HWND): boolean;
51 function GetActiveFormHandle: HWND;
52 procedure StartZOrdering;
53 function SystemRunning: boolean;
54 function ModalDelphiForm: boolean;
55 function IsTopMost(Handle: HWND): boolean;
56 public
57 procedure Start;
58 procedure Stop;
59 procedure Timer(Sender: TObject);
60 procedure Activate(Sender: TObject);
61 procedure ActiveFormChange(Sender: TObject);
62 procedure Restore(Sender: TObject);
63 end;
64
65 TFormEvent = class(TObject)
66 private
67 FForm: TForm;
68 FEvent: TNotifyEvent;
69 FSeconds: integer;
70 FTimeStamp: TDateTime;
71 end;
72
73var
74 FormMonitor: TFormMonitor = nil;
75
76type
77 HDisableGhostProc = procedure(); stdcall;
78
79const
80 NORMALIZED = $00000001;
81 UN_NORMALIZED = $FFFFFFFE;
82 STAY_ON_TOP = $00000002;
83 NORMAL_FORM = $FFFFFFFD;
84
85
86procedure DisableGhosting;
87const
88 DisableProc = 'DisableProcessWindowsGhosting';
89 UserDLL = 'user32.dll';
90
91var
92 DisableGhostProc: HDisableGhostProc;
93 User32Handle: THandle;
94
95begin
96 User32Handle := LoadLibrary(PChar(UserDLL));
97 try
98 if User32Handle <= HINSTANCE_ERROR then
99 User32Handle := 0
100 else
101 begin
102 DisableGhostProc := GetProcAddress(User32Handle, PChar(DisableProc));
103 if(assigned(DisableGhostProc)) then
104 begin
105 DisableGhostProc;
106 end;
107 end;
108 finally
109 if(User32Handle <> 0) then
110 FreeLibrary(User32Handle);
111 end;
112end;
113
114procedure SetFormMonitoring(activate: boolean);
115var
116 running: boolean;
117begin
118 running := assigned(FormMonitor);
119 if(activate <> running) then
120 begin
121 if(running) then
122 begin
123 FormMonitor.Stop;
124 FormMonitor.Free;
125 FormMonitor := nil;
126 end
127 else
128 begin
129 FormMonitor := TFormMonitor.Create;
130 FormMonitor.Start;
131 end;
132 end;
133end;
134
135procedure MarkFormAsStayOnTop(Form: TForm; IsStayOnTop: Boolean);
136var
137 Data: Longint;
138begin
139 Data := GetWindowLong(Form.Handle, GWL_USERDATA);
140 if(IsStayOnTop) then
141 begin
142 Data := Data or STAY_ON_TOP;
143 SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
144 end
145 else
146 begin
147 Data := Data and NORMAL_FORM;
148 SetWindowPos(Form.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
149 end;
150 SetWindowLong(Form.Handle, GWL_USERDATA, Data);
151end;
152
153function FindFormEventIndex(Form: TForm): integer;
154var
155 i: integer;
156 event: TFormEvent;
157begin
158 Result := -1;
159 for i := 0 to FormMonitor.FFormEvents.Count-1 do
160 begin
161 event := TFormEvent(FormMonitor.FFormEvents[i]);
162 if(event.FForm = Form) then
163 begin
164 Result := i;
165 exit;
166 end;
167 end;
168end;
169
170function FindFormEvent(Form: TForm): TFormEvent;
171var
172 idx: integer;
173begin
174 idx := FindFormEventIndex(Form);
175 if(idx < 0) then
176 Result := nil
177 else
178 Result := TFormEvent(FormMonitor.FFormEvents[idx]);
179end;
180
181procedure FormMonitorBringToFrontEvent(Form: TForm; AEvent: TNotifyEvent; Seconds: integer);
182var
183 event: TFormEvent;
184 idx: integer;
185begin
186 event := FindFormEvent(Form);
187 if(assigned(AEvent)) then
188 begin
189 if(event = nil) then
190 begin
191 event := TFormEvent.Create;
192 event.FForm := Form;
193 event.FTimeStamp := 0;
194 FormMonitor.FFormEvents.Add(event);
195 end;
196 event.FEvent := AEvent;
197 event.FSeconds := Seconds;
198 end
199 else
200 if(event <> nil) then
201 begin
202 idx := FindFormEventIndex(Form);
203 FormMonitor.FFormEvents.Delete(idx);
204// event.Free; - TObjectList frees object automatically
205 end;
206end;
207
208function IsFormStayOnTop(form: TForm): boolean;
209begin
210 Result := (form.FormStyle = fsStayOnTop);
211 if(not Result) then
212 Result := ((GetWindowLong(Form.Handle, GWL_USERDATA) and STAY_ON_TOP) <> 0);
213end;
214
215{ TFormMonitor }
216
217procedure TFormMonitor.Activate(Sender: TObject);
218begin
219 if(Assigned(FOldActivateEvent)) then
220 FOldActivateEvent(Sender);
221 NormalizeReset;
222 StartZOrdering;
223end;
224
225procedure TFormMonitor.ActiveFormChange(Sender: TObject);
226begin
227 if(Assigned(FOldActiveFormChangeEvent)) then
228 FOldActiveFormChangeEvent(Sender);
229 StartZOrdering;
230end;
231
232procedure TFormMonitor.Restore(Sender: TObject);
233begin
234 if(Assigned(FOldRestore)) then
235 FOldRestore(Sender);
236 NormalizeReset;
237 StartZOrdering;
238end;
239
240function TFormMonitor.FormValid(form: TForm): boolean;
241begin
242 Result := assigned(form);
243 if Result then
244 Result := (form.Parent = nil) and (form.ParentWindow = 0) and form.Visible and (form.Handle <> 0);
245end;
246
247function TFormMonitor.HandleValid(handle: HWND): boolean;
248begin
249 Result := (handle <> 0);
250 if(Result) then
251 Result := IsWindow(handle) and IsWindowVisible(handle) and isWindowEnabled(handle);
252end;
253
254function FindWindowZOrder(Window: HWnd; Data: Longint): Bool; stdcall;
255begin
256 if(IsWindow(Window) and IsWindowVisible(Window)) then
257 FormMonitor.FZOrderHandles.Add(Pointer(Window));
258 Result := True;
259end;
260
261procedure TFormMonitor.ManageForms;
262var
263 i, j: integer;
264 form: TForm;
265 formHandle, activeHandle: HWND;
266 modal, doCall: boolean;
267 event: TFormEvent;
268
269begin
270 if(FModifyingZOrder) then exit;
271 if(not SystemRunning) then exit;
272 FModifyingZOrder := TRUE;
273 try
274 activeHandle := GetActiveFormHandle;
275 modal := ModalDelphiForm;
276 FZOrderHandles.Clear;
277 fTopOnList.Clear;
278 fTopOffList.Clear;
279
280 EnumThreadWindows(GetCurrentThreadID, @FindWindowZOrder, 0);
281 for i := 0 to FZOrderHandles.Count-1 do
282 begin
283 formHandle := HWND(FZOrderHandles[i]);
284 for j := 0 to Screen.FormCount-1 do
285 begin
286 form := Screen.Forms[j];
287 if(form.Handle = formHandle) then
288 begin
289 if formValid(form) and (form.Handle <> activeHandle) and IsFormStayOnTop(form) then
290 begin
291 if(modal and (not IsWindowEnabled(form.Handle))) then
292 fTopOffList.Add(Pointer(form.Handle))
293 else
294 fTopOnList.Add(Pointer(form.Handle));
295 end;
296 break;
297 end;
298 end;
299 end;
300 for i := fTopOffList.Count-1 downto 0 do
301 MoveOffTop(HWND(fTopOffList[i]));
302 for i := fTopOnList.Count-1 downto 0 do
303 MoveOnTop(HWND(fTopOnList[i]));
304
305 if(activeHandle <> 0) then
306 begin
307 if(assigned(FActiveForm)) then
308 begin
309 event := FindFormEvent(FActiveForm);
310 doCall := (event = nil);
311 if(not doCall) then
312 doCall := (activeHandle <> FLastActiveFormHandle);
313 if(not doCall) then
314 doCall := SecondsBetween(Now, event.FTimeStamp) > event.FSeconds;
315 if(doCall) then
316 begin
317 if IsFormStayOnTop(FActiveForm) then
318 begin
319 SetWindowPos(activeHandle, HWND_TOPMOST, 0, 0, 0, 0,
320 SWP_NOMOVE or SWP_NOSIZE);
321 Normalize(activeHandle, FALSE);
322 end;
323 FActiveForm.BringToFront;
324 if(event <> nil) then
325 begin
326 if(FormValid(event.FForm)) then
327 begin
328 event.FEvent(FActiveForm);
329 event.FTimeStamp := now;
330 end;
331 end;
332 end;
333 end
334 else
335 begin
336 if(activeHandle <> 0) then
337 begin
338 SetFocus(activeHandle);
339 BringWindowToTop(activeHandle);
340 if(IsTopMost(activeHandle)) then
341 SetWindowPos(activeHandle, HWND_TOPMOST, 0, 0, 0, 0,
342 SWP_NOMOVE or SWP_NOSIZE);
343 end;
344 end;
345 end;
346 FLastActiveFormHandle := activeHandle;
347 finally
348 FModifyingZOrder := FALSE;
349 end;
350end;
351
352function CallWndHook(Code: Integer; WParam: wParam; Msg: PCWPStruct): Longint; stdcall;
353begin
354 case Msg.message of
355 WM_INITMENU, WM_INITMENUPOPUP, WM_ENTERMENULOOP:
356 FormMonitor.FMenuPending := TRUE;
357 WM_MENUSELECT, WM_EXITMENULOOP:
358 FormMonitor.FMenuPending := FALSE;
359 end;
360 Result := CallNextHookEx(FormMonitor.FWindowsHook, Code, WParam, Longint(Msg));
361end;
362
363procedure TFormMonitor.Start;
364begin
365 if(FRunning) then exit;
366 FRunning := TRUE;
367 FTimer := TTimer.Create(Application);
368 fTimer.Enabled := FALSE;
369 FTimer.OnTimer := Timer;
370 FTimer.Interval := 10;
371 FMenuPending := FALSE;
372 FLastActiveFormHandle := 0;
373
374 FZOrderHandles := TList.Create;
375 fTopOnList := TList.Create;
376 fTopOffList := TList.Create;
377 FFormEvents := TObjectList.Create;
378 FModifyingZOrder := false;
379 FLastModal := false;
380 FOldActiveFormChangeEvent := Screen.OnActiveFormChange;
381 Screen.OnActiveFormChange := ActiveFormChange;
382 FOldActivateEvent := Application.OnActivate;
383 Application.OnActivate := Activate;
384 FOldRestore := Application.OnRestore;
385 Application.OnRestore := Restore;
386 FWindowsHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndHook, 0, GetCurrentThreadID)
387end;
388
389procedure TFormMonitor.Stop;
390begin
391 if(not FRunning) then exit;
392 FRunning := FALSE;
393 if FWindowsHook <> 0 then
394 begin
395 UnHookWindowsHookEx(FWindowsHook);
396 FWindowsHook := 0;
397 end;
398 Screen.OnActiveFormChange := FOldActiveFormChangeEvent;
399 Application.OnActivate := FOldActivateEvent;
400 Application.OnRestore := FOldRestore;
401
402 FZOrderHandles.Free;
403 fTopOnList.Free;
404 fTopOffList.Free;
405 FFormEvents.Free;
406 fTimer.Enabled := FALSE;
407 fTimer.Free;
408end;
409
410procedure TFormMonitor.MoveOffTop(Handle: HWND);
411begin
412 if(not IsNormalized(Handle)) then
413 begin
414 SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
415 SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
416 Normalize(Handle, TRUE);
417 end;
418end;
419
420procedure TFormMonitor.MoveOnTop(Handle: HWND);
421begin
422 if(isNormalized(Handle)) then
423 begin
424 SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
425 SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
426 Normalize(Handle, FALSE);
427 end;
428end;
429
430procedure TFormMonitor.Normalize(Handle: HWND; Yes: boolean);
431var
432 Data: Longint;
433begin
434 Data := GetWindowLong(Handle, GWL_USERDATA);
435 if(yes) then
436 Data := Data or NORMALIZED
437 else
438 Data := Data and UN_NORMALIZED;
439 SetWindowLong(Handle, GWL_USERDATA, Data);
440end;
441
442function TFormMonitor.IsNormalized(Handle: HWND): boolean;
443begin
444 Result := ((GetWindowLong(Handle, GWL_USERDATA) and NORMALIZED) <> 0);
445end;
446
447function TFormMonitor.IsTopMost(Handle: HWND): boolean;
448begin
449 Result := ((GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0);
450end;
451
452function FindWindows(Window: HWnd; Data: Longint): Bool; stdcall;
453begin
454 FormMonitor.Normalize(Window, FALSE);
455 Result := True;
456end;
457
458procedure TFormMonitor.NormalizeReset;
459begin
460 EnumThreadWindows(GetCurrentThreadID, @FindWindows, 0);
461end;
462
463var
464 uActiveWindowHandle: HWND;
465 uActiveWindowCount: integer;
466
467function IsHandleOK(Handle: HWND): boolean;
468var
469 i: integer;
470
471begin
472 Result := FALSE;
473 if(not formMonitor.HandleValid(Handle)) or (Handle = Application.Handle) then exit;
474 for i := 0 to Screen.FormCount-1 do
475 begin
476 if(Handle = Screen.Forms[i].Handle) then exit;
477 end;
478 Result := TRUE;
479end;
480
481function FindActiveWindow(Window: HWnd; Data: Longint): Bool; stdcall;
482begin
483 Result := True;
484 if(IsHandleOK(Window)) then
485 begin
486 inc(uActiveWindowCount);
487 if(uActiveWindowCount = 1) then
488 uActiveWindowHandle := Window
489 else
490 if(uActiveWindowCount > 1) then
491 Result := false;
492 end;
493end;
494
495function TFormMonitor.GetActiveFormHandle: HWND;
496var
497 i: integer;
498 form: TForm;
499
500begin
501 FActiveForm := Screen.ActiveForm;
502 if(assigned(FActiveForm)) then
503 Result := FActiveForm.Handle
504 else
505 Result := 0;
506 if(FormValid(FActiveForm) and IsWindowEnabled(FActiveForm.Handle)) then
507 exit;
508 for i := 0 to Screen.FormCount-1 do
509 begin
510 form := Screen.Forms[i];
511 if(form.Handle = Result) then
512 begin
513 if FormValid(form) and IsWindowEnabled(form.Handle) then
514 begin
515 FActiveForm := form;
516 Result := form.Handle;
517 exit;
518 end;
519 end;
520 end;
521 FActiveForm := nil;
522 Result := GetActiveWindow;
523 if(IsHandleOK(Result)) then exit;
524 uActiveWindowHandle := 0;
525 uActiveWindowCount := 0;
526 EnumThreadWindows(GetCurrentThreadID, @FindActiveWindow, 0);
527 if(uActiveWindowCount = 1) then
528 begin
529 Result := uActiveWindowHandle;
530 end;
531end;
532
533
534procedure TFormMonitor.StartZOrdering;
535begin
536 if(FModifyPending) then exit;
537 if(SystemRunning) then
538 begin
539 FModifyPending := TRUE;
540 FTimerCount := 0;
541 FTimer.Enabled := TRUE;
542 end;
543end;
544
545function TFormMonitor.SystemRunning: boolean;
546begin
547 Result := assigned(Application.MainForm) and
548 (Application.MainForm.Handle <> 0) and
549 IsWindowVisible(Application.MainForm.Handle);
550end;
551
552
553function TFormMonitor.ModalDelphiForm: boolean;
554var
555 i: integer;
556 form: TForm;
557begin
558 for i := 0 to Screen.FormCount-1 do
559 begin
560 form := screen.Forms[i];
561 if(FormValid(form) and (fsModal in form.FormState)) then
562 begin
563 Result := TRUE;
564 exit;
565 end;
566 end;
567 Result := FALSE;
568end;
569
570procedure TFormMonitor.Timer(Sender: TObject);
571var
572 NoMenu: boolean;
573begin
574 inc(FTimerCount);
575 if(FTimerCount > 20) then
576 begin
577 FTimer.Enabled := FALSE;
578 FMenuPending := FALSE;
579 FModifyPending := FALSE;
580 exit;
581 end;
582 if(FTimerCount <> 1) then exit;
583 FTimer.Enabled := FALSE;
584 NoMenu := not FMenuPending;
585 FMenuPending := FALSE;
586 if(NoMenu and SystemRunning) then
587 ManageForms;
588 FModifyPending := FALSE;
589end;
590
591initialization
592 DisableGhosting;
593
594finalization
595
596end.
Note: See TracBrowser for help on using the repository browser.