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 Add a size grip to a TForm without using a status bar 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
14-Feb-03
Category
VCL-Forms
Language
Delphi 7.x
Views
219
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Lou Adler

How to add a size grip to a TForm without using a status bar

Answer:

Solve 1:

A size grip appears on a form in two cases: when a status bar is placed at the 
bottom of the form or when the form has both a horizontal and a vertical scrollbar. 
To place a size grip on a form without any of the above, you need to draw it 
yourself and handle mouse events. The following unit demonstrates drawing a size 
grip at the bottom right corner (including XP style, if supported):

1   unit Unit1;
2   
3   interface
4   
5   uses
6     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms;
7   
8   type
9     TForm1 = class(TForm)
10      procedure FormPaint(Sender: TObject);
11      procedure FormResize(Sender: TObject);
12      procedure FormCreate(Sender: TObject);
13    private
14      FSizeGripWidth: Integer;
15      FSizeGripHeight: Integer;
16      FSizeGripRect: TRect;
17      procedure WMNCHitTest(var message: TWMNCHitTest); message WM_NCHITTEST;
18    public
19      { Public declarations }
20    end;
21  
22  var
23    Form1: TForm1;
24  
25  implementation
26  
27  uses
28    Themes;
29  
30  {$R *.dfm}
31  
32  procedure TForm1.FormPaint(Sender: TObject);
33  begin
34    if ThemeServices.ThemesAvailable then
35    begin
36      ThemeServices.DrawElement(Canvas.Handle,
37        ThemeServices.GetElementDetails(tsSizeBoxRightAlign), FSizeGripRect);
38    end
39    else
40      DrawFrameControl(Canvas.Handle, FSizeGripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
41  end;
42  
43  procedure TForm1.FormResize(Sender: TObject);
44  begin
45    FSizeGripRect := ClientRect;
46    FSizeGripRect.Left := FSizeGripRect.Right - FSizeGripWidth;
47    FSizeGripRect.Top := FSizeGripRect.Bottom - FSizeGripHeight;
48    Refresh;
49  end;
50  
51  procedure TForm1.FormCreate(Sender: TObject);
52  begin
53    FSizeGripWidth := GetSystemMetrics(SM_CXVSCROLL);
54    FSizeGripHeight := GetSystemMetrics(SM_CYHSCROLL);
55  end;
56  
57  procedure TForm1.WMNCHitTest(var message: TWMNCHitTest);
58  begin
59    inherited;
60    if PtInRect(FSizeGripRect, ScreenToClient(SmallPointToPoint(message.Pos))) then
61      message.Result := HTBOTTOMRIGHT;
62  end;
63  
64  end.



Solve 2:

Use a TPaintBox (Anchors = [akRight,akBottom]) and place it on a TPanel 
(Align=alClient):

65  unit Unit1;
66  
67  interface
68  
69  uses
70    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
71    Dialogs, ExtCtrls, ComCtrls;
72  
73  type
74    TForm1 = class(TForm)
75      Panel1: TPanel;
76      PaintBox1: TPaintBox;
77      procedure FormCreate(Sender: TObject);
78      procedure FormPaint(Sender: TObject);
79      procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
80        Shift: TShiftState; X, Y: Integer);
81    private
82      { Private declarations }
83    protected
84    public
85      { Public declarations }
86    end;
87  
88  var
89    Form1: TForm1;
90  
91  implementation
92  
93  {$R *.dfm}
94  
95  procedure TForm1.FormCreate(Sender: TObject);
96  begin
97    PaintBox1.Width := GetSystemMetrics(SM_CXVSCROLL);
98    PaintBox1.Height := GetSystemMetrics(SM_CYHSCROLL);
99  end;
100 
101 procedure TForm1.FormPaint(Sender: TObject);
102 begin
103   with (Sender as TPaintBox) do
104     DrawFrameControl(Canvas.Handle, ClientRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
105 end;
106 
107 procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
108   Shift: TShiftState; X, Y: Integer);
109 begin
110   PaintBox1.Perform(WM_LBUTTONUP, MK_LBUTTON, X or (Y shl 16));
111   PostMessage(Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, X or (Y shl 16));
112 end;
113 
114 end.



Solve 3:

I took an image for the grip and adjusted it manually on resizing of the form. 
Anchors do not work correctly with toolwindows or if the window caption is not the 
same as in design time.

115 { ... }
116 TxxDlg = class(TForm)
117   SizeGripImage: TImage;
118   { ... }
119 
120 procedure TxxDlg.SizeGripImageMouseDown(Sender: TObject; Button: TMouseButton;
121   Shift: TShiftState; X, Y: Integer);
122 begin
123   {release mouse button}
124   PostMessage(Handle, WM_LBUTTONUP, MK_LBUTTON, 0);
125   Application.ProcessMessages;
126   {simulate size click}
127   PostMessage(Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0)
128 end;
129 
130 procedure TxxDlg.FormResize(Sender: TObject);
131 begin
132   {adjust size grip position}
133   SizeGripImage.SetBounds(clientrect.Right - SizeGripImage.Width, clientrect.Bottom 
134 -
135     SizeGripImage.Height, SizeGripImage.Width, SizeGripImage.Height);
136 end;
137 
138 
139 Solve 4:
140 
141 Note that this only works with Delphi version 7 - to use it in earlier versions 
142 would require some compiler directives around the theme-related stuff.
143 
144 {Component - KobSizeGrip
145 Date - February 16, 2004
146 Author - Eric Schreiber, Kobayashi Software
147 Contact - eric@kobayashi.com
148 Web URL - www.kobayashi.com
149 Copyright - (C) 2004 Eric Schreiber
150 Function - Adds resizing grip to form}
151 
152 unit KobSizeGrip;
153 
154 interface
155 
156 uses
157   Windows, Forms, Messages, Classes, ExtCtrls, Controls, SysUtils, Themes;
158 
159 type
160   TKobSizeGrip = class(TComponent)
161   private
162     { Private declarations }
163     FActive: Boolean;
164     FGripHeight: Integer;
165     FGripWidth: Integer;
166     FParentForm: TCustomForm;
167     FSaveWndProc: TWndMethod;
168     procedure SetActive(AValue: Boolean);
169     procedure HookWndProc;
170     procedure UnhookWndProc;
171     procedure SizeGripWindowProc(var AMsg: TMessage);
172   protected
173     { Protected declarations }
174     function GetGripRect: TRect;
175   public
176     { Public declarations }
177     constructor Create(AOwner: TComponent); override;
178     destructor Destroy; override;
179   published
180     { Published declarations }
181     property Active: Boolean read FActive write SetActive default False;
182   end;
183 
184 procedure register;
185 
186 implementation
187 
188 procedure register;
189 begin
190   RegisterComponents('Kobayashi', [TKobSizeGrip]);
191 end;
192 
193 function TKobSizeGrip.GetGripRect: TRect;
194 begin
195   Result := FParentForm.ClientRect;
196   Result.Left := Result.Right - FGripWidth;
197   Result.Top := Result.Bottom - FGripHeight;
198 end;
199 
200 constructor TKobSizeGrip.Create(AOwner: TComponent);
201 begin
202   inherited Create(AOwner);
203   FActive := False;
204   if not (csDesigning in ComponentState) then
205   begin
206     FGripWidth := GetSystemMetrics(SM_CXVSCROLL);
207     FGripHeight := GetSystemMetrics(SM_CYHSCROLL);
208     FParentForm := GetParentForm(TControl(AOwner));
209     HookWndProc;
210   end;
211 end;
212 
213 destructor TKobSizeGrip.Destroy;
214 begin
215   if not (csDesigning in ComponentState) then
216   begin
217     UnhookWndProc;
218     if FParentForm <> nil then
219       FParentForm := nil;
220   end;
221   inherited Destroy;
222 end;
223 
224 procedure TKobSizeGrip.HookWndProc;
225 begin
226   if FParentForm <> nil then
227   begin
228     FSaveWndProc := FParentForm.WindowProc; {save original}
229     FParentForm.WindowProc := SizeGripWindowProc; {assign new}
230   end;
231 end;
232 
233 procedure TKobSizeGrip.UnhookWndProc;
234 begin
235   if Assigned(FSaveWndProc) and (FParentForm <> nil) then
236   begin
237     FParentForm.WindowProc := FSaveWndProc;
238     FSaveWndProc := nil;
239   end;
240 end;
241 
242 procedure TKobSizeGrip.SetActive(AValue: Boolean);
243 begin
244   if FActive <> AValue then
245   begin
246     FActive := AValue;
247     if not (csDesigning in ComponentState) then
248       FParentForm.Invalidate;
249   end;
250 end;
251 
252 procedure TKobSizeGrip.SizeGripWindowProc(var AMsg: TMessage);
253 var
254   GripRect: TRect;
255 begin
256   if Assigned(FSaveWndProc) then
257     FSaveWndProc(AMsg); {call saved handler}
258   if FActive and (FParentForm <> nil) and not (csDesigning in ComponentState)
259     and not (csDestroying in ComponentState) then
260   begin
261     {Rect used in all cases}
262     GripRect := GetGripRect;
263     if AMsg.Msg = WM_PAINT then
264     begin
265       {Do paint related stuff}
266       if ThemeServices.ThemesEnabled then
267         ThemeServices.DrawElement(FParentForm.Canvas.Handle,
268           ThemeServices.GetElementDetails(tsSizeBoxRightAlign),
269           GripRect)
270       else
271         DrawFrameControl(FParentForm.Canvas.Handle, GripRect,
272           DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
273     end
274     else if AMsg.Msg = WM_SIZE then
275     begin
276       {Do resizing related stuff}
277       GripRect.Top := GripRect.Bottom - FGripHeight;
278       GripRect.Left := GripRect.Right - FGripWidth;
279       FParentForm.Refresh;
280 
281     end
282     else if AMsg.Msg = WM_NCHITTEST then
283     begin
284       {Do hit test related stuff. Cast AMsg as TWMNCHitTest to get mouse position}
285       if PtInRect(GripRect, FParentForm.ScreenToClient(SmallPointToPoint
286         (TWMNCHitTest(AMsg).Pos))) then
287         AMsg.Result := HTBOTTOMRIGHT;
288     end;
289   end;
290 end;
291 
292 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