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

source: cprs/branches/tmg-cprs/CPRS-Chart/uFormMonitor.pas@ 1156

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

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