Author: Tomas Rutkauskas
How can I create a TPanel that can be resized by grip in the lower right corner
(just like the grip, the TStatusBar has)?
Answer:
Solve 1:
Try this one. It may need some refinement in painting the grip.
1 unit SizeablePanel;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls;
8
9 type
10 TSizeablePanel = class(TPanel)
11 private
12 FDragging: Boolean;
13 FLastPos: TPoint;
14 protected
15 procedure Paint; override;
16 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
17 override;
18 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
19 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
20 override;
21 public
22 { Public declarations }
23 published
24 { Published declarations }
25 end;
26
27 procedure register;
28
29 implementation
30
31 procedure register;
32 begin
33 RegisterComponents('PBGoodies', [TSizeablePanel]);
34 end;
35
36 procedure TSizeablePanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
37 Integer);
38 begin
39 if (Button = mbLeft) and ((Width - x) < 10) and ((Height - y) < 10) then
40 begin
41 FDragging := TRue;
42 FLastPos := Point(x, y);
43 MouseCapture := true;
44 Screen.cursor := crSizeNWSE;
45 end
46 else
47 inherited;
48 end;
49
50 procedure TSizeablePanel.MouseMove(Shift: TShiftState; X, Y: Integer);
51 var
52 r: TRect;
53 begin
54 if FDragging then
55 begin
56 r := BoundsRect;
57 SetBounds(r.left, r.top, r.right - r.left + X - FlastPos.X,
58 r.bottom - r.top + Y - Flastpos.Y);
59 FLastPos := Point(x, y);
60 end
61 else
62 begin
63 inherited;
64 if ((Width - x) < 10) and ((Height - y) < 10) then
65 Cursor := crSizeNWSE
66 else
67 Cursor := crDefault;
68 end;
69 end;
70
71 procedure TSizeablePanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
72 Integer);
73 begin
74 if FDragging then
75 begin
76 FDragging := False;
77 MouseCapture := false;
78 Screen.Cursor := crDefault;
79 end
80 else
81 inherited;
82 end;
83
84 procedure TSizeablePanel.Paint;
85 var
86 x, y: Integer;
87 begin
88 inherited;
89 Canvas.Font.Name := 'Marlett';
90 Canvas.Font.Size := 10;
91 Canvas.Brush.Style := bsClear;
92 x := clientwidth - canvas.textwidth('o');
93 y := clientheight - canvas.textheight('o');
94 canvas.textout(x, y, 'o');
95 end;
96
97 end.
Solve 2:
Here's a component that will do that and also looks like it has a statusbar at the
bottom:
98 unit SizeGripPanel;
99
100 interface
101
102 uses
103 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
104 ExtCtrls;
105
106 type
107 TSizeGripPanel = class(TPanel)
108 private
109 {Private declarations}
110 FAllowMove, FAllowSize, FShowSizeGrip: Boolean;
111 procedure SetAllowMove(Value: Boolean);
112 procedure SetAllowSize(Value: Boolean);
113 procedure SetShowSizeGrip(Value: Boolean);
114 protected
115 {Protected declarations}
116 procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
117 procedure Paint; override;
118 public
119 {Public declarations}
120 published
121 {Published declarations}
122 property ShowSizeGrip: Boolean read FShowSizeGrip write SetShowSizeGrip;
123 property AllowMove: Boolean read FAllowMove write SetAllowMove;
124 property AllowSize: Boolean read FAllowSize write SetAllowSize;
125 end;
126
127 procedure register;
128
129 implementation
130
131 procedure register;
132 begin
133 RegisterComponents('Samples', [TSizeGripPanel]);
134 end;
135
136 procedure TSizeGripPanel.WMNCHitTest(var Msg: TWMNCHitTest);
137 var
138 ScreenPt: TPoint;
139 MoveArea: TRect;
140 HANDLE_WIDTH: Integer;
141 SIZEGRIP: Integer;
142 begin
143 {This code came from Lou's Tip of the Day web site... with changes}
144 HANDLE_WIDTH := BevelWidth;
145 Sizegrip := 19;
146 inherited;
147 if not (csDesigning in ComponentState) then
148 begin
149 ScreenPt := ScreenToClient(Point(Msg.Xpos, Msg.Ypos));
150 MoveArea := Rect(HANDLE_WIDTH, HANDLE_WIDTH, Width - HANDLE_WIDTH,
151 Height - HANDLE_WIDTH);
152 if FAllowSize then
153 begin
154 {left side}
155 if (ScreenPt.x < HANDLE_WIDTH) then
156 Msg.Result := HTLEFT
157 {top side}
158 else if (ScreenPt.y < HANDLE_WIDTH) then
159 Msg.Result := HTTOP
160 {right side}
161 else if (ScreenPt.x >= Width - HANDLE_WIDTH) then
162 Msg.Result := HTRIGHT
163 {bottom side}
164 else if (ScreenPt.y >= Height - HANDLE_WIDTH) then
165 Msg.Result := HTBOTTOM
166 {top left corner}
167 else if (ScreenPt.x < Sizegrip) and (ScreenPt.y < Sizegrip) then
168 Msg.Result := HTTOPLEFT
169 {bottom left corner}
170 else if (ScreenPt.x < Sizegrip) and (ScreenPt.y >= Height - Sizegrip) then
171 Msg.Result := HTBOTTOMLEFT
172 {top right corner}
173 else if (ScreenPt.x >= Width - Sizegrip) and (ScreenPt.y < Sizegrip) then
174 Msg.Result := HTTOPRIGHT
175 {bottom right corner}
176 else if (ScreenPt.x >= Width - Sizegrip) and (ScreenPt.y >= Height -
177 Sizegrip) then
178 Msg.Result := HTBOTTOMRIGHT;
179 end
180 {no sides or corners, this will do the dragging}
181 else if PtInRect(MoveArea, ScreenPt) and FAllowMove then
182 Msg.Result := HTCAPTION;
183 end;
184 end;
185
186 procedure TSizeGripPanel.Paint;
187 const
188 Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
189 var
190 Rect: TRect;
191 TopColor, BottomColor: TColor;
192 FontHeight: Integer;
193 LineBeg, LineEnd: TPoint;
194 Flags: Longint;
195 R: TRect;
196
197 procedure AdjustColors(Bevel: TPanelBevel);
198 begin
199 TopColor := clBtnHighlight;
200 if Bevel = bvLowered then
201 TopColor := clBtnShadow;
202 BottomColor := clBtnShadow;
203 if Bevel = bvLowered then
204 BottomColor := clBtnHighlight;
205 end;
206
207 procedure DrawCorner(pane: TRect);
208 begin
209 {Got this code from a Codeguru post. It was a CStatusBar descendant
210 and written in C}
211 OffsetRect(pane, -1, -1);
212 with Canvas do
213 begin
214 Canvas.Pen.Color := clBtnHighlight;
215 MoveTo(pane.right - 15, pane.bottom);
216 LineTo(pane.right, pane.bottom - 15);
217 MoveTo(pane.right - 11, pane.bottom);
218 LineTo(pane.right, pane.bottom - 11);
219 MoveTo(pane.right - 7, pane.bottom);
220 LineTo(pane.right, pane.bottom - 7);
221 MoveTo(pane.right - 3, pane.bottom);
222 LineTo(pane.right, pane.bottom - 3);
223 Canvas.Pen.Color := clBtnShadow;
224 MoveTo(pane.right - 14, pane.bottom);
225 LineTo(pane.right, pane.bottom - 14);
226 MoveTo(pane.right - 10, pane.bottom);
227 LineTo(pane.right, pane.bottom - 10);
228 MoveTo(pane.right - 6, pane.bottom);
229 LineTo(pane.right, pane.bottom - 6);
230 MoveTo(pane.right - 2, pane.bottom);
231 LineTo(pane.right, pane.bottom - 2);
232 MoveTo(pane.right - 13, pane.bottom);
233 LineTo(pane.right, pane.bottom - 13);
234 MoveTo(pane.right - 9, pane.bottom);
235 LineTo(pane.right, pane.bottom - 9);
236 MoveTo(pane.right - 5, pane.bottom);
237 LineTo(pane.right, pane.bottom - 5);
238 MoveTo(pane.right - 1, pane.bottom);
239 LineTo(pane.right, pane.bottom);
240 end;
241 end;
242
243 begin
244 Rect := GetClientRect;
245 if BevelOuter <> bvNone then
246 begin
247 AdjustColors(BevelOuter);
248 Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
249 end;
250 Frame3D(Canvas, Rect, Color, Color, BorderWidth);
251 if BevelInner <> bvNone then
252 begin
253 AdjustColors(BevelInner);
254 Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
255 end;
256 with Canvas do
257 begin
258 Brush.Color := Color;
259 FillRect(Rect);
260 Brush.Style := bsClear;
261 Font := Self.Font;
262 FontHeight := TextHeight('W');
263 with Rect do
264 begin
265 Top := ((Bottom + Top) - FontHeight) div 2;
266 Bottom := Top + FontHeight;
267 end;
268 Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
269 Flags := DrawTextBiDiModeFlags(Flags);
270 DrawText(Handle, PChar(Caption), -1, Rect, Flags);
271 Rect := GetClientRect;
272 if FShowSizeGrip then
273 begin
274 R := Rect;
275 R.Top := Height - 19;
276 R.Left := Rect.Left + BevelWidth;
277 R.Bottom := Rect.Bottom - BevelWidth;
278 R.Right := Rect.Right - BevelWidth;
279 AdjustColors(BevelOuter);
280 {Always have sunken statusbar! If you want a bar that is raised when
281 your panel is sunken, use this line, instead:
282 Frame3D(Canvas, R, BottomColor, TopColor, 1);}
283 Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1);
284 DrawCorner(R);
285 end;
286 end;
287 end;
288
289 procedure TSizeGripPanel.SetAllowMove(Value: Boolean);
290 begin
291 if Value <> FAllowMove then
292 begin
293 FAllowMove := Value;
294 Invalidate;
295 end;
296 end;
297
298 procedure TSizeGripPanel.SetAllowSize(Value: Boolean);
299 begin
300 if Value <> FAllowSize then
301 begin
302 FAllowSize := Value;
303 FShowSizeGrip := Value;
304 Invalidate;
305 end;
306 end;
307
308 procedure TSizeGripPanel.SetShowSizeGrip(Value: Boolean);
309 begin
310 if Value <> FShowSizeGrip then
311 begin
312 FShowSizeGrip := Value;
313 Invalidate;
314 end;
315 end;
316
317 end.
|
