close Warning: Can't use blame annotator: 
svn blame failed on cprs/trunk/CPRS-Chart/uFormMonitor.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

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