Author: Kevin Gallagher
How can I move/resize a TPanel at runtime. Also can I place a sizegrip on the panel
and make it a different color then Grey?
Answer:
Many times an application may need to move or resize items on a form. The custom
panel presented here provides the ability to move the panel by holding down the
left mouse button and dragging the panel to a new location. The size can be
adjusted by holding the left mouse button down in the lower right hand corner of
the panel as done when resizing a form. There is a property to show/hide the
SizeGrip and even change the style of the SizeGrip so that the color can be changed
in the event the panel needs to be different then battleship grey. There is two
unusual properties FreezeTopAt and FreezeTop which allow you to restrict how far
the top can be moved on the parent form. It has been tested with D5 but not D6,
see comments inside concerning D6.
1 unit SizeGripPanel;
2
3 {
4 Description:
5 This component, a decendent of TPanel provides methods to size and move
6 the panel by using the mouse. The only restriction for sizing the panel
7 is that is must be done using the SizeGrip located at the bottom right
8 part of the panel.
9
10 There are two additional events, OnMove and OnSize. Yes you guessed
11 correct, the are hooked into when a user moves or resizes the panel.
12
13 ColoredGrip when True allows the grip to be colored unlike the default
14 style grip.
15
16 Author:
17 Kevin S. Gallagher
18 gallaghe@teleport.com
19
20 Version
21 1.0.2
22
23 Copyrights:
24 This is a freeware component. Use at your own risk. You may not sell
25 or distruibute the component for profit.
26
27 Notes:
28 Originally created in D4, ported to D5.
29
30 I am not sure what all needs to change for D6 since I don't have it yet.
31 It will work as reported from one programmer by hacking some code i.e.
32 Changing the USES clause and removing the "About" code. There should be
33 away to make the "About" code work, will fix it once I get D6.
34
35 Limitations:
36 The Grip as is can not assume the color of the panel, for a quick
37 solution I added the property . For myself it doesn't matter
38 since I am always using drab grey. If anyone wants to change this, feel
39 free, just email me the changes.
40
41 IF YOU GET THIS TO WORK UNDER D6 SEND ME THE CHANGES PLEASE SO I CAN POST
42 THE CHANGES.
43
44 Revisions
45 KSG 02.08.01
46 Added the property "FreezeTop" which when set will not allow vertical
47 movement of the panel. "FreezeTopAt" control the topmost point the
48 panel can move too.
49
50 KSG 09.10.01
51 Found flaw in code to set Grip visible, fixed.
52 Attempted to make work under D6 w/o D6 available.
53
54 }
55
56 interface
57
58 {$IFDEF VER140}
59 uses
60 Windows, Messages, Classes, ExtCtrls, Controls, ToolsAPI, DesignIntf,
61 DesignEditors;
62 {$ELSE}
63 uses
64 Windows, Messages, Classes, ExtCtrls, Controls, DsgnIntf, Commctrl;
65 {$ENDIF}
66
67 type
68 TAbout = class(TPropertyEditor)
69 public
70 procedure Edit; override;
71 function GetAttributes: TPropertyAttributes; override;
72 function GetValue: string; override;
73 end;
74
75 TSizeGripPanel = class(TPanel)
76 private
77 FAbout: TAbout;
78 FUseGrip: Boolean;
79 FMoving: Boolean;
80 FSizing: Boolean;
81 FColorGrip: Boolean;
82 FOnMove: TNotifyEvent;
83 FOnSize: TNotifyEvent;
84 FTop: Integer; { to prevent vertical movement KSG 02.08.01 }
85 FFreeze: Boolean;
86 function GetGripRect: TRect;
87 procedure WMExitSizeMove(var Msg: TMessage); message WM_EXITSIZEMOVE;
88 procedure SetGripColorStyle(Value: Boolean);
89 procedure SetGripVisability(Value: Boolean); { KSG 09.10.2001 }
90 protected
91 procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
92 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
93 override;
94 procedure WMMove(var message: TWMMove); message WM_MOVE;
95 procedure WMSize(var message: TWMSize); message WM_SIZE;
96 procedure Paint; override;
97 public
98 constructor Create(AOwner: TComponent); override;
99 published
100 property About: TAbout read FAbout write FAbout;
101 property FreezeTopAt: Integer read FTop write FTop;
102 property FreezeTop: boolean read FFreeze write FFreeze;
103 property ShowGrip: Boolean read FUseGrip write SetGripVisability;
104 property ColoredGrip: Boolean read FColorGrip write SetGripColorStyle;
105 property OnMove: TNotifyEvent read FOnMove write FOnMove;
106 property OnSize: TNotifyEvent read FOnSize write FOnSize;
107 end;
108
109 procedure register;
110
111 implementation
112
113 uses Dialogs, SysUtils, Graphics;
114
115 procedure TAbout.Edit;
116 begin
117 MessageDlg('SizeMovePanel component v1.0.2'#13'by Kevin S. Gallagher',
118 mtInformation, [mbOK], 0);
119 end;
120
121 function TAbout.GetAttributes: TPropertyAttributes;
122 begin
123 Result := [paMultiSelect, paDialog, paReadOnly];
124 end;
125
126 function TAbout.GetValue: string;
127 begin
128 Result := '(about)';
129 end;
130
131 constructor TSizeGripPanel.Create(AOwner: TComponent);
132 begin
133 inherited Create(AOwner);
134 { Don't care for a caption at all }
135 ControlStyle := ControlStyle - [csSetCaption];
136 ShowGrip := True;
137 FreezeTop := False;
138 FColorGrip := False;
139 end;
140
141 procedure TSizeGripPanel.WMExitSizeMove(var Msg: TMessage);
142 begin
143 inherited;
144
145 if FreezeTop then
146 Top := FTop;
147
148 Msg.Result := 0;
149 end;
150
151 procedure TSizeGripPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
152 X, Y: Integer);
153 const
154 SC_DRAGMOVE: Longint = $F012;
155 begin
156 { Might also want to check for Client alignment too. }
157 if (Align = alNone) then
158 begin
159 FMoving := True;
160 ReleaseCapture;
161 SendMessage(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
162 end
163 else
164 inherited MouseDown(Button, Shift, X, Y);
165 end;
166
167 procedure TSizeGripPanel.WMMove(var message: TWMMove);
168 begin
169 inherited;
170 if FMoving then
171 begin
172 FMoving := False;
173 Parent.Realign;
174 if Assigned(FOnMove) then
175 FOnMove(Self);
176 end;
177 end;
178
179 procedure TSizeGripPanel.WMSize(var message: TWMSize);
180 begin
181 inherited;
182 if FSizing then
183 begin
184 FSizing := False;
185 Parent.Realign;
186 if Assigned(FOnSize) then
187 FOnSize(Self);
188 end;
189 end;
190
191 function TSizeGripPanel.GetGripRect: TRect;
192 var
193 GripWidth: integer;
194 GripHeight: integer;
195 begin
196 GripWidth := GetSystemMetrics(SM_CXHSCROLL);
197 GripHeight := GetSystemMetrics(SM_CYVSCROLL);
198 Result := GetClientRect();
199 Result.Left := Result.Right - GripWidth;
200 Result.Top := Result.Bottom - GripHeight;
201 end;
202
203 procedure TSizeGripPanel.WMNCHitTest(var Msg: TWMNCHitTest);
204 var
205 ScreenPt: TPoint;
206 begin
207 inherited;
208 if not (csDesigning in ComponentState) and (Msg.Result = HTCLIENT) then
209 begin
210 ScreenPt := ScreenToClient(Point(Msg.Xpos, Msg.Ypos));
211 if (ScreenPt.x >= GetGripRect.Left) and (ScreenPt.y >= GetGripRect.Top) then
212 Msg.Result := HTBOTTOMRIGHT;
213
214 { Used to trigger OnSize }
215 with Msg do
216 if Result in [Windows.HTLEFT..Windows.HTBOTTOMRIGHT] then
217 FSizing := True;
218 end;
219 end;
220
221 procedure TSizeGripPanel.Paint;
222 var
223 Rect: TRect;
224 begin
225 inherited Paint;
226
227 if not FUseGrip then
228 exit;
229
230 Rect := GetGripRect;
231
232 if not FColorGrip then
233 DrawFrameControl(Canvas.Handle, Rect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP)
234 else
235 with Self.Canvas do
236 begin
237 Brush.Style := bsClear;
238 Font.Name := 'Marlett';
239 Font.Size := 8;
240
241 Font.Color := clGray;
242 TextOut(rect.left, rect.top, 'o');
243
244 Font.Color := clWhite;
245 TextOut(rect.left, rect.top, 'p');
246 end;
247 end;
248
249 procedure TSizeGripPanel.SetGripColorStyle(Value: Boolean);
250 begin
251 if Value <> FColorGrip then
252 begin
253 FColorGrip := Value;
254 Repaint;
255 end;
256 end;
257
258 procedure TSizeGripPanel.SetGripVisability(Value: Boolean);
259 begin
260 if Value <> FUseGrip then
261 begin
262 FUsegrip := Value;
263 Repaint;
264 end;
265 end;
266
267 procedure register;
268 begin
269 RegisterComponents('Samples', [TSizeGripPanel]);
270 RegisterPropertyEditor(TypeInfo(TAbout), TSizeGripPanel, 'ABOUT', TAbout);
271 end;
272 end.
|
