Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a resizable TPanel with a size grip Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
26-Aug-02
Category
VCL-General
Language
Delphi 2.x
Views
52
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC