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

Answer

First solution:

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):

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms;

type
 TForm1 = class(TForm)
 procedure FormPaint(Sender: TObject);
 procedure FormResize(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 private
 FSizeGripWidth: Integer;
 FSizeGripHeight: Integer;
 FSizeGripRect: TRect;
 procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses
 Themes;

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
begin
 if ThemeServices.ThemesAvailable then
 begin
 ThemeServices.DrawElement(Canvas.Handle,
 ThemeServices.GetElementDetails(tsSizeBoxRightAlign), FSizeGripRect);
 end
 else
 DrawFrameControl(Canvas.Handle, FSizeGripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 FSizeGripRect := ClientRect;
 FSizeGripRect.Left := FSizeGripRect.Right - FSizeGripWidth;
 FSizeGripRect.Top := FSizeGripRect.Bottom - FSizeGripHeight;
 Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FSizeGripWidth := GetSystemMetrics(SM_CXVSCROLL);
 FSizeGripHeight := GetSystemMetrics(SM_CYHSCROLL);
end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
 inherited;
 if PtInRect(FSizeGripRect, ScreenToClient(SmallPointToPoint(Message.Pos))) then
 Message.Result := HTBOTTOMRIGHT;
end;

end.

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):

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms;

type

TForm1 = class(TForm)

procedure FormPaint(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

FSizeGripWidth: Integer;

FSizeGripHeight: Integer;

FSizeGripRect: TRect;

procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses

Themes;

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);

begin

if ThemeServices.ThemesAvailable then

begin

ThemeServices.DrawElement(Canvas.Handle,

ThemeServices.GetElementDetails(tsSizeBoxRightAlign), FSizeGripRect);

end

else

DrawFrameControl(Canvas.Handle, FSizeGripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);

end;

procedure TForm1.FormResize(Sender: TObject);

begin

FSizeGripRect := ClientRect;

FSizeGripRect.Left := FSizeGripRect.Right - FSizeGripWidth;

FSizeGripRect.Top := FSizeGripRect.Bottom - FSizeGripHeight;

Refresh;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FSizeGripWidth := GetSystemMetrics(SM_CXVSCROLL);

FSizeGripHeight := GetSystemMetrics(SM_CYHSCROLL);

end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);

begin

inherited;

if PtInRect(FSizeGripRect, ScreenToClient(SmallPointToPoint(Message.Pos))) then

Message.Result := HTBOTTOMRIGHT;

end;

end.

Solution 2:

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

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, ComCtrls;

type
 TForm1 = class(TForm)
 Panel1: TPanel;
 PaintBox1: TPaintBox;
 procedure FormCreate(Sender: TObject);
 procedure FormPaint(Sender: TObject);
 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 private
 { Private declarations }
 protected
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBox1.Width := GetSystemMetrics(SM_CXVSCROLL);
 PaintBox1.Height := GetSystemMetrics(SM_CYHSCROLL);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 with (Sender as TPaintBox) do
 DrawFrameControl(Canvas.Handle, ClientRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 PaintBox1.Perform(WM_LBUTTONUP, MK_LBUTTON, X or (Y shl 16));
 PostMessage(Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, X or (Y shl 16));
end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, ComCtrls;

type

TForm1 = class(TForm)

Panel1: TPanel;

PaintBox1: TPaintBox;

procedure FormCreate(Sender: TObject);

procedure FormPaint(Sender: TObject);

procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

protected

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

PaintBox1.Width := GetSystemMetrics(SM_CXVSCROLL);

PaintBox1.Height := GetSystemMetrics(SM_CYHSCROLL);

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

with (Sender as TPaintBox) do

DrawFrameControl(Canvas.Handle, ClientRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);

end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

PaintBox1.Perform(WM_LBUTTONUP, MK_LBUTTON, X or (Y shl 16));

PostMessage(Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, X or (Y shl 16));

end;

end.

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

{ … }

TxxDlg = class(TForm)
 SizeGripImage: TImage;
 { ... }

procedure TxxDlg.SizeGripImageMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 {release mouse button}
 PostMessage(Handle, WM_LBUTTONUP, MK_LBUTTON, 0);
 Application.ProcessMessages;
 {simulate size click}
 PostMessage(Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0)
end;

procedure TxxDlg.FormResize(Sender: TObject);
begin
 {adjust size grip position}
 SizeGripImage.SetBounds(clientrect.Right - SizeGripImage.Width, clientrect.Bottom -
 SizeGripImage.Height, SizeGripImage.Width, SizeGripImage.Height);
end;

TxxDlg = class(TForm)

SizeGripImage: TImage;

{ ... }

procedure TxxDlg.SizeGripImageMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

{release mouse button}

PostMessage(Handle, WM_LBUTTONUP, MK_LBUTTON, 0);

Application.ProcessMessages;

{simulate size click}

PostMessage(Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0)

end;

procedure TxxDlg.FormResize(Sender: TObject);

begin

{adjust size grip position}

SizeGripImage.SetBounds(clientrect.Right - SizeGripImage.Width, clientrect.Bottom -

SizeGripImage.Height, SizeGripImage.Width, SizeGripImage.Height);

end;

Solution 4:

Note that this only works with Delphi version 7 – to use it in earlier versions would require some compiler directives around the theme-related stuff.

{Component - KobSizeGrip
Date - February 16, 2004
Author - Eric Schreiber, Kobayashi Software
Contact - eric@kobayashi.com
Web URL - www.kobayashi.com
Copyright - (C) 2004 Eric Schreiber
Function - Adds resizing grip to form}

unit KobSizeGrip;

interface

uses
 Windows, Forms, Messages, Classes, ExtCtrls, Controls, SysUtils, Themes;

type
 TKobSizeGrip = class(TComponent)
 private
 { Private declarations }
 FActive: Boolean;
 FGripHeight: Integer;
 FGripWidth: Integer;
 FParentForm: TCustomForm;
 FSaveWndProc: TWndMethod;
 procedure SetActive(AValue: Boolean);
 procedure HookWndProc;
 procedure UnhookWndProc;
 procedure SizeGripWindowProc(var AMsg: TMessage);
 protected
 { Protected declarations }
 function GetGripRect: TRect;
 public
 { Public declarations }
 constructor Create(AOwner: TComponent); override;
 destructor Destroy; override;
 published
 { Published declarations }
 property Active: Boolean read FActive write SetActive default False;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Kobayashi', [TKobSizeGrip]);
end;

function TKobSizeGrip.GetGripRect: TRect;
begin
 Result := FParentForm.ClientRect;
 Result.Left := Result.Right - FGripWidth;
 Result.Top := Result.Bottom - FGripHeight;
end;

constructor TKobSizeGrip.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FActive := False;
 if not (csDesigning in ComponentState) then
 begin
 FGripWidth := GetSystemMetrics(SM_CXVSCROLL);
 FGripHeight := GetSystemMetrics(SM_CYHSCROLL);
 FParentForm := GetParentForm(TControl(AOwner));
 HookWndProc;
 end;
end;

destructor TKobSizeGrip.Destroy;
begin
 if not (csDesigning in ComponentState) then
 begin
 UnhookWndProc;
 if FParentForm &lt;&gt; nil then
 FParentForm := nil;
 end;
 inherited Destroy;
end;

procedure TKobSizeGrip.HookWndProc;
begin
 if FParentForm &lt;&gt; nil then
 begin
 FSaveWndProc := FParentForm.WindowProc; {save original}
 FParentForm.WindowProc := SizeGripWindowProc; {assign new}
 end;
end;

procedure TKobSizeGrip.UnhookWndProc;
begin
 if Assigned(FSaveWndProc) and (FParentForm &lt;&gt; nil) then
 begin
 FParentForm.WindowProc := FSaveWndProc;
 FSaveWndProc := nil;
 end;
end;

procedure TKobSizeGrip.SetActive(AValue: Boolean);
begin
 if FActive &lt;&gt; AValue then
 begin
 FActive := AValue;
 if not (csDesigning in ComponentState) then
 FParentForm.Invalidate;
 end;
end;

procedure TKobSizeGrip.SizeGripWindowProc(var AMsg: TMessage);
var
 GripRect: TRect;
begin
 if Assigned(FSaveWndProc) then
 FSaveWndProc(AMsg); {call saved handler}
 if FActive and (FParentForm &lt;&gt; nil) and not (csDesigning in ComponentState)
 and not (csDestroying in ComponentState) then
 begin
 {Rect used in all cases}
 GripRect := GetGripRect;
 if AMsg.Msg = WM_PAINT then
 begin
 {Do paint related stuff}
 if ThemeServices.ThemesEnabled then
 ThemeServices.DrawElement(FParentForm.Canvas.Handle,
 ThemeServices.GetElementDetails(tsSizeBoxRightAlign),
 GripRect)
 else
 DrawFrameControl(FParentForm.Canvas.Handle, GripRect,
 DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
 end
 else if AMsg.Msg = WM_SIZE then
 begin
 {Do resizing related stuff}
 GripRect.Top := GripRect.Bottom - FGripHeight;
 GripRect.Left := GripRect.Right - FGripWidth;
 FParentForm.Refresh;

 end
 else if AMsg.Msg = WM_NCHITTEST then
 begin
 {Do hit test related stuff. Cast AMsg as TWMNCHitTest to get mouse position}
 if PtInRect(GripRect, FParentForm.ScreenToClient(SmallPointToPoint
 (TWMNCHitTest(AMsg).Pos))) then
 AMsg.Result := HTBOTTOMRIGHT;
 end;
 end;
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

{Component - KobSizeGrip

Date - February 16, 2004

Author - Eric Schreiber, Kobayashi Software

Contact - eric@kobayashi.com

Web URL - www.kobayashi.com

Function - Adds resizing grip to form}

unit KobSizeGrip;

interface

uses

Windows, Forms, Messages, Classes, ExtCtrls, Controls, SysUtils, Themes;

type

TKobSizeGrip = class(TComponent)

private

{ Private declarations }

FActive: Boolean;

FGripHeight: Integer;

FGripWidth: Integer;

FParentForm: TCustomForm;

FSaveWndProc: TWndMethod;

procedure SetActive(AValue: Boolean);

procedure HookWndProc;

procedure UnhookWndProc;

procedure SizeGripWindowProc(var AMsg: TMessage);

protected

{ Protected declarations }

function GetGripRect: TRect;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

{ Published declarations }

property Active: Boolean read FActive write SetActive default False;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Kobayashi', [TKobSizeGrip]);

end;

function TKobSizeGrip.GetGripRect: TRect;

begin

Result := FParentForm.ClientRect;

Result.Left := Result.Right - FGripWidth;

Result.Top := Result.Bottom - FGripHeight;

end;

constructor TKobSizeGrip.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FActive := False;

if not (csDesigning in ComponentState) then

begin

FGripWidth := GetSystemMetrics(SM_CXVSCROLL);

FGripHeight := GetSystemMetrics(SM_CYHSCROLL);

FParentForm := GetParentForm(TControl(AOwner));

HookWndProc;

end;

destructor TKobSizeGrip.Destroy;

begin

if not (csDesigning in ComponentState) then

begin

UnhookWndProc;

if FParentForm <> nil then

FParentForm := nil;

end;

inherited Destroy;

end;

procedure TKobSizeGrip.HookWndProc;

begin

if FParentForm <> nil then

begin

FSaveWndProc := FParentForm.WindowProc; {save original}

FParentForm.WindowProc := SizeGripWindowProc; {assign new}

end;

procedure TKobSizeGrip.UnhookWndProc;

begin

if Assigned(FSaveWndProc) and (FParentForm <> nil) then

begin

FParentForm.WindowProc := FSaveWndProc;

FSaveWndProc := nil;

end;

procedure TKobSizeGrip.SetActive(AValue: Boolean);

begin

if FActive <> AValue then

begin

FActive := AValue;

if not (csDesigning in ComponentState) then

FParentForm.Invalidate;

end;

procedure TKobSizeGrip.SizeGripWindowProc(var AMsg: TMessage);

var

GripRect: TRect;

begin

if Assigned(FSaveWndProc) then

FSaveWndProc(AMsg); {call saved handler}

if FActive and (FParentForm <> nil) and not (csDesigning in ComponentState)

and not (csDestroying in ComponentState) then

begin

{Rect used in all cases}

GripRect := GetGripRect;

if AMsg.Msg = WM_PAINT then

begin

{Do paint related stuff}

if ThemeServices.ThemesEnabled then

ThemeServices.DrawElement(FParentForm.Canvas.Handle,

ThemeServices.GetElementDetails(tsSizeBoxRightAlign),

GripRect)

else

DrawFrameControl(FParentForm.Canvas.Handle, GripRect,

DFC_SCROLL, DFCS_SCROLLSIZEGRIP);

end

else if AMsg.Msg = WM_SIZE then

begin

{Do resizing related stuff}

GripRect.Top := GripRect.Bottom - FGripHeight;

GripRect.Left := GripRect.Right - FGripWidth;

FParentForm.Refresh;

end

else if AMsg.Msg = WM_NCHITTEST then

begin

{Do hit test related stuff. Cast AMsg as TWMNCHitTest to get mouse position}

if PtInRect(GripRect, FParentForm.ScreenToClient(SmallPointToPoint

(TWMNCHitTest(AMsg).Pos))) then

AMsg.Result := HTBOTTOMRIGHT;

end;

end.

Make a question and you'll have an answer…

Make a question and you'll have an answer…

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

Answer