运行期窗体、可视组件任意移动 调整大小功能实现组件

很多时候我们需要在运行期随意移动窗体、组件或改变其大小,研究了一下封装成一个组件 欢迎大家指点

代码
1 {*******************************************************}
2  { }
3  { UWS Move anywhere }
4 { }
5 { 版权所有 (C) 2007 UW Soft }
6 { }
7 {*******************************************************}
8
9 unit UWSMoveAnyWhere;
10
11 interface
12
13 uses
14 SysUtils, Classes,Controls,Messages,Windows,Forms;
15
16 const
17 MAW_HSizeL=$F001;
18 MAW_HSizeR=$F002;
19 MAW_VSizeT=$F003;
20 MAW_SizeLT=$F004;
21 MAW_SizeRT=$F005;
22 MAW_VSizeB=$F006;
23 MAW_SizeLB=$F007;
24 MAW_SizeRB=$F008;
25 MAW_MoveAnyWhere=$F009;
26 MAW_MoveAnyWhereEx=$F011;
27 MAW_Move=$F012;
28
29 type
30 TMoveType=(mvMove,mvMoveEx,mvMoveA,mvSizeRB,mvSizeLB,mvVSizeB,mvSizeRT,mvSizeLT,mvVSizeT,mvHSizeR,mvHSizeL);
31 TControlMode=(mFixed,mAuto);
32 TUWSMoveAnyWhere = class(TComponent)
33 private
34 { Private declarations }
35 FMoveControl:TWinControl;
36 FControlForm:TForm ;
37 FMoveType:TMoveType ;
38 FActive:Boolean ;
39 FControlMode:TControlMode ;
40 protected
41 { Protected declarations }
42 public
43 { Public declarations }
44 procedure DoMoveAnyWhere;
45 procedure DoFormMoveAnyWhere;
46 procedure AutoMove(Shift: TShiftState; X, Y, Precision: integer);
47 procedure AutoMoveForm(Shift: TShiftState; X, Y, Precision: integer);
48 published
49 { Published declarations }
50 property MoveControl : TWinControl read FMoveControl write FMoveControl;
51 property ControlForm : TForm read FControlForm write FControlForm;
52 property MoveType : TMoveType read FMoveType write FMoveType;
53 property Active : Boolean read FActive write FActive;
54 property ControlMode : TControlMode read FControlMode write FControlMode;
55 end;
56
57 procedure Register;
58
59 implementation
60
61 procedure TUWSMoveAnyWhere.DoMoveAnyWhere ;
62 var
63 MoveMode:Word ;
64 begin
65 if not FActive then Exit ;
66 if FControlMode=mAuto then Exit ;
67 Screen.Cursor:=crDefault ;
68 case FMoveType of
69 mvMove:MoveMode:=MAW_Move ;
70 mvMoveEx:MoveMode:=MAW_MoveAnyWhereEx;
71 mvMoveA:MoveMode:=MAW_MoveAnyWhere;
72 mvSizeRB:MoveMode:=MAW_SizeRB;
73 mvSizeLB:MoveMode:=MAW_SizeLB;
74 mvVSizeB:MoveMode:=MAW_VSizeB;
75 mvSizeRT:MoveMode:=MAW_SizeRT;
76 mvSizeLT:MoveMode:=MAW_SizeLT;
77 mvVSizeT:MoveMode:=MAW_VSizeT;
78 mvHSizeR:MoveMode:=MAW_HSizeR;
79 mvHSizeL:MoveMode:=MAW_HSizeL;
80 end;
81 if FMoveControl<>nil then
82 begin
83 ReleaseCapture;
84 FMoveControl.Perform(WM_SYSCOMMAND,MoveMode,0);
85 end;
86 FMoveControl.Update ;
87 end;
88
89 procedure TUWSMoveAnyWhere.DoFormMoveAnyWhere;
90 var
91 MoveMode:Word ;
92 begin
93 if not FActive then Exit ;
94 if FControlMode=mAuto then Exit ;
95 Screen.Cursor:=crDefault ;
96 case FMoveType of
97 mvMove:MoveMode:=MAW_Move ;
98 mvMoveEx:MoveMode:=MAW_MoveAnyWhereEx;
99 mvMoveA:MoveMode:=MAW_MoveAnyWhere;
100 mvSizeRB:MoveMode:=MAW_SizeRB;
101 mvSizeLB:MoveMode:=MAW_SizeLB;
102 mvVSizeB:MoveMode:=MAW_VSizeB;
103 mvSizeRT:MoveMode:=MAW_SizeRT;
104 mvSizeLT:MoveMode:=MAW_SizeLT;
105 mvVSizeT:MoveMode:=MAW_VSizeT;
106 mvHSizeR:MoveMode:=MAW_HSizeR;
107 mvHSizeL:MoveMode:=MAW_HSizeL;
108 end;
109 if FControlForm<>nil then
110 begin
111 ReleaseCapture;
112 FControlForm.Perform(WM_SYSCOMMAND,MoveMode,0);
113 end;
114 //FControlForm.Update ;
115 end;
116
117 procedure TUWSMoveAnyWhere.AutoMove(Shift: TShiftState; X, Y, Precision: Integer);
118 var
119 MoveMode:Word ;
120 begin
121 if not FActive then Exit ;
122 if FMoveControl=nil then Exit ;
123 if FControlMode=mFixed then Exit ;
124 // 光标在左侧时
125 if (X<=Precision) and (Y>Precision) and (Y<FMoveControl.Height-Precision) then
126 begin
127 MoveMode:=MAW_HSizeL;
128 Screen.Cursor := crSizeWE;
129 end
130 // 光标在右侧时
131 else if (X>=FMoveControl.Width-Precision) and (Y>Precision) and (Y<FMoveControl.Height-Precision) then
132 begin
133 MoveMode:=MAW_HSizeR;
134 Screen.Cursor := crSizeWE;
135 end
136 //光标在顶部时
137 else if (X>Precision) and (X<FMoveControl.Width-Precision) and (Y<=Precision) then
138 begin
139 MoveMode:=MAW_VSizeT;
140 Screen.Cursor :=crSizeNS;
141 end
142 // 光标在左上角
143 else if (X<=Precision) and (Y<=Precision) then
144 begin
145 MoveMode:=MAW_SizeLT;
146 Screen.Cursor := crSizeNWSE;
147 end
148 // 光标在右上角
149 else if (X>=FMoveControl.Width-Precision) and (Y<=Precision) then
150 begin
151 MoveMode:=MAW_SizeRT;
152 Screen.Cursor := crSizeNESW;
153 end
154 //光标在底部
155 else if (X>Precision) and (X<FMoveControl.Width-Precision) and (Y>=FMoveControl.Height-Precision) then
156 begin
157 MoveMode:=MAW_VSizeB;
158 Screen.Cursor := crSizeNS;
159 end
160 //光标在左下角
161 else if (X<=Precision) and (Y>=FMoveControl.Height-Precision) then
162 begin
163 MoveMode:=MAW_SizeLB;
164 Screen.Cursor :=crSizeNESW;
165 end
166 // 光标在右下角
167 else if (X>=FMoveControl.Width-Precision) and (Y>=FMoveControl.Height-Precision) then
168 begin
169 MoveMode:=MAW_SizeRB;
170 Screen.Cursor := crSizeNWSE;
171 end
172 // 移动模式
173 else if(X>5) and (Y>5) and (X<FMoveControl.Width-5) and (Y<FMoveControl.Height-5) then
174 begin
175 MoveMode:=MAW_Move;
176 Screen.Cursor := crDefault;
177 end;
178 if Shift=[ssLeft] then
179 begin
180 ReleaseCapture;
181 FMoveControl.Perform(WM_SYSCOMMAND,MoveMode,0);
182 end;
183 FMoveControl.Update ;
184 end;
185
186 procedure TUWSMoveAnyWhere.AutoMoveForm(Shift: TShiftState; X, Y, Precision: Integer);
187 var
188 MoveMode:Word ;
189 begin
190 if not FActive then Exit ;
191 if FControlForm=nil then Exit ;
192 if FControlMode=mFixed then Exit ;
193 // 光标在左侧时
194 if (X<=Precision) and (Y>Precision) and (Y<FControlForm.Height-Precision) then
195 begin
196 MoveMode:=MAW_HSizeL;
197 FControlForm.Cursor := crSizeWE;
198 end
199 // 光标在右侧时
200 else if (X>=FControlForm.Width-Precision) and (Y>Precision) and (Y<FControlForm.Height-Precision) then
201 begin
202 MoveMode:=MAW_HSizeR;
203 FControlForm.Cursor := crSizeWE;
204 end
205 //光标在顶部时
206 else if (X>Precision) and (X<FControlForm.Width-Precision) and (Y<=Precision) then
207 begin
208 MoveMode:=MAW_VSizeT;
209 FControlForm.Cursor :=crSizeNS;
210 end
211 // 光标在左上角
212 else if (X<=Precision) and (Y<=Precision) then
213 begin
214 MoveMode:=MAW_SizeLT;
215 FControlForm.Cursor := crSizeNWSE;
216 end
217 // 光标在右上角
218 else if (X>=FControlForm.Width-Precision) and (Y<=Precision) then
219 begin
220 MoveMode:=MAW_SizeRT;
221 FControlForm.Cursor := crSizeNESW;
222 end
223 //光标在底部
224 else if (X>Precision) and (X<FControlForm.Width-Precision) and (Y>=FControlForm.Height-Precision) then
225 begin
226 MoveMode:=MAW_VSizeB;
227 FControlForm.Cursor := crSizeNS;
228 end
229 //光标在左下角
230 else if (X<=Precision) and (Y>=FControlForm.Height-Precision) then
231 begin
232 MoveMode:=MAW_SizeLB;
233 FControlForm.Cursor :=crSizeNESW;
234 end
235 // 光标在右下角
236 else if (X>=FControlForm.Width-Precision) and (Y>=FControlForm.Height-Precision) then
237 begin
238 MoveMode:=MAW_SizeRB;
239 FControlForm.Cursor := crSizeNWSE;
240 end
241 // 移动模式
242 else if(X>5) and (Y>5) and (X<FControlForm.Width-5) and (Y<FControlForm.Height-5) then
243 begin
244 MoveMode:=MAW_Move;
245 FControlForm.Cursor := crDefault;
246 end;
247 if Shift=[ssLeft] then
248 begin
249 ReleaseCapture;
250 FControlForm.Perform(WM_SYSCOMMAND,MoveMode,0);
251 end;
252 //FControlForm.Update ;
253 end;
254
255 procedure Register;
256 begin
257 RegisterComponents('UWS Used', [TUWSMoveAnyWhere]);
258 end;
259
260 end.
261

 下载:https://files.cnblogs.com/uws2056/MoveAnyWhere.rar

原文地址:https://www.cnblogs.com/uws2056/p/1764604.html