如何在程序中像Delphi设计阶段那样在一个控件周围加上一个有8个点的框,并能拖动控件的大小，多谢各位了，帮帮小弟吧！

[redcoral]

如何在程序中像Delphi设计阶段那样在一个控件周围加上一个有8个点的框,并能拖动控件的大小，多谢各位了，帮帮小弟吧！我想在一个报表中增加设计功能。

[lastshrill]

关注！！！！！！！！！！！！！！

[rh]

八个点自己画
对于拖动……请看如下代码：
试试这段代码
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012;
begin ReleaseCapture;
panel1.perform(WM_SysCommand, SC_DragMove, 0);
end;

[rh]

哦！我错了，我给你代码是拖动控件的位置的：）
拖动大小很简单啊
在MouseDown里响应事件判断鼠标光标是否处于控件边缘
是的话设置width和height属性的值就好了

[rh]

哦！我错了，我给你代码是拖动控件的位置的：）
拖动大小很简单啊
在MouseDown里响应事件判断鼠标光标是否处于控件边缘
是的话设置width和height属性的值就好了

[redcoral]

TO:rh(全民动员齐为战，教它东洋举国悲！)　说详细点行吗？

[coldljy]

这是程序员大本营光盘上的。

Contributor: DAVID STIDOLPH

{
The following is a unit I wrote yesterday. I am uploading it because it is a
failed component - failed because it ultimately could not do what I needed.
What I needed were resizeable bloxes (hotspots if you will) over a graphic.
I created a component and setup 8 boxes at the perimeter for resizing and
developed the code for the control to be moved (by clicking and holding
while moving inside the control) or resized (at one of the 8 resize blocks
around the edge). The failure was that after I got all this working I could
not find a way to make the window transparent or automatically copy the area
underneath to its canvas. I had to have a transparent hotspot - not one
pushbutton grey!

Anyway, when the user presses the mouse button down I take the X,Y, make it
a point and do ClientToScreen on it - I also store the location of the
control in parent coordinates. Later, when I get the OnMouseMove call, I
take the new X,Y position, convert it to screen coordinates and take the
difference of the original mouse X,Y to the new mouse X,Y and apply that to
the original window X,Y.

I am redoing this control as a descendant of TPaintBox so it can have the
graphic and handling the hotspots as a TList instead of individual windows.
Easier on resources as well.
}
unit Hotspot;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;

type
THotspot = class(TCustomControl)
private
{ Private declarations }
xDown: Integer;
yDown: Integer;
ptDown: TPoint;
dragging: Integer;
wDrag: Integer;
rcDown: TRect;
rcDrag: Array [0..7] of TRect;
rcCursor: Array [0..7] of TCursor;

protected
{ Protected declarations }
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;

procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure Paint; override;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);

published
{ Published declarations }
end;

procedure Register;

implementation

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

constructor THotspot.Create(AOwner: TComponent);
var
win: Longint;
begin
inherited Create(AOwner);
Canvas.Brush.Style := bsClear;
dragging := -1;
wDrag := 5;

OnMouseMove := MouseMove;
OnMouseDown := MouseDown;
OnMouseUp := MouseUp;
ParentColor := True;

rcCursor[0] := crSizeNWSE;
rcCursor[1] := crSizeNS;
rcCursor[2] := crSizeNESW;
rcCursor[3] := crSizeWE;
rcCursor[4] := crSizeNWSE;
rcCursor[5] := crSizeNS;
rcCursor[6] := crSizeNESW;
rcCursor[7] := crSizeWE;
end;

procedure THotspot.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
r,b,r2,b2: Integer;
wDrag2: Integer;
begin
r := AWidth;
b := AHeight;
r2:= r div 2;
b2 := b div 2;
wDrag2 := wDrag div 2;

rcDrag[0] := Rect(0,0,wDrag,wDrag);
rcDrag[1] := Rect(r2-wDrag2,0,r2+wDrag2,wDrag);
rcDrag[2] := Rect(r-wDrag+1,0,r,wDrag);
rcDrag[3] := Rect(r-wDrag+1,b2-wDrag2,r,b2+wDrag2);
rcDrag[4] := Rect(r-wDrag+1,b-wDrag,r,b);
rcDrag[5] := Rect(r2-wDrag2,b-wDrag,r2+wDrag2,b);
rcDrag[6] := Rect(0,b-wDrag,wDrag,b);
rcDrag[7] := Rect(0,b2-wDrag2,wDrag,b2+wDrag2);

inherited SetBounds(ALeft,ATop,AWidth,AHeight);
end;

procedure THotspot.Paint;
var
rc: TRect;
i,w: Integer;
begin
with Canvas do begin
Pen.Style := psDot;
if dragging = -1 then
Pen.Color := clBlack
else
Pen.Color := clWhite;
rc := GetClientRect;
w := wDrag div 2;
Rectangle(w,w,rc.right-w,rc.bottom-w);

Brush.Style := bsSolid;
Brush.Color := Pen.Color;
Pen.Style := psSolid;
for i := 0 to 7 do
Rectangle(rcDrag[i].Left,rcDrag[i].Top,rcDrag[i].Right,rcDrag[i].Bottom);
Brush.Style := bsClear;
end;
end;

procedure THotspot.MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
var
i: Integer;
pt: TPoint;
xDif,yDif: Integer;

procedure SetW(leftOff,topOff,rightOff,bottomOff: Integer);
var
rc: TRect;
begin
rc := rcDown;
Inc(rc.Left,leftOff);
Inc(rc.Top,topOff);
Inc(rc.Right,rightOff);
Inc(rc.Bottom,bottomOff);
SetBounds(rc.Left,rc.Top,rc.Right-rc.Left+1,rc.Bottom-rc.Top+1);
end;

begin
pt := ClientToScreen(Point(X,Y));
xDif := pt.X - ptDown.X;
yDif := pt.Y - ptDown.Y;
if ssLeft in Shift then
case dragging of
-1: SetBounds(left + (X-xDown),top + (Y-yDown),width,height);
0: SetW(xDif,yDif,0,0);
1: SetW(0,yDif,0,0);
2: SetW(0,yDif,xDif,0);
3: SetW(0,0,xDif,0);
4: SetW(0,0,xDif,yDif);
5: SetW(0,0,0,yDif);
6: SetW(xDif,0,0,yDif);
7: SetW(xDif,0,0,0);
end
else begin
pt := Point(X,Y);
Cursor := crArrow;
for i := 0 to 7 do
if PtInRect(rcDrag[i],pt) then
Cursor := rcCursor[i];
end;
end;

procedure THotspot.MouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
var
i: Integer;
pt: TPoint;
begin
pt := Point(X,Y);
ptDown := ClientToScreen(pt);
xDown := X;
yDown := Y;
rcDown := Rect(left,top,left+Width,top+Height);
dragging := -1;
for i := 0 to 7 do
if PtInRect(rcDrag[i],pt) then
dragging := i;
if dragging <> -1 then
Cursor := rcCursor[i]
else if Cursor <> crArrow then
Cursor := crArrow;
Paint;
end;

procedure THotspot.MouseUp(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Integer);
begin
dragging := -1;
Paint;
end;

end.