Mega Code Archive
Resizable forms and size grip Part 2
<![CDATA[
Title: Resizable forms and size grip - Part 2
Question: Improving the behaviour...
Answer:
A comment to my previous article (thanks to Skip Bremer) stated that the cursor target area was not enlarged as the status bar would. This is correct.
In effect the article was simply a suggestion on how to use that API to draw a size grip not on how to reproduce the behaviour of the status bar; anyway the Bremer's comment pushed me to make some testing on how to implement the suggested behaviour.
The solution I found is simple: I used a PaintBox aligned on the bottom-right corner of the form, I set the Cursor property to crSizeNWSE and then intercepted the OnPaint and OnMouseDown events.
During the OnPaint the DrawFrameControl API is used to draw the visual effect.
During the OnMouseDown event the mouse capture is released and the resize of the form is started using the SendMessage API
Here follows the DFM and PAS source code:
This is the DFM:
object Form1: TForm1
Left = 286
Top = 106
Width = 410
Height = 286
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
Anchors = [akRight, akBottom]
Caption = 'Grip Tester'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object PaintBox1: TPaintBox
Left = 386
Top = 242
Width = 16
Height = 16
Cursor = crSizeNWSE
Anchors = [akRight, akBottom]
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
OnMouseDown = PaintBox1MouseDown
OnPaint = PaintBox1Paint
end
object Label1: TLabel
Left = 263
Top = 245
Width = 119
Height = 13
Anchors = [akRight, akBottom]
Caption = 'This is not a size grip! --'
end
end
This is the PAS source:
unit Unit1;
interface
uses
Windows, Messages, Forms, ExtCtrls, Classes, Controls, StdCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Label1: TLabel;
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
DrawFrameControl(PaintBox1.Canvas.Handle,
PaintBox1.ClientRect,
DFC_SCROLL,
DFCS_SCROLLSIZEGRIP);
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if(Button = mbLeft) and (Shift = [ssLeft]) then
begin
ReleaseCapture;
SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0);
end;
end;
end.
Enjoy
]]>