Author: Christian Cristofori
Just put this component on your form and set as active and your form will not be
moved out of screen visible area.
Answer:
1 unit ScreenSnap;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes,
7 Graphics, Controls, Forms, Dialogs,
8 ShellAPI;
9
10 type
11 TNoOutScreen =
12 class(TComponent)
13 private
14 OldWndProc: Pointer;
15 NewWndProc: Pointer;
16 FDistance: Integer;
17 procedure NewWndMethod(var Msg: TMessage);
18 public
19 constructor Create(AOwner: TComponent); override;
20 destructor Destroy; override;
21 published
22 property Distance: Integer read FDistance write FDistance default 30;
23 end;
24
25 procedure register;
26
27 implementation
28
29 constructor TNoOutScreen.Create(AOwner: TComponent);
30 begin
31 inherited;
32 if (not (csDesigning in ComponentState)) then
33 begin
34 NewWndProc := MakeObjectInstance(NewWndMethod);
35 OldWndProc := Pointer(SetWindowLong(TForm(Owner).Handle, gwl_WndProc,
36 LongInt(NewWndProc)));
37 end
38 else
39 begin
40 NewWndProc := nil;
41 OldWndProc := nil;
42 end;
43 FDistance := 30;
44 end;
45
46 destructor TNoOutScreen.Destroy;
47 begin
48 if (Assigned(NewWndProc)) then
49 FreeObjectInstance(NewWndProc);
50 inherited;
51 end;
52
53 procedure TNoOutScreen.NewWndMethod(var Msg: TMessage);
54 var
55 Pabd: APPBARDATA;
56 ScreenWidth: Integer;
57 ScreenHeight: Integer;
58 ScreenRect: TRect;
59 TaskBarRect: TRect;
60 begin
61 if (Msg.Msg = WM_EXITSIZEMOVE) then
62 begin
63 Pabd.cbSize := SizeOf(APPBARDATA);
64 SHAppBarMessage(ABM_GETTASKBARPOS, Pabd);
65 ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
66 ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
67 ScreenRect := Rect(0, 0, ScreenWidth, ScreenHeight);
68 TaskBarRect := Pabd.rc;
69 if ((TaskBarRect.Left = -2) and (TaskBarRect.Bottom = (ScreenHeight + 2)) and
70 (TaskBarRect.Right = (ScreenWidth + 2))) then
71 ScreenRect.Bottom := TaskBarRect.top
72 else if ((TaskBarRect.Top = -2) and (TaskBarRect.Left = -2) and
73 (TaskBarRect.Right
74 = (ScreenWidth + 2))) then
75 ScreenRect.Top := TaskBarRect.Bottom
76 else if ((TaskBarRect.Left = -2) and (TaskBarRect.Top = -2) and
77 (TaskBarRect.Bottom = (ScreenHeight + 2))) then
78 ScreenRect.Left := TaskBarRect.Right
79 else if ((TaskBarRect.Right = (ScreenWidth + 2)) and (TaskBarRect.Top = -2) and
80 (TaskBarRect.Bottom = (ScreenHeight + 2))) then
81 ScreenRect.Right := TaskBarRect.Left;
82 if (TForm(Owner).Left < (ScreenRect.Left + FDistance)) then
83 TForm(Owner).Left := ScreenRect.Left;
84 if (TForm(Owner).Top < (ScreenRect.Top + FDistance)) then
85 TForm(Owner).Top := ScreenRect.Top;
86 if ((TForm(Owner).Left + TForm(Owner).Width) > (ScreenRect.Right - FDistance))
87 then
88 TForm(Owner).Left := ScreenRect.Right - TForm(Owner).Width;
89 if ((TForm(Owner).Top + TForm(Owner).Height) > (ScreenRect.Bottom - FDistance))
90 then
91 TForm(Owner).Top := ScreenRect.Bottom - TForm(Owner).Height;
92 end;
93 Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam,
94 Msg.LParam);
95 end;
96
97 procedure register;
98 begin
99 RegisterComponents('Christian', [TNoOutScreen]);
100 end;
101
102 end.
|
