SizeControl 留下的黑点如何檫去？(100分)

SizeControl 是一个允许在运行时移动和改变 控件的不可见控件，在运行时若单击某控件后，会出现8个黑点，但当再选取另外的控件时，这些黑点不会被檫除，不如 Delphi 设计的那么专业，那位大虾有办法呀？（我用pmNotxor 模式绘制黑点也无效）。若有好的控件或修正此控件，使之能如 Delphi 设计时那样工作，可另外送分。

unit SizerControl;

interface

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

type
TSizerControl = class(TCustomControl)
private
FControl: TControl;
FRectList: Array [1..8] of TRect;
FPosList: Array [1..8] of Integer;

{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl);
procedure CreateParams(var Params: TCreateParams); override;
procedure Createhandle;override;
procedure WmNcHitTest(var Msg: TWmNcHitTest); message wm_NcHitTest;
procedure WmSize(var Msg:TWmSize); message wm_Size;
procedure WmLButtonDown(var Msg: TWmLButtonDown); message wm_LButtonDown;
procedure WmMove(var Msg: TWmMove); message Wm_Move;
procedure Paint; override;
procedure SizeControlExit(Sender: TObject);

{ Public declarations }
published
{ Published declarations }
end;
const
sc_DragMove: Longint = $F012;


procedure Register;

implementation

constructor TSizerControl.Create(AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlExit;

R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;

end;
procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle
+ WS_EX_TRANSPARENT;
end;

procedure TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;

procedure TSizerControl.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
I: Integer;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
//检测鼠标位置并改变状态
for I := 1 to 8 do
if PtInRect(FRectList, Pt) then
Msg.Result := FPosList;
if Msg.Result = 0 then
inherited;
end;


procedure TSizerControl.WmSize(var Msg:TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.BoundsRect := R;
//计算8个黑方框
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 TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//执行拖动命令
Perform(Wm_SysCommand, sc_DragMove, 0);
end;

procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;

procedure TSizerControl.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := clBlack;
for I := 1 to 8 do
with FRectList do
Canvas.Rectangle (Left, Top, Right, Bottom);
end;

procedure TSizerControl.SizeControlExit(Sender: TObject);
begin
Free;
end;



procedure Register;
begin
RegisterNoicon([TSizerControl]);
end;

end

主窗口程序：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
btn: TButton;
GroupBox1: TGroupBox;
procedure btnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses SizerControl;

{$R *.DFM}

procedure TForm1.btnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, btn);
end;

procedure TForm1.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, GroupBox1);
end;



end.

以上是该控件的代码

你代码没贴出来人家也没法帮你调试。看看这个怎么样？（转载的）

unit Resizer;

interface

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

const
GRIDDEFAULT = 4;

type
TResizer = class;
TMover = class;

TMovingEvent = procedure(Sender: TResizer; var NewLeft, NewTop: integer) of object;
TSizingEvent = procedure(Sender: TResizer; var NewLeft, NewTop, NewWidth, NewHeight: integer) of object;

TResizer = class(TComponent)
protected
FActive : boolean;
FControl : TControl;
Sizers : TList;
GroupMovers : TList;
FGroup : TWinControl;
FGridX : integer;
FGridY : integer;
FOnSized : TNotifyEvent;
FOnSizing : TSizingEvent;
FOnMoved : TNotifyEvent;
FOnMoving : TMovingEvent;
Sizing : boolean;
Moving : boolean;
OrigSize : TRect;
NewSize : TRect;
DownX : integer;
DownY : integer;
FAllowSize : boolean;
FAllowMove : boolean;
FKeepIn : boolean;
FHotTrack : boolean;
OneMover : TMover;
CurMover : TMover;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetActive(b: boolean);
procedure SetControl(c: TControl);
procedure SetGroup(p: TWinControl);
procedure CreateSizers;
procedure CheckSizers;
procedure ShowSizers;
procedure HideSizers;
procedure SizerDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MoverDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MoverUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure DrawSizeRect(Rect: TRect);
procedure Calc_Size_Rect(SizerNum, dx, dy: integer);
procedure DoSizingEvent;
procedure Calc_Move_Rect(dx, dy: integer);
procedure DoMovingEvent;
procedure Constrain_Size;
procedure Constrain_Move;
procedure MoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer);
procedure CreateGroupMovers;
procedure CreateOneMover(m: TMover; c: TControl);
function FindMoverByBuddy(c: TControl): TMover;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Active: boolean read FActive write SetActive default True;
property ResizeControl: TControl read FControl write SetControl;
property ResizeGroup: TWinControl read FGroup write SetGroup;
property GridX: integer read FGridX write FGridX default GRIDDEFAULT;
property GridY: integer read FGridY write FGridY default GRIDDEFAULT;
property OnSized: TNotifyEvent read FOnSized write FOnSized;
property OnSizing: TSizingEvent read FOnSizing write FOnSizing;
property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
property OnMoving: TMovingEvent read FOnMoving write FOnMoving;
property AllowSize: boolean read FAllowSize write FAllowSize default True;
property AllowMove: boolean read FAllowMove write FAllowMove default True;
property KeepInParent: boolean read FKeepIn write FKeepIn default True;
property HotTrack: boolean read FHotTrack write FHotTrack;
end;

TInvisWin = class(TPanel) // This could also derive from TPanel
protected
procedure WndProc(var Message: TMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMDLGCode(var Message: TMessage); message WM_GETDLGCODE;
public
property OnKeyDown;
end;

TMover = class(TInvisWin)
public
Buddy : TControl;
procedure Show;
end;


procedure Register;

implementation

const
SIZE = 6;
HALFSIZE = SIZE div 2;

type
TSizer = class(TPanel)
end;

procedure Register;
begin
RegisterComponents('Samples', [TResizer]);
end;


// *****************************************************************
// TInvisWin

procedure TInvisWin.WndProc(var Message: TMessage);
var
ps : TPaintStruct;
begin
case Message.Msg of
WM_ERASEBKGND: Message.Result := 1;
WM_PAINT: begin
BeginPaint(Handle, ps);
EndPaint(Handle, ps);
Message.Result := 1;
end;
else
inherited WndProc(Message);
end;
end;

procedure TInvisWin.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TInvisWin.WMDLGCode(var Message: TMessage);
begin
Message.Result := DLGC_WANTARROWS or DLGC_WANTALLKEYS;
end;


// *****************************************************************
// TMover

procedure TMover.Show;
begin
Assert(Buddy <> nil);
BoundsRect := Buddy.BoundsRect;
Parent := Buddy.Parent;
Visible := True;
BringToFront;
end;


// *****************************************************************
// TResizer

constructor TResizer.Create(AOwner: TComponent);
begin
inherited;
FActive := True;
FKeepIn := True;
FGridX := GRIDDEFAULT;
FGridY := GRIDDEFAULT;
FAllowSize := True;
FAllowMove := True;
GroupMovers := TList.Create;
Sizers := TList.Create;

OneMover := TMover.Create(Self);
CreateOneMover(OneMover, nil);

CreateSizers;
end;

destructor TResizer.Destroy;
begin
GroupMovers.Free;
Sizers.Free;
Sizers := nil;
inherited;
end;

procedure TResizer.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if csDestroying in ComponentState then exit;
if (AComponent = ResizeControl) and (Operation = opRemove) then
ResizeControl := nil;
end;

procedure TResizer.SetActive(b: boolean);
begin
if b<>FActive then begin
FActive := b;
CheckSizers;
end;
end;

procedure TResizer.SetControl(c: TControl);
begin
if c <> FControl then begin

if c<>nil then begin
if ResizeGroup<>nil then begin
Assert(c.Parent = ResizeGroup, 'ResizeControl is not in ResizeGroup!');
CurMover := FindMoverByBuddy(c);
end else begin
CurMover := OneMover;
CurMover.Buddy := c;
end;
CurMover.Show;
end;

FControl := c;
CheckSizers;
end;
end;

procedure TResizer.SetGroup(p: TWinControl);
begin
if p <> FGroup then begin
FGroup := p;
CreateGroupMovers;
end;
end;

procedure TResizer.CreateGroupMovers;
var
i : integer;
m : TMover;
c : TControl;
begin
if csDesigning in ComponentState then exit;

// Clear out the old Movers
for i := 0 to GroupMovers.Count-1 do
TObject(GroupMovers).Free;
GroupMovers.Clear;

if ResizeGroup <> nil then begin
for i := 0 to ResizeGroup.ControlCount-1 do begin
c := ResizeGroup.Controls;
if (c is TMover) or (c is TSizer) then continue;

m := TMover.Create(Self);
CreateOneMover(m, c);
GroupMovers.Add(m);
m.Show;
end;
end;
end;

procedure TResizer.CreateSizers;
var
i : integer;
p : TSizer;
begin
if csDesigning in ComponentState then exit;

for i := 0 to 7 do begin
p := TSizer.Create(Self);
Sizers.Add(p);

p.BevelOuter := bvNone;
p.Width := SIZE;
p.Height := SIZE;
p.Color := clBlack;
p.Caption := '';
p.Tag := i;
p.OnMouseDown := SizerDown;
p.OnMouseUp := SizerUp;
p.OnMouseMove := SizerMove;
p.TabStop := False;

case i of
0, 7 : p.Cursor := crSizeNWSE;
2, 5 : p.Cursor := crSizeNESW;
1, 6 : p.Cursor := crSizeNS;
3, 4 : p.Cursor := crSizeWE;
end;
end;
end;

procedure TResizer.CreateOneMover(m: TMover; c: TControl);
begin
m.OnMouseDown := MoverDown;
m.OnMouseUp := MoverUp;
m.OnMouseMove := MoverMove;
m.TabStop := True;
m.OnKeyDown := MoverKeyDown;
m.Buddy := c;
end;

procedure TResizer.CheckSizers;
begin
if (ResizeControl<>nil) and Active and (not (csDesigning in ComponentState)) then
ShowSizers
else
HideSizers;
end;

procedure TResizer.ShowSizers;
var
i : integer;
p : TPanel;
c : TControl;
begin
c := ResizeControl;
Assert(c <> nil);

for i := 0 to 7 do begin
p := TPanel(Sizers);
case i of
0, 1, 2 : p.Top := c.Top - HALFSIZE;
3, 4 : p.Top := c.Top + c.Height div 2 - HALFSIZE;
5, 6, 7 : p.Top := c.Top + c.Height - HALFSIZE;
end;

case i of
0, 3, 5 : p.Left := c.Left - HALFSIZE;
1, 6 : p.Left := c.Left + c.Width div 2 - HALFSIZE;
2, 4, 7 : p.Left := c.Left + c.Width - HALFSIZE;
end;
end;

Assert(CurMover<>nil);
CurMover.Show;

for i := 0 to Sizers.Count-1 do begin
p := TPanel(Sizers);
p.Parent := c.Parent;
p.Visible := True;
p.BringToFront;
end;

if CurMover.HandleAllocated and CurMover.CanFocus then
CurMover.SetFocus;
end;

procedure TResizer.HideSizers;
var
i : integer;
p : TPanel;
begin
for i := 0 to Sizers.Count-1 do begin
p := TPanel(Sizers);
p.Visible := False;
p.Update;
end;
OneMover.Visible := False;
end;

procedure TResizer.SizerDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Sizing := True;
DownX := X;
DownY := Y;
HideSizers;
ResizeControl.Parent.Update;
ResizeControl.Update;
OrigSize := ResizeControl.BoundsRect;
NewSize := OrigSize;
DrawSizeRect(NewSize);
end;

procedure DoSwap(DoSwap: boolean; var a, b: integer);
var
t : integer;
begin
if DoSwap then begin
t := a;
a := b;
b := t;
end;
end;

procedure TResizer.SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if NewSize.Right < NewSize.Left then
DoSwap(True, NewSize.Right, NewSize.Left);
if NewSize.Bottom < NewSize.Top then
DoSwap(True, NewSize.Bottom, NewSize.Top);

Sizing := False;
DrawSizeRect(NewSize);
ResizeControl.Invalidate;
ResizeControl.BoundsRect := NewSize;
ShowSizers;
if Assigned(OnSized) then OnSized(Self);
end;

procedure TResizer.SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Sizing then begin
DrawSizeRect(NewSize);

if AllowSize then begin
Calc_Size_Rect((Sender as TSizer).Tag, X - DownX, Y - DownY);
DoSizingEvent;
end;

DrawSizeRect(NewSize);
if HotTrack then ResizeControl.BoundsRect := NewSize;
end;
end;

procedure TResizer.DoSizingEvent;
var
tmpWid, tmpHgt : integer;
begin
tmpWid := NewSize.Right - NewSize.Left;
tmpHgt := NewSize.Bottom - NewSize.Top;
if Assigned(OnSizing) then
OnSizing(Self, NewSize.Left, NewSize.Top, tmpWid, tmpHgt);
NewSize.Right := NewSize.Left + tmpWid;
NewSize.Bottom := NewSize.Top + tmpHgt;
end;

procedure GetNonClientOffset(h: THandle; var nx, ny: integer);
var
p : TPoint;
R : TRect;
begin
p := Point(0, 0);
Windows.ClientToScreen(h, p);
Windows.GetWindowRect(h, R);
nx := p.x - R.Left;
ny := p.y - R.Top;
end;

procedure TResizer.DrawSizeRect(Rect: TRect);
var
h : THandle;
dc : THandle;
c : TCanvas;
nx, ny : integer;
OldPen : TPen;
OldBrush : TBrush;
begin
if HotTrack then exit;

h := (ResizeControl.Parent as TWinControl).Handle;
GetNonClientOffset(h, nx, ny);
dc := GetWindowDC(h);
try
c := TCanvas.Create;
c.Handle := dc;

OldPen := TPen.Create;
OldPen.Assign(c.Pen);
OldBrush := TBrush.Create;
OldBrush.Assign(c.Brush);

c.Pen.Width := 2;
c.Pen.Mode := pmXOR;
c.Pen.Color := clWhite;
c.Brush.Style := bsClear;
c.Rectangle(Rect.Left + nx, Rect.Top + ny, Rect.Right + nx, Rect.Bottom + ny);

c.Pen.Assign(OldPen);
OldPen.Free;
c.Brush.Assign(OldBrush);
OldBrush.Free;

c.Handle := 0;
c.Free;
finally
ReleaseDC(h, dc);
end;
end;

procedure TResizer.Calc_Size_Rect(SizerNum, dx, dy: integer);
begin
dx := (dx div GridX) * GridX;
dy := (dy div GridY) * GridY;

case SizerNum of
0, 1, 2 : NewSize.Top := OrigSize.Top + dy;
5, 6, 7 : NewSize.Bottom := OrigSize.Bottom + dy;
end;

case SizerNum of
0, 3, 5 : NewSize.Left := OrigSize.Left + dx;
2, 4, 7 : NewSize.Right := OrigSize.Right + dx;
end;

if KeepInParent then Constrain_Size;
end;

procedure TResizer.MoverDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
CurMover := Sender as TMover;
FControl := CurMover.Buddy;
Assert(FControl<>nil);
FControl.BringToFront;
CurMover.BringToFront;

Moving := True;
DownX := X;
DownY := Y;
HideSizers;
ResizeControl.Parent.Update;
ResizeControl.Update;
OrigSize := ResizeControl.BoundsRect;
NewSize := OrigSize;
DrawSizeRect(NewSize);
end;

procedure TResizer.MoverUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Moving := False;
ResizeControl.BoundsRect := NewSize;
CurMover.Invalidate;
ResizeControl.Refresh;
DrawSizeRect(NewSize);
ShowSizers;
if Assigned(OnMoved) then OnMoved(Self);
end;

procedure TResizer.Calc_Move_Rect(dx, dy: integer);
begin
NewSize := OrigSize;
dx := (dx div GridX) * GridX;
dy := (dy div GridY) * GridY;
OffsetRect(NewSize, dx, dy);
if KeepInParent then Constrain_Move;
end;

procedure TResizer.DoMovingEvent;
var
tmpWid, tmpHgt : integer;
begin
tmpWid := NewSize.Right - NewSize.Left;
tmpHgt := NewSize.Bottom - NewSize.Top;
if Assigned(OnMoving) then
OnMoving(Self, NewSize.Left, NewSize.Top);
NewSize.Right := NewSize.Left + tmpWid;
NewSize.Bottom := NewSize.Top + tmpHgt;
end;

procedure TResizer.MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
dx, dy: integer;
begin
if Moving then begin
DrawSizeRect(NewSize);

if AllowMove then begin
dx := X - DownX;
dy := Y - DownY;
Calc_Move_Rect(dx, dy);
DoMovingEvent;
end;

DrawSizeRect(NewSize);
if HotTrack then ResizeControl.BoundsRect := NewSize;
end;
end;

procedure TResizer.Constrain_Size;
var
p : TWinControl;
begin
p := ResizeControl.Parent;

with NewSize do begin
if Left < 0 then Left := 0;
if Top < 0 then Top := 0;
if Right > p.ClientWidth then Right := p.ClientWidth;
if Bottom > p.ClientHeight then Bottom := p.ClientHeight;

if Right < Left + GridX then Right := Left + GridX;
if Bottom < Top + GridY then Bottom := Top + GridY;
end;
end;

procedure TResizer.Constrain_Move;
begin
if NewSize.Left < 0 then
OffsetRect(NewSize, -NewSize.Left, 0);

if NewSize.Top < 0 then
OffsetRect(NewSize, 0, -NewSize.Top);

if NewSize.Right > ResizeControl.Parent.ClientWidth then
OffsetRect(NewSize, ResizeControl.Parent.ClientWidth - NewSize.Right, 0);

if NewSize.Bottom > ResizeControl.Parent.ClientHeight then
OffsetRect(NewSize, 0, ResizeControl.Parent.ClientHeight - NewSize.Bottom);
end;

procedure TResizer.MoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Active then begin
case Key of
VK_LEFT : DoSizeMove(Key, Shift, -GridX, 0);
VK_RIGHT : DoSizeMove(Key, Shift, GridX, 0);
VK_UP : DoSizeMove(Key, Shift, 0, -GridY);
VK_DOWN : DoSizeMove(Key, Shift, 0, GridY);
end;
end;
end;

procedure TResizer.DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer);
begin
if (ssCtrl in Shift) or (ssShift in Shift) then begin
Key := 0;

NewSize := ResizeControl.BoundsRect;

if (ssCtrl in Shift) and AllowMove then begin
OffsetRect(NewSize, dx, dy);
if KeepInParent then Constrain_Move;
DoMovingEvent;
end;

if (ssShift in Shift) and AllowSize then begin
NewSize.Right := NewSize.Right + dx;
NewSize.Bottom := NewSize.Bottom + dy;
if KeepInParent then Constrain_Size;
DoSizingEvent;
end;

ResizeControl.BoundsRect := NewSize;
ShowSizers;
end;
end;

function TResizer.FindMoverByBuddy(c: TControl): TMover;
var
i : integer;
begin
Result := nil;
for i := 0 to GroupMovers.Count-1 do
if TMover(GroupMovers).Buddy = c then
Result := GroupMovers;
Assert(Result <> nil);
end;

end.

这个控件装上去，就能设置控件在程序运行时随意拖动，就象设计时一样，边上还有四个小点

1.在label的OnMouseDown中写label1.BeginDrag(false);
2.在TForm1 OnDragOver中写if Source is TLabel
Accept=true;
3.在Form1的OnDrawDrop中写
Label1.left=x;
Label1.top=y;
如果是Panel或Button,可以用Perform()
void __fastcall TForm1:anel1MouseDown(TObject *Sender,
TMouseButton Button, TShiftState Shift, int X, int Y)
{
int SC_DragMove=0xF012;
ReleaseCapture();
Panel1->Perform(WM_SYSCOMMAND,SC_DragMove,0);
}

StretchHandle 在实际使用时，也有问题， 拖动一个控件会将其他不希望被移动的控件也一同拖走。

yostgxf, 在下先行谢过了！

接受答案了.

StretchHandle 控件源代码：

unit Handles;

{ TStretchHandles is a transparent control to implement runtime grab handles
for Forms Designer-like projects. It paints the handles on its own canvas,
maintains a list of the controls it is supposed to manage, and traps mouse
and keyboard events to move/resize itself and its child controls. See the
accompanying README file for more information.

Distributed by the author as freeware, please do not sell.

Anthony Scott
CIS: 75567,3547 }

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Menus, StdCtrls, Dialogs;
{ miscellaneous type declarations }
type
TDragStyle = (dsMove, dsSizeTopLeft, dsSizeTopRight, dsSizeBottomLeft,
dsSizeBottomRight, dsSizeTop, dsSizeLeft, dsSizeBottom,
dsSizeRight);
TForwardMessage = (fmMouseDown, fmMouseUp);
GridValues = 1..32;
EBadChild = class(Exception);


{ TStretchHandle component declaration }

type
TStretchHandle = class(TCustomControl)
private
FDragOffset: TPoint;
FDragStyle: TDragStyle;
FDragging: boolean;
FDragRect: TRect;
FLocked: boolean;
FPrimaryColor: TColor;
FSecondaryColor: TColor;
FGridX, FGridY: GridValues;
FChildList: TList;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
procedure Rubberband(XPos, YPos: integer; ShowBox: boolean);
procedure ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SetPrimaryColor(Color: TColor);
procedure SetSecondaryColor(Color: TColor);
procedure SetGridState(Value: boolean);
function GetGridState: boolean;
function GetChildCount: integer;
function GetChildControl(idx: integer): TControl;
function GetModifiedRect(XPos, YPos: integer): TRect;
function PointOverChild(P: TPoint): boolean;
function XGridAdjust(X: integer): integer;
function YGridAdjust(Y: integer): integer;
function IsAttached: boolean;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure KeyDown(var key: Word; Shift: TShiftState); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
property Canvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Attach(ChildControl: TControl);
procedure Detach;
procedure ReleaseChild(ChildControl: TControl);
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure BringToFront;
procedure SendToBack;
procedure SetColors(Color1, Color2: TColor);
function IndexOf(ChildControl: TControl): integer;
{ new run-time only properties }
property Attached: boolean read IsAttached;
property ChildCount: integer read GetChildCount;
property Children[idx: integer]: TControl read GetChildControl;
published
{ new properties }
property Color: TColor read FPrimaryColor write SetPrimaryColor default clBlack;
property SecondaryColor: TColor read FSecondaryColor write SetSecondaryColor default clGray;
property Locked: boolean read FLocked write FLocked default False;
property GridX: GridValues read FGridX write FGridX default 8;
property GridY: GridValues read FGridY write FGridY default 8;
property SnapToGrid: boolean read GetGridState write SetGridState default False;
{ inherited properties }
property DragCursor;
property Enabled;
property Hint;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
{ defined events }
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnKeyDown;
property OnKeyUp;
property OnKeyPress;
end;

procedure Register;
function MinInt(a, b: integer): integer;
function MaxInt(a, b: integer): integer;

implementation

procedure Register;
begin
{ add the component to the 'Samples' tab }
RegisterComponents('Samples', [TStretchHandle]);
end;

constructor TStretchHandle.Create(AOwner: TComponent);
begin

inherited Create(AOwner);
{ create storage for child objects }
FChildList := TList.Create;
{ initialize default properties }
Width := 24;
Height := 24;
FPrimaryColor := clBlack;
FSecondaryColor := clGray;
{ a value of 1 is used to effectively disable the snap-to grid }
FGridX := 1;
FGridY := 1;
{ doesn't do anything until it is Attached to something else }
Enabled := False;
Visible := False;

end;

destructor TStretchHandle.Destroy;
begin
{ tidy up carefully }
FChildList.Free;
inherited Destroy;

end;

procedure TStretchHandle.CreateParams(var Params: TCreateParams);
begin
{ set default Params values }
inherited CreateParams(Params);
{ then add transparency; ensures correct repaint order }
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;

end;

procedure TStretchHandle.WMGetDLGCode(var Message: TMessage);
begin
{ get arrow key press events }
Message.Result := DLGC_WANTARROWS;

end;

procedure TStretchHandle.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
{ completely fake erase, don't call inherited, don't collect $200 }
Message.Result := 1;

end;

procedure TStretchHandle.Attach(ChildControl: TControl); //绑定
var
L, T, W, H: integer;
begin
{ definitely not allowed! }
if ChildControl is TForm then
raise EBadChild.Create('Handles can not be attached to a Form!');
{ add child component to unique list managed by TStretchHandle }
if (ChildControl <> nil) and (FChildList.IndexOf(TObject(ChildControl)) = -1) then
begin
{ make sure new child's Parent matches siblings }
if (FChildList.Count > 0) and (ChildControl.Parent <> Parent) then
Detach; //松绑
{ initialize when first child is attached }
if FChildList.Count = 0 then
begin
Parent := ChildControl.Parent;
{ only make it visible now, to avoid color flashing, & accept events }
FDragRect := Rect(0, 0, 0, 0);
Enabled := True;
Visible := True;

inherited SetBounds(ChildControl.Left - 2, ChildControl.Top - 2, ChildControl.Width + 5, ChildControl.Height + 5);

end
else
begin
{ set size to bound all children, plus room for handles }
L := MinInt(Left, ChildControl.Left - 2);
T := MinInt(Top, ChildControl.Top - 2);
W := Maxint(Left + Width - 3, ChildControl.Left + ChildControl.Width) - L + 3;
H := Maxint(Top + Height - 3, ChildControl.Top + ChildControl.Height) - T + 3;
inherited SetBounds(L, T, W, H);

end;
{ add to list of active Children }
FChildList.Add(TObject(ChildControl));
{ re-set DragStyle }
FDragStyle := dsMove;
{ use old BringToFront so as not to change Child's Z-order }
if not (csDesigning in ComponentState) then
begin
inherited BringToFront;
{ allow us to get Mouse events immediately! }
SetCapture(Handle);
{ get keyboard events }
if Visible and Enabled then
SetFocus;
end;

end;

end;

procedure TStretchHandle.Detach;
begin
{ remove all Child components from list }
if FChildList.Count > 0 then
with FChildList do
repeat
Delete(0);
until Count = 0;
{ disable & hide StretchHandle }
FLocked := False;
Width := 24;
Height := 24;
Enabled := False;
Visible := False;
Parent := nil;
FDragRect := Rect(0, 0, 0, 0);

end;

procedure TStretchHandle.ReleaseChild(ChildControl: TControl);
var
idx, L, T, W, H: integer;
AControl: TControl;
begin
{ delete the Child if it exists in the list }
idx := FChildList.IndexOf(TObject(ChildControl));
if (ChildControl <> nil) and (idx >= 0) then
FChildList.Delete(idx);
{ disable & hide StretchHandle if no more children }
if FChildList.Count = 0 then
begin
FLocked := False;
Enabled := False;
Visible := False;
Parent := nil;
FDragRect := Rect(0, 0, 0, 0);
end
else
begin
{ set size to bound remaining children, plus room for handles }
L := TControl(FChildList.Items[0]).Left - 2;
T := TControl(FChildList.Items[0]).Top - 2;
W := TControl(FChildList.Items[0]).Width + 3;
H := TControl(FChildList.Items[0]).Height + 3;

for idx := 0 to FChildList.Count - 1 do
begin
AControl := TControl(FChildList.Items[idx]);
L := MinInt(L, AControl.Left - 2);
T := MinInt(T, AControl.Top - 2);
W := Maxint(L + W - 3, AControl.Left + AControl.Width) - L + 3;
H := Maxint(T + H - 3, AControl.Top + AControl.Height) - T + 3;
end;

inherited SetBounds(L, T, W, H);

end;

end;

function TStretchHandle.IndexOf(ChildControl: TControl): integer;
begin
{ simply pass on the result... }
Result := FChildList.IndexOf(TObject(ChildControl));

end;

procedure TStretchHandle.BringToFront;
var
i: integer;
begin
{ do nothing if not Attached }
if Attached and not Locked then
begin
{ take care of Children first, in Attach order }
for i := 0 to FChildList.Count - 1 do
begin
TControl(FChildList).BringToFront;
end;
{ make sure keyboard focus is restored }
inherited BringToFront;
if Visible and Enabled then
SetFocus;
end;

end;

procedure TStretchHandle.SendToBack;
var
i: integer;
begin
{ do nothing if not Attached }
if Attached and not Locked then
begin
{ take care of Children first, in Attach order }
for i := 0 to FChildList.Count - 1 do
begin
TControl(FChildList).SendToBack;
end;
{ Handles stay in front of everything, always }
inherited BringToFront;
if Visible and Enabled then
SetFocus;
end;

end;

procedure TStretchHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{ only process MouseDown if it is over a Child, else forward }
if PointOverChild(Point(Left + X, Top + Y)) then
begin
if (Button = mbLeft) and not FLocked then
begin
FDragOffset := Point(X, Y);
FDragging := True;
end;
inherited MouseDown(Button, Shift, X, Y);
end
else
begin
Cursor := crDefault;
SetCursor(Screen.Cursors[Cursor]);
ForwardMessage(fmMouseDown, Button, Shift, Left + X, Top + Y);
end;

end;

procedure TStretchHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
ARect: TRect;
begin
{ resize, reposition if anything changed }
if FDragging and (Button = mbLeft) then
begin
{ disallow drop off Parent }
if (Left + X) < 0 then
X := -Left;
if (Top + Y) < 0 then
Y := -Top;
if (Left + X) > Parent.Width then
X := Parent.Width - Left;
if (Top + Y) > Parent.Height then
Y := Parent.Height - Top;
{ force Paint when size doesn't change but position does }
if (X <> FDragOffset.X) or (Y <> FDragOffset.Y) then
begin
Invalidate;
ARect := GetModifiedRect(X, Y);
SetBounds(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
{ clear drag outline }
RubberBand(0, 0, False);
{ seem to need this for keyboard events }
if Visible and Enabled then
SetFocus;

FDragging := False;
Cursor := crDefault;
ReleaseCapture;
{ perform default processing }
inherited MouseUp(Button, Shift, X, Y);

end
else
ForwardMessage(fmMouseUp, Button, Shift, Left + X, Top + Y);

end;

procedure TStretchHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ARect: TRect;
DragStyle: TDragStyle;
begin
{ this may be a move immediately on Attach instead of MouseDown }
if (ssLeft in Shift) and not FDragging and not FLocked then
begin
FDragOffset := Point(X, Y);
FDragging := True;
end
{ only recognize move after simulated MouseDown }
else
begin
{ let's not hog mouse events unnecessarily }
if not (ssLeft in Shift) then
ReleaseCapture;
{ default to drag cursor only when dragging }
DragStyle := dsMove;
Cursor := crDefault;
{ disallow resize if multiple children }
if FChildList.Count = 1 then
begin

ARect := GetClientRect;
{ so I don't like long nested if statements... }
if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Top) < 5)) then
begin
DragStyle := dsSizeTopLeft;
Cursor := crSizeNWSE;
end;

if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
begin
DragStyle := dsSizeBottomRight;
Cursor := crSizeNWSE;
end;

if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Top) < 5)) then
begin
DragStyle := dsSizeTopRight;
Cursor := crSizeNESW;
end;

if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
begin
DragStyle := dsSizeBottomLeft;
Cursor := crSizeNESW;
end;

if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Top) < 5)) then
begin
DragStyle := dsSizeTop;
Cursor := crSizeNS;
end;

if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Bottom) < 5)) then
begin
DragStyle := dsSizeBottom;
Cursor := crSizeNS;
end;

if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Left) < 5)) then
begin
DragStyle := dsSizeLeft;
Cursor := crSizeWE;
end;

if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Right) < 5)) then
begin
DragStyle := dsSizeRight;
Cursor := crSizeWE;
end;

end;
{ if position-locked, override cursor change }
if FLocked then
Cursor := crNoDrop;

if FDragging then
begin
{ disallow drag off Parent }
if (Left + X) < 0 then
X := -Left;
if (Top + Y) < 0 then
Y := -Top;
if (Left + X) > Parent.Width then
X := Parent.Width - Left;
if (Top + Y) > Parent.Height then
Y := Parent.Height - Top;
{ display cursor & drag outline }
if FDragStyle = dsMove then
Cursor := DragCursor;
SetCursor(Screen.Cursors[Cursor]);
RubberBand(X, Y, True);

end
else
FDragStyle := DragStyle;

end;
{ perform default processing }
inherited MouseMove(Shift, X, Y);

end;

procedure TStretchHandle.ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: integer;
Found: boolean;
Msg: Word;
ARect: TRect;
AControl: TControl;
AMessage: TMessage;
begin
{ construct the message to be sent }
case FwdMsg of
fmMouseDown:
case Button of
mbLeft:
Msg := WM_LBUTTONDOWN;
mbMiddle:
Msg := WM_MBUTTONDOWN;
mbRight:
Msg := WM_RBUTTONDOWN;
end;
fmMouseUp:
case Button of
mbLeft:
Msg := WM_LBUTTONUP;
mbMiddle:
Msg := WM_MBUTTONUP;
mbRight:
Msg := WM_RBUTTONUP;
end;
end;

AMessage.WParam := 0;
{ determine whether X, Y is over any other windowed control }
Found := False;
for i := 0 to Parent.ControlCount - 1 do
begin
AControl := TControl(Parent.Controls);
if (AControl is TWinControl) and not (AControl is TStretchHandle) then
begin
ARect := Rect(AControl.Left,
AControl.Top,
AControl.Left + AControl.Width,
AControl.Top + AControl.Height);
{ X, Y are relative to Parent }
if PtInRect(ARect, Point(X, Y)) then
begin
Found := True;
break;
end;
end;
end;
{ forward the message to the control if found, else to the Parent }
if Found then
begin
AMessage.LParamLo := X - AControl.Left;
AMessage.LParamHi := Y - AControl.Top;
SendMessage(TWinControl(AControl).Handle, Msg, AMessage.WParam, AMessage.LParam);
end
else
begin
AMessage.LParamLo := X;
AMessage.LParamHi := Y;
SendMessage(Parent.Handle, Msg, AMessage.WParam, AMessage.LParam);
end;

end;

procedure TStretchHandle.KeyDown(var Key: Word; Shift: TShiftState);
begin
{ process arrow keys to move/resize Handles & Child, also move siblings }
case Key of
VK_UP:
begin
Invalidate;
SetBounds(Left, Top - 1, Width, Height);
end;
VK_DOWN:
begin
Invalidate;
SetBounds(Left, Top + 1, Width, Height);
end;
VK_LEFT:
begin
Invalidate;
SetBounds(Left - 1, Top, Width, Height);
end;
VK_RIGHT:
begin
Invalidate;
SetBounds(Left + 1, Top, Width, Height);
end;
end;

inherited KeyDown(Key, Shift);

end;

function TStretchHandle.GetModifiedRect(XPos, YPos: integer): TRect;
var
ARect: TRect;
begin
{ compute new position/size, depending on FDragStyle}
case FDragStyle of

dsSizeTopLeft:
begin
ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
ARect.Right := Width - (ARect.Left - Left);
ARect.Bottom := Height - (ARect.Top - Top);
end;

dsSizeTopRight:
begin
ARect.Left := Left;
ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
ARect.Bottom := Height - (ARect.Top - Top);
end;

dsSizeBottomLeft:
begin
ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
ARect.Top := Top;
ARect.Right := Width - (ARect.Left - Left);
ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
end;

dsSizeBottomRight:
begin
ARect.Left := Left;
ARect.Top := Top;
ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
end;

dsSizeTop:
begin
ARect.Left := Left;
ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
ARect.Right := Width;
ARect.Bottom := Height - (ARect.Top - Top);
end;

dsSizeBottom:
begin
ARect.Left := Left;
ARect.Top := Top;
ARect.Right := Width;
ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
end;

dsSizeLeft:
begin
ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
ARect.Top := Top;
ARect.Right := Width - (ARect.Left - Left);
ARect.Bottom := Height;
end;

dsSizeRight:
begin
ARect.Left := Left;
ARect.Top := Top;
ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
ARect.Bottom := Height;
end;

else
{ keep size, move to new position }
ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
ARect.Right := Width;
ARect.Bottom := Height;

end;
{ impose a minimum size for sanity }
if ARect.Right < 5 then
ARect.Right := 5;
if ARect.Bottom < 5 then
ARect.Bottom := 5;

Result := ARect;

end;

procedure TStretchHandle.Rubberband(XPos, YPos: integer; ShowBox: boolean);
var
NewRect: TRect;
PtA, PtB: TPoint;
ScreenDC: HDC;
begin
{ outline is drawn over all windows }
ScreenDC := GetDC(0);
{ erase previous rectangle, if any, & adjust for handle's position }
if (FDragRect.Left <> 0) or (FDragRect.Top <> 0) or (FDragRect.Right <> 0) or (FDragRect.Bottom <> 0) then
begin
PtA := Parent.ClientToScreen(Point(FDragRect.Left + 2, FDragRect.Top + 2));
PtB := Parent.ClientToScreen(Point(FDragRect.Left + FDragRect.Right - 3, FDragRect.Top + FDragRect.Bottom - 3));
DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
FDragRect := Rect(0, 0, 0, 0);
end;
{ draw new rectangle unless this is a final erase }
if ShowBox then
begin
NewRect := GetModifiedRect(XPos, YPos);
PtA := Parent.ClientToScreen(Point(NewRect.Left + 2, NewRect.Top + 2));
PtB := Parent.ClientToScreen(Point(NewRect.Left + NewRect.Right - 3, NewRect.Top + NewRect.Bottom - 3));
DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
FDragRect := NewRect;
end
else
begin
Parent.Repaint;
Repaint;
end;

ReleaseDC(0, ScreenDC);

end;

procedure TStretchHandle.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
WasVisible: boolean;
i: integer;
AControl: TControl;
begin
{ hide & preserve fixed size in design mode }
WasVisible := Visible;
if csDesigning in ComponentState then
begin
Visible := False;
inherited SetBounds(ALeft, ATop, 24, 24);
end
else { move child also, if any (but only if not locked) }
if not FLocked then
begin
for i := 0 to FChildList.Count - 1 do
begin
AControl := FChildList;
AControl.SetBounds(AControl.Left - Left + ALeft,
AControl.Top - Top + ATop,
AControl.Width - Width + AWidth,
AControl.Height - Height + AHeight);
end;
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;
{ restore visibility }
if Visible = False then
Visible := WasVisible;

end;

procedure TStretchHandle.Paint;
var
AControl: TControl;
ARect, BoxRect: TRect;
i: integer;
begin

inherited Paint;
{ do it differently at design time... }
if csDesigning in ComponentState then
begin
Canvas.Brush.Color := FPrimaryColor;
BoxRect := Rect(0, 0, 5, 5);
Canvas.FillRect(BoxRect);
BoxRect := Rect(19, 0, 24, 5);
Canvas.FillRect(BoxRect);
BoxRect := Rect(19, 19, 24, 24);
Canvas.FillRect(BoxRect);
BoxRect := Rect(0, 19, 5, 24);
Canvas.FillRect(BoxRect);
end
else
begin
{ set color to primary if only one child, else secondary }
if FChildList.Count = 1 then
Canvas.Brush.Color := FPrimaryColor
else
Canvas.Brush.Color := FSecondaryColor;
{ draw resize handles for each child }
for i := 0 to FChildList.Count - 1 do
begin

AControl := TControl(FChildList.Items);
ARect := Rect(AControl.Left - Left - 2,
AControl.Top - Top - 2,
AControl.Left - Left + AControl.Width + 2,
AControl.Top - Top + AControl.Height + 2);

with Canvas do
begin
{ draw corner boxes (assuming Canvas is minimum 5x5) }
BoxRect := Rect(ARect.Left, ARect.Top, ARect.Left + 5, ARect.Top + 5);
FillRect(BoxRect);
BoxRect := Rect(ARect.Right - 5, ARect.Top, ARect.Right, ARect.Top + 5);
FillRect(BoxRect);
BoxRect := Rect(ARect.Right - 5, ARect.Bottom - 5, ARect.Right, ARect.Bottom);
FillRect(BoxRect);
BoxRect := Rect(ARect.Left, ARect.Bottom - 5, ARect.Left + 5, ARect.Bottom);
FillRect(BoxRect);
{ only for single Children, draw center boxes }
if FChildList.Count = 1 then
begin
BoxRect := Rect(ARect.Left + trunc((ARect.Right - ARect.Left) / 2) - 2,
ARect.Top,
ARect.Left + trunc((ARect.Right - ARect.Left) / 2) + 3,
ARect.Top + 5);
FillRect(BoxRect);
BoxRect := Rect(ARect.Left + trunc((ARect.Right - ARect.Left) / 2) - 2,
ARect.Bottom - 5,
ARect.Left + trunc((ARect.Right - ARect.Left) / 2) + 3,
ARect.Bottom);
FillRect(BoxRect);
BoxRect := Rect(ARect.Left,
ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) - 2,
ARect.Left + 5,
ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) + 3);
FillRect(BoxRect);
BoxRect := Rect(ARect.Right - 5,
ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) - 2,
ARect.Right,
ARect.Top + trunc((ARect.Bottom - ARect.Top) / 2) + 3);
FillRect(BoxRect);
end;

end;

end;

end;

end;

procedure TStretchHandle.SetPrimaryColor(Color: TColor);
begin
{ set single select color, repaint immediately }
FPrimaryColor := Color;
Repaint;

end;

procedure TStretchHandle.SetSecondaryColor(Color: TColor);
begin
{ set multiple select color, repaint immediately }
FSecondaryColor := Color;
Repaint;

end;

procedure TStretchHandle.SetColors(Color1, Color2: TColor);
begin
{ set single/multiple select colors, repaint }
FPrimaryColor := Color1;
FSecondaryColor := Color2;
Repaint;

end;

procedure TStretchHandle.SetGridState(Value: boolean);
begin
{ a value of 1 effectively disables a grid axis }
if Value then
begin
FGridX := 8;
FGridY := 8;
end
else
begin
FGridX := 1;
FGridY := 1;
end;

end;

function TStretchHandle.GetGridState: boolean;
begin

if (FGridX > 1) or (FGridY > 1) then
Result := True
else
Result := False;

end;

function TStretchHandle.GetChildCount: integer;
begin
Result := FChildList.Count;
end;

function TStretchHandle.GetChildControl(idx: integer): TControl;
begin

if (FChildList.Count > 0) and (idx >= 0) then
Result := FChildList[idx]
else
Result := nil;

end;

function TStretchHandle.IsAttached: boolean;
begin

if FChildList.Count > 0 then
Result := True
else
Result := False;

end;

function TStretchHandle.PointOverChild(P: TPoint): boolean;
var
i: integer;
ARect: TRect;
AControl: TControl;
begin
{ determine whether X, Y is over any child (for dragging) }
Result := False;
for i := 0 to FChildList.Count - 1 do
begin
AControl := TControl(FChildList);
ARect := Rect(AControl.Left - 2,
AControl.Top - 2,
AControl.Left + AControl.Width + 2,
AControl.Top + AControl.Height + 2);
{ P is relative to the Parent }
if PtInRect(ARect, P) then
begin
Result := True;
break;
end;
end;

end;

function TStretchHandle.XGridAdjust(X: integer): integer;
begin
Result := (X DIV FGridX) * FGridX;
end;

function TStretchHandle.YGridAdjust(Y: integer): integer;
begin
Result := (Y DIV FGridY) * FGridY;
end;

function MinInt(a, b: integer): integer;
begin
if a < b then
Result := a
else
Result := b;
end;

function MaxInt(a, b: integer): integer;
begin
if a > b then
Result := a
else
Result := b;
end;

end.

我有现成的。
zhy19806@hotmail.com