使控件周边也有6各黑点，鼠标可以任意调整其大小和位置
其实我记得有一套控件好像是ReSize控件可以做到这一点。 ：）
{*************************************************}
{ }
{ DCB Studio Library }
{ }
{ Copyright(C) 2002-2003 DCB Studio }
{ }
{*************************************************}
unit DCBS_Components;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics, Menus;
const
SC_DRAGMOVE = $F012;
type
TdcbsSizeControlTemplate = class(TCustomControl)
private
FControl: TControl;
FRectList: array [1..8] of TRect;
FResizePosList: array [ 1..8] of DWORD;
procedure PopupMenuItemFreeClick(Sender: TObject);
procedure WMLButtonDown(var Msg: TWMLButtonDown);
message WM_LBUTTONDOWN;
procedure WMMove(var Msg: TWMMove);
message WM_MOVE;
procedure WMNcHitTest(var Msg: TWMNcHitTest);
message WM_NCHITTEST;
procedure WMPaint(var Msg: TWMPaint);
message WM_PAINT;
procedure WMRButtonUp(var Msg: TWMRButtonUp);
message WM_RBUTTONUP;
procedure WMSize(var Msg: TWMSize);
message WM_SIZE;
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent;
AControl: TControl);
procedure CreateParams(var Params: TCreateParams);
override;
procedure CreateHandle;
override;
procedure SizeControlTemplateExit(Sender: TObject);
published
{ Published declarations }
end;
TSizeControlTemplate = TdcbsSizeControlTemplate;
procedure CreateSizeControl(AOwner: TComponent;
AControl: TControl);
stdcall;
implementation
//***************************************************************************
{ TdcbsSizeControlTemplate }
constructor TdcbsSizeControlTemplate.Create(AOwner: TComponent;
AControl: TControl);
var
R: TRect;
MenuItem: TMenuItem;
FPopupMenu: TPopupMenu;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlTemplateExit;
R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
FPopupMenu := TPopupMenu.Create(Self);
with FPopupMenudo
begin
MenuItem := TMenuItem.Create(FPopupMenu);
MenuItem.Caption := 'Free(&F)';
MenuItem.Name := 'FreeControlMenuItem';
MenuItem.OnClick := PopupMenuItemFreeClick;
Items.Add(MenuItem);
end;
PopupMenu := FPopupMenu;
FResizePosList[1] := htTopLeft;
FResizePosList[2] := htTop;
FResizePosList[3] := htTopRight;
FResizePosList[4] := htRight;
FResizePosList[5] := htBottomRight;
FResizePosList[6] := htBottom;
FResizePosList[7] := htBottomLeft;
FResizePosList[8] := htLeft;
end;
procedure TdcbsSizeControlTemplate.CreateHandle;
begin
inherited;
SetFocus;
end;
procedure TdcbsSizeControlTemplate.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;
procedure TdcbsSizeControlTemplate.PopupMenuItemFreeClick(Sender: TObject);
begin
SizeControlTemplateExit(Self);
end;
procedure TdcbsSizeControlTemplate.SizeControlTemplateExit(
Sender: TObject);
begin
Free;
end;
procedure TdcbsSizeControlTemplate.WMLButtonDown(var Msg: TWMLButtonDown);
begin
Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
procedure TdcbsSizeControlTemplate.WMMove(var Msg: TWMMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;
procedure TdcbsSizeControlTemplate.WMNcHitTest(var Msg: TWMNcHitTest);
var
Pt: TPoint;
I: Byte;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
for I := 1 to 8do
if PtInRect(FRectList, Pt) then
Msg.Result := FResizePosList;
if Msg.Result = 0 then
inherited;
end;
procedure TdcbsSizeControlTemplate.WMPaint(var Msg: TWMPaint);
var
I: Byte;
begin
with Canvasdo
begin
Brush.Color := clBlue;
for I := 1 to 8do
Rectangle(FRectList);
end;
end;
procedure TdcbsSizeControlTemplate.WMRButtonUp(var Msg: TWMRButtonUp);
begin
inherited;
FControl.Invalidate;
end;
procedure TdcbsSizeControlTemplate.WMSize(var Msg: TWMSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect(R, -2, -2);
FControl.BoundsRect := R;
FRectList[1] := Rect(0, 0, 5, 5);
FRectList[2] := Rect(Width div 2 - 3, 0, Width div 2 + 2, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, Height div 2 - 3, Width, Height div 2 + 2);
FRectList[5] := Rect(Width - 5, Height - 5, Width , Height);
FRectList[6] := Rect(Width div 2 - 3, Height - 5, Width div 2 + 2, Height);
FRectList[7] := Rect(0, Height - 5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - 3, 5, Height div 2 + 2);
end;
procedure CreateSizeControl(AOwner: TComponent;
AControl: TControl);
begin
if not Assigned(AOwner) then
raise Exception.Create('Invalid parameter "AOwner"!');
if not Assigned(AControl) then
raise Exception.Create('Invalid parameter "AControl"');
TdcbsSizeControlTemplate.Create(AOwner, AControl);
end;
end.
使用方法：
建立一个新的unit，把上面的代码都贴进去。
在需要使用时只要调用CreateSizeControl()函数就可以了：
// Example:
begin
CreateSizeControl(Form1, Button1);
end;
// 注意这个东西还不完善，如果不乱用是不会用问题的。
关于类的实例的内存释放问题是这样的：
（1）当Button1失去焦点时，控件会自动释放；
（2）使用鼠标右键可以手工释放。
