这个你看看吧
在运行时可用dxfDesigner控件,在www.51delphi.com或www.playicq.com中有下载.
dxforumlibrary;
//////////////////////////////////////////////////////////////////////////////////////
constructor TSizerControl.myCreate(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.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;
procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
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 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.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 Register;
begin
RegisterNoicon([TSizerControl]);
end;