首页  编辑  

使控件周边也有6各黑点,鼠标可以任意调整其大小和位置

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/自定义控件/   Date Created:

使控件周边也有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 FPopupMenu do

 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 8 do

   if PtInRect(FRectList[I], Pt) then

     Msg.Result := FResizePosList[I];

 if Msg.Result = 0 then

   inherited;

end;

procedure TdcbsSizeControlTemplate.WMPaint(var Msg: TWMPaint);

var

 I: Byte;

begin

 with Canvas do

 begin

   Brush.Color := clBlue;

   for I := 1 to 8 do

     Rectangle(FRectList[I]);

 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)使用鼠标右键可以手工释放。