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.
|
