[ 分享]SizeGrip

状态栏的右边有一个小的区域，可以用鼠标拖动改动窗体的大小，如果我不使用状态栏，如何来做呢？

How Can I Add a SizeGrip to a Form Without Using Statusbar?

[Post=2]

From: http://vidfern.com/showcode.asp?id=sizegrip Author: John

在窗体上面放一个TImage，然后在FormCreate中添加类似代码：

 with Image1 do

 begin

   AutoSize := False;

   Cursor := crSizeNWSE;

   Anchors := [akRight, akBottom];

   Width := 16;

   Height := 16;

   Canvas.FillRect(Rect(0, 0, Width, Height));

   DrawFrameControl(Canvas.Handle, Rect(0, 0, 15, 15), DFC_SCROLL, DFCS_SCROLLSIZEGRIP);

   Transparent := True;

   Left := Self.ClientWidth - Width - 1;

   Top := Self.ClientHeight - Height - 1;

 end;

在Image的onMouseDown中添加如下代码即可：

 ReleaseCapture();

 Perform(WM_SYSCOMMAND, SC_SIZE + 8, 0);

当然也可以有另外的方法，类似下面，From b.p.d.n David B. Ferguson <david.mcs@ns.sympatico.ca>：

unit Unit1;

interface

uses

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

type

 TForm1 = class(TForm)

   procedure WMNCHitTest(var Message: TWMNCHitTest);

   procedure FormCreate(Sender: TObject);

   procedure FormResize(Sender: TObject);

   procedure FormPaint(Sender: TObject);

 private

   { Private declarations }

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

 FSizeGripRect: TRect;

 FSizeGripWidth, FSizeGripHeight: Integer;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);

begin

 inherited;

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

then

   Message.Result := HTBOTTOMRIGHT;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 FSizeGripWidth:=GetSystemMetrics(SM_CXVSCROLL);

 FSizeGripHeight:=GetSystemMetrics(SM_CYHSCROLL);

end;

procedure TForm1.FormResize(Sender: TObject);

begin

 FSizeGripRect := ClientRect;

 FSizeGripRect.Left := FSizeGripRect.Right - FSizeGripWidth;

 FSizeGripRect.Top := FSizeGripRect.Bottom - FSizeGripHeight;

 Refresh;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

   DrawFrameControl(Canvas.Handle, FSizeGripRect,

     DFC_SCROLL, DFCS_SCROLLSIZEGRIP);

end;

end.

最后，我们可以把这个功能封装成一个控件 From B.P.A Bryan Ashby <bryanashby@hotNOSPAM.PLEASEmail.com>：

unit BaclBasicUiEnh;

interface

uses

 Windows,  Messages,  Controls,  Classes,  ThemeSrv;

type

 TThemedSizeGripper    = class (TCustomControl)

 public

   constructor Create (AOwner : TComponent); override;

 protected

   procedure Paint; override;

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

 end;

implementation

{ TThemedSizeGripper }

constructor TThemedSizeGripper.Create(AOwner: TComponent);

var

 GripWidth     : integer;

 GripHeight    : integer;

begin

 inherited Create (AOwner);

 GripWidth := GetSystemMetrics (SM_CXHSCROLL);

 GripHeight := GetSystemMetrics (SM_CYVSCROLL);

 ControlStyle := ControlStyle - [csSetCaption];

 SetBounds ((AOwner as TWinControl).ClientWidth - GripWidth,

   (AOwner as TWinControl).ClientHeight - GripHeight, GripWidth, GripHeight);

 Anchors := [akRight, akBottom];

end;

procedure TThemedSizeGripper.Paint;

var

 Details       : TThemedElementDetails;

begin

 if ThemeServices.ThemesEnabled then

 begin

   Details := ThemeServices.GetElementDetails(tsGripper);

   ThemeServices.DrawElement(Canvas.Handle, Details, ClientRect);

 end

 else

   DrawFrameControl (Canvas.Handle, ClientRect, DFC_SCROLL,

     DFCS_SCROLLSIZEGRIP);

end;

procedure TThemedSizeGripper.WMNCHitTest(var Msg: TWMNCHitTest);

var

 ScreenPt      : TPoint;

begin

 inherited;

 if not (csDesigning in  ComponentState) and (Msg.Result = HTCLIENT) then

 begin

   ScreenPt := ScreenToClient(Point(Msg.Xpos, Msg.Ypos));

   if (ScreenPt.x >= (ClientWidth - Width)) and

     (ScreenPt.y >= (ClientHeight - Height)) then Msg.Result := HTBOTTOMRIGHT;

 end;

end;

end.[/Post]