Author: Christian Cristofori
The form remember on what side you put it and returns there when Windows Taskbar is
moved!!! Try it out: full source code.
Answer:
1 unit frmSplashUnit;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes,
7 Graphics, Controls, Forms, Dialogs,
8 ExtCtrls, StdCtrls, ComCtrls, Buttons,
9 Menus, ImgList;
10
11 const
12 MagneticField = 10;
13
14 type
15 TAlignSide1 = (fasNone, fasTop, fasBottom, fasRight, fasLeft);
16 TAlignSide = set of TAlignSide1;
17 TfrmSplash =
18 class(TForm)
19 bvlForm: TBevel;
20 lblAction: TLabel;
21 lblFile: TLabel;
22 bvlTitle: TBevel;
23 imgTitle: TImage;
24 lblProgress: TLabel;
25 pbProgress: TProgressBar;
26 bvlLine: TBevel;
27 cmdCancel: TSpeedButton;
28 popSystemMenu: TPopupMenu;
29 mnuRestore: TMenuItem;
30 mnuMove: TMenuItem;
31 mnuSize: TMenuItem;
32 mnuMinimize: TMenuItem;
33 mnuMaximize: TMenuItem;
34 mnuBar1: TMenuItem;
35 mnuClose: TMenuItem;
36 ilSystemMenu: TImageList;
37 mnuBar2: TMenuItem;
38 mnuAbout: TMenuItem;
39 cmdAbout: TSpeedButton;
40 procedure imgTitleMouseDown(Sender: TObject; Button: TMouseButton; Shift:
41 TShiftState; X, Y: Integer);
42 procedure imgTitleMouseUp(Sender: TObject; Button: TMouseButton; Shift:
43 TShiftState; X, Y: Integer);
44 procedure imgTitleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
45 procedure ClientAreaVerify(var Msg: TWMSettingChange); message WM_SETTINGCHANGE;
46 procedure FormCreate(Sender: TObject);
47 procedure cmdCancelClick(Sender: TObject);
48 procedure FormResize(Sender: TObject);
49 private
50 public
51 FSide: TAlignSide;
52 FMoving: Boolean;
53 FOldX: Integer;
54 FOldY: Integer;
55 FArea: TRect;
56 end;
57
58 var
59 frmSplash: TfrmSplash;
60
61 implementation
62
63 {$R *.DFM}
64
65 procedure TfrmSplash.imgTitleMouseDown(Sender: TObject; Button: TMouseButton; Shift:
66 TShiftState; X, Y: Integer);
67 begin
68 FMoving := True;
69 FOldX := X;
70 FOldY := Y;
71 end;
72
73 procedure TfrmSplash.imgTitleMouseUp(Sender: TObject; Button: TMouseButton; Shift:
74 TShiftState; X, Y: Integer);
75 begin
76 FMoving := False;
77 end;
78
79 procedure TfrmSplash.imgTitleMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
80 Integer);
81 var
82 WorkArea: TRect;
83 begin
84 if (SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0)) then
85 FArea := WorkArea;
86 if (FMoving) then
87 begin
88 FSide := [fasNone];
89 if (((frmSplash.Left - (FOldX - X)) > (WorkArea.Left + MagneticField)) and
90 ((frmSplash.Left - (FOldX - X) + frmSplash.Width) < (WorkArea.Right -
91 MagneticField))) then
92 frmSplash.Left := frmSplash.Left - (FOldX - X)
93 else if ((frmSplash.Left - (FOldX - X)) <= (WorkArea.Left + MagneticField)) then
94 begin
95 frmSplash.Left := WorkArea.Left;
96 FSide := FSide + [fasLeft];
97 end
98 else
99 begin
100 frmSplash.Left := WorkArea.Right - frmSplash.Width;
101 FSide := FSide + [fasRight];
102 end;
103 if (((frmSplash.Top - (FOldY - Y)) > (WorkArea.Top + MagneticField)) and
104 ((frmSplash.Top - (FOldY - Y) + frmSplash.Height) < (WorkArea.Bottom -
105 MagneticField))) then
106 begin
107 frmSplash.Top := frmSplash.Top - (FOldY - Y);
108 FSide := [fasNone];
109 end
110 else if ((frmSplash.Top - (FOldY - Y)) <= (WorkArea.Top + MagneticField)) then
111 begin
112 frmSplash.Top := WorkArea.Top;
113 FSide := FSide + [fasTop];
114 end
115 else
116 begin
117 frmSplash.Top := WorkArea.Bottom - frmSplash.Height;
118 FSide := FSide + [fasBottom];
119 end;
120 // Removes [fasNone] if anything else is found in FSide.
121 if (((fasBottom in FSide) or (fasTop in FSide) or (fasLeft in FSide) or
122 (fasRight
123 in FSide)) and (fasNone in FSide)) then
124 FSide := FSide - [fasNone];
125 end;
126 end;
127
128 procedure TfrmSplash.ClientAreaVerify(var Msg: TWMSettingChange);
129 var
130 WorkArea: TRect;
131 begin
132 if (not (FMoving)) then
133 if (SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0)) then
134 begin
135 if (fasLeft in FSide) then
136 frmSplash.Left := WorkArea.Left;
137 if (fasRight in FSide) then
138 frmSplash.Left := WorkArea.Right - frmSplash.Width;
139 if (fasTop in FSide) then
140 frmSplash.Top := WorkArea.Top;
141 if (fasBottom in FSide) then
142 frmSplash.Top := WorkArea.Bottom - frmSplash.Height;
143 end;
144 end;
145
146 procedure TfrmSplash.FormCreate(Sender: TObject);
147 begin
148 // TO DO: Check if form is on one of the corners.
149 FSide := [fasNone];
150 FMoving := False;
151 end;
152
153 procedure TfrmSplash.cmdCancelClick(Sender: TObject);
154 begin
155 Application.Terminate;
156 end;
157
158 procedure TfrmSplash.FormResize(Sender: TObject);
159 begin
160 imgTitle.Width := bvlTitle.Width;
161 bvlLine.Width := frmSplash.Width - (2 * bvlLine.Left);
162 pbProgress.Width := frmSplash.Width - pbProgress.Left - bvlLine.Left;
163 cmdCancel.Left := frmSplash.Width - cmdCancel.Width - cmdAbout.Left;
164 cmdAbout.Top := frmSplash.Height - cmdAbout.Height - cmdAbout.Left;
165 cmdCancel.Top := cmdAbout.Top;
166 bvlLine.Top := cmdAbout.Top - bvlLine.Height;
167 end;
168
169 end.
|
