如何使画的矩形被点击后周围出现8个小方块用来缩放图形?(100分)

如题

我作过，当使用的是8个小panel，设成黑的，并且鼠标设成对应的形状
其实实现后，也不是太复杂

大概自己画上去

我记得，以前Huizhang 写了一个Tline控件有类似的效果，

你可以参考一下（查询以前的讨论）

一切的一切都是通过画上去，一切的一切都可以通过画上去来实现。

我是自己硬画的

有一个resize控件能满足你的要求

计算各点的位置RECT（大小自定），合并成RGN，用INVERTRGN反色即可

那8个方块应该是对象,我把它们继承自TGraphicControl类,但是我在主form中create了8个方块并存在链表中后,再想传一些参数改变它们的位置什么
的就不行了...
请教!

to lha
有这样的控件吗？就像一个可以随便拉大和缩小、而且改变线条的弯曲程度的线条控件吗？ 就像流程图中的二个节点直接
的连线那个控件，是怎么作的？

我也想知道答案,许多程序中都要设计这个东东

应该是在canvas上然后改变其画笔颜色，使用Rectangle绘制小方块比较合理
使用Tpanel或者从TGranphicControl继承，资源占用上不是很合理
如果要绘制400点的曲线被选中的情况那怎么办呢？

首先，你这个矩形应该是一个控件，可以直接从TCustomControl中继承下来，
重写其Paint方法即可。还需要一个AttachSizer方法如下：
procedure AttachSizer(Sender: TObject);
begin
TSizer.Create(FOwner, Sender as TCustomControl, FDefaultWidth, FDefaultHeight);
end;
其次，如下写一个TSizer控件，这是一个透明包含控件，在选定矩形控件后，
调用其AttachSizer方法动态创建TSizer控件。
声明如下：
const
sc_DragMove: LongInt = $F012;

type
TSizer = class(TCustomControl)
private
FControl: TCustomControl;
FRectList: array[1..8] of TRect;
FPosList: array[1..8] of Integer;
public
constructor Create(AOwner: TComponent; AControl: TCustomControl);
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 SizerControlExit(Sender: TObject);
end;
实现如下：
constructor TSizer.Create(AOwner: TComponent; AControl: TCustomControl);
var
R: TRect;
begin
inherited Create(AOwner);
FControl := AControl;
//制定OnExit事件的处理程序
OnExit := SizerControlExit;
//设置大小和位置
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 TSizer.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle + ws_ex_Transparent;
end;

procedure TSizer.CreateHandle;
begin
inherited CreateHandle;
SetFocus;
end;

procedure TSizer.SizerControlExit(Sender: TObject);
begin
Free;
end;

procedure TSizer.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 TSizer.Paint;
var
i: integer;
begin
Canvas.Brush.Color := clBlack;
for i := 1 to 8 do
Canvas.Rectangle(FRectList.Left, FRectList.Top, FRectList.Right, FRectList.Bottom);
end;

procedure TSizer.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 TSizer.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//传递一个消息
Perform(wm_SysCommand, sc_DragMove, 0);
end;

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

tanglu真是高人
但有一个疑问,象在Word中画各种图形(例如一条直线),也是采用类似技术吗

hi all
这是一个工作流程编辑器中用到的,现在拖动和缩放都可以了,就是这两个问题没能解决,请教各位了!
现在请教从TGraphicControl继承的对象在FORM中拖动时产生的闪烁和2个这样的对象被拖到重叠时留下的痕迹如何消除
搞定一定给分,还会追加!

这个问题我已经搞定了,请大家再看看新问题...

下面是3个单元的code
大家看完后帮忙想想新问题吧!
MainForm


interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,Menus, ToolWin, ComCtrls, Buttons;

type
Tf_wfe = class(TForm)
ToolBar1: TToolBar;
MainMenu: TMainMenu;
FileMenu: TMenuItem;
FileNewItem: TMenuItem;
FileOpenItem: TMenuItem;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
N1: TMenuItem;
FilePrintItem: TMenuItem;
FilePrintSetupItem: TMenuItem;
N4: TMenuItem;
FileExitItem: TMenuItem;
EditMenu: TMenuItem;
EditUndoItem: TMenuItem;
N2: TMenuItem;
EditCutItem: TMenuItem;
EditCopyItem: TMenuItem;
EditPasteItem: TMenuItem;
Object1: TMenuItem;
StartNode1: TMenuItem;
N5: TMenuItem;
Workline1: TMenuItem;
HelpMenu: TMenuItem;
HelpContentsItem: TMenuItem;
HelpSearchItem: TMenuItem;
HelpHowToUseItem: TMenuItem;
N3: TMenuItem;
HelpAboutItem: TMenuItem;
SpeedButton1: TSpeedButton;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);

private

{ Private declarations }
public
{ Public declarations }

Drawing:Boolean;
StartPos, LastPos, EndPos:TPoint;

procedure DrawShape(TopLeft,BottomRight:Tpoint; AMode:TPenMode);
procedure ShowAllGrabs();
procedure HideAllGrabs();
procedure RefreshAllGrabs();
procedure RedrawAllWfn();
end;

var
f_wfe: Tf_wfe;
grabs: array[1..8] of TGraphicControl;
CurSelNode: TGraphicControl;
wfnode: ^TGraphicControl;
wfnodes: TList;
implementation
uses WFNode,GrabControl;
{$R *.DFM}

procedure Tf_wfe.DrawShape(TopLeft, BottomRight: Tpoint; AMode: TPenMode);
begin
f_wfe.Canvas.Pen.Mode:=Amode;
f_wfe.Canvas.Rectangle(TopLeft.x,TopLeft.y,BottomRight.x,BottomRight.y);

end;

procedure Tf_wfe.formMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing:=true;
f_wfe.Canvas.MoveTo(x,y);
StartPos:=Point(x,y);
LastPos:=Point(x, y);
end;


procedure Tf_wfe.formMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Drawing then
begin
DrawShape(StartPos,LastPos,pmnotxor);
LastPos:=Point(x,y);
DrawShape(StartPos,LastPos,pmnotxor);
end;
end;

procedure Tf_wfe.formMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
begin
EndPos:=Point(x,y);
Drawing:=false;
if ( (abs(EndPos.X - StartPos.X) > 20) and
(abs(EndPos.Y - StartPos.Y) > 20) ) then
begin
DrawShape(StartPos, EndPos, pmCopy);
wfnodes:=TList.Create;
wfnode:=^TWFNode.Create(self);
new(wfnode);
wfnode:=^CurSelNode;

ShowAllGrabs();
RedrawAllWfn();
end
else
begin
DrawShape(StartPos, EndPos, pmnotxor);
end;
end;
end;

procedure Tf_wfe.FormCreate(Sender: TObject);
var
i:Integer;
begin
for i:=1 to 8 do
begin
grabs:=TGrabControl.Create(self);
(grabs as TGrabControl).Gctype:=gcts;
end;
end;

procedure Tf_wfe.ShowAllGrabs();
var
i:Integer;
begin
for i:=1 to 8 do
begin
(grabs as TGrabControl).SetAttachPos(CurSelNode.Left, CurSelNode.Top, CurSelNode.Width, CurSelNode.Height);
grabs.visible:=True;
end;
end;

procedure Tf_wfe.HideAllGrabs();
var
i:Integer;
begin
for i:=1 to 8 do
begin
grabs.visible:=False;
end;
end;

procedure Tf_wfe.RefreshAllGrabs();
begin
HideAllGrabs();
ShowAllGrabs();
end;

procedure Tf_wfe.RedrawAllWfn;
begin

end;

end.


grabcontrol


interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MainForm,ExtCtrls;
type
TGrabControlType = (gtLT, gtMT, gtRT, gtRM, gtRB, gtMB, gtLB, gtLM);
TGrabControl = class(TGraphicControl)
private
FGcType : TGrabControlType;
gcCanvas : TCanvas;
StartX, StartY : Integer;
procedure Drawit();
procedure SetGcType(Value: TGrabControlType);
procedure SetClipCursor();
protected
procedure Paint(); override;
public
constructor Create(AOwner: TComponent); override;
procedure OnSelect (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure OnMoveEnd (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure OnMove (Sender: TObject; Shift: TShiftState; X, Y: Integer);
published
procedure SetAttachPos(AtX, AtY, AtWidth, AtHeight:Integer);
property Gctype : TGrabControlType Read FGcType Write SetGcType;
end;

var
gcts:array[1..8] of TGrabControlType = (gtLT, gtMT, gtRT, gtRM, gtRB, gtMB, gtLB, gtLM);

implementation
uses WFNode;
{ TGrabControl }

constructor TGrabControl.Create(AOwner: TComponent );
begin
inherited Create(Aowner);
width:=6;
height:=6;
gccanvas:=canvas;
visible:=false;
parent:=Aowner as TWinControl;

OnMouseDown:=OnSelect;
OnMouseMove:=OnMove;
OnMouseUp:=OnMoveEnd;
end;

procedure TGrabControl.Drawit();
begin
gccanvas.Brush.Color:=clblack;
gccanvas.Rectangle(gccanvas.cliprect);
end;

procedure TGrabControl.OnMoveEnd (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClipCursor(nil);
end;

procedure TGrabControl.OnMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
node:TWFNode;
IncX1, IncY1, IncX2, IncY2: Integer;
begin
if (ssLeft in Shift) then
begin
IncX1 := 0;
IncY1 := 0;
IncX2 := 0;
IncY2 := 0;
case fgctype of
gtLT :
begin
IncX1 := X - StartX;
IncY1 := Y - StartY;
end;
gtMT :
begin
IncY1 := Y - StartY;
end;
gtRT :
begin
IncX2 := X - StartX;
IncY1 := Y - StartY;
end;
gtRM :
begin
IncX2 := X - StartX;
end;
gtRB :
begin
IncX2 := X - StartX;
IncY2 := Y - StartY;
end;
gtMB :
begin
IncY2 := Y - StartY;
end;
gtLB :
begin
IncX1 := X - StartX;
IncY2 := Y - StartY;
end;
gtLM :
begin
IncX1 := X - StartX;
end;
end;
node := (MainForm.CurSelNode as TWFNode);
node.MoveWithOff(IncX1, IncY1, IncX2, IncY2);
MainForm.f_wfe.RefreshAllGrabs();
end;
end;

procedure TGrabControl.SetClipCursor();
var
ClntClip:TRect;
begin
with MainForm.CurSelNode do
begin
ClntClip.TopLeft := Point(Left, Top);
ClntClip.BottomRight := Point(Left + Width, Top + Height);
end;
with ClntClip do
begin
case fgctype of
gtLT :
begin
TopLeft := Point(0, 0);
Right := Right - 20;
Bottom := Bottom - 20;
end;
gtMT :
begin
TopLeft := Point(0, 0);
Right := Right - 20;
Bottom := Bottom - 20;
end;
gtRT :
begin
Left := Left + 20;
Top := 0;
Right := MainForm.f_wfe.Width;
Bottom := Bottom - 20;
end;
gtRM :
begin
Left := Left + 20;
Top := 0;
Right := MainForm.f_wfe.Width;
Bottom := Bottom - 20;
end;
gtRB :
begin
Left := Left + 20;
Top := Top + 20;
Right := MainForm.f_wfe.Width;
Bottom := MainForm.f_wfe.Height;
end;
gtMB :
begin
Left := Left + 20;
Top := Top + 20;
Right := MainForm.f_wfe.Width;
Bottom := MainForm.f_wfe.Height;
end;
gtLB :
begin
Left := 0;
Top := Top + 20;
Right := Right - 20;
Bottom := MainForm.f_wfe.Height;
end;
gtLM :
begin
Left := 0;
Right := Right - 20;
end;
end;
ClntClip.TopLeft := MainForm.f_wfe.ClientToScreen(ClntClip.TopLeft);
ClntClip.BottomRight := MainForm.f_wfe.ClientToScreen(ClntClip.BottomRight);
ClipCursor(@ClntClip);
end;
end;

procedure TGrabControl.OnSelect(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
StartX := X;
StartY := Y;
SetClipCursor();
end;

procedure TGrabControl.Paint();
begin
drawit();
end;

procedure TGrabControl.SetGcType(Value: TGrabControlType);
begin
FGcType := Value;
case fgctype of
gtLT : cursor:=crSizeNWSE;
gtMT : cursor:=crSizeNS;
gtRT : cursor:=crSizeNESW;
gtRM : cursor:=crSizeWE;
gtRB : cursor:=crSizeNWSE;
gtMB : cursor:=crSizeNS;
gtLB : cursor:=crSizeNESW;
gtLM : cursor:=crSizeWE;
end;
end;

procedure TGrabControl.SetAttachPos(AtX, AtY, AtWidth, AtHeight:Integer);
begin
case fgctype of
gtLT :
begin
Left := AtX - 6;
Top := AtY - 6;
end;
gtMT :
begin
Left := AtX - 3 + (AtWidth) div 2;
Top := AtY - 6;
end;
gtRT :
begin
Left := AtX + AtWidth;
Top := AtY - 6;
end;
gtRM :
begin
Left := AtX + AtWidth;
Top := AtY -3 + (AtHeight) div 2;
end;
gtRB :
begin
Left := AtX + AtWidth;
Top := AtY + AtHeight;
end;
gtMB :
begin
Left := AtX - 3 + (AtWidth) div 2;
Top := AtY + AtHeight;
end;
gtLB :
begin
Left := AtX - 6;
Top := AtY + AtHeight;
end;
gtLM :
begin
Left := AtX - 6;
Top := AtY - 3 + (AtHeight) div 2;
end;
end;
//drawit();

end;

end.

WFNode


interface

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

type
TWFNodeType = ( wtNone, wtStart, wtEnd, wtSS, wtSM, wtMS, wtMM );
TWFNode = class(TGraphicControl)
private
{ Private declarations }
Origin: tpoint;
FNodeType : TWFNodeType;
swCanvas : TCanvas;
procedure SetNodeType(Value : TWFNodeType);

protected
{ Protected declarations }
procedure OnNodeSelect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure OnNodeUnselect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure OnNodeMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Paint(); override;
property Canvas;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure MoveWithOff(IncX1, IncY1, IncX2, IncY2: Integer);
procedure Redraw();
published
{ Published declarations }
property NodeType : TWFNodeType read FNodeType write SetNodeType;
end;

implementation
uses GrabControl;
constructor TWFNode.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNodeType := wtNone;

Left := Min(MainForm.f_wfe.StartPos.x, MainForm.f_wfe.EndPos.x);
Top := Min(MainForm.f_wfe.StartPos.y, MainForm.f_wfe.EndPos.y);;
Width := Abs(MainForm.f_wfe.StartPos.x - MainForm.f_wfe.EndPos.x);
Height := Abs(MainForm.f_wfe.StartPos.y - MainForm.f_wfe.EndPos.y);
color:=clyellow;

//ShowHint := True;
//Hint := 'Work node object';

swCanvas := Canvas;
Parent := AOwner as TWinControl;

OnMouseDown := OnNodeSelect;
OnMouseUp := OnNodeUnselect;
OnMouseMove := OnNodeMove;
end;

procedure TWFNode.SetNodeType(Value : TWFNodeType);
begin
if FNodeType <> Value then
begin
FNodeType := Value;
//Redraw();
end;
end;

procedure TWFNode.Redraw();
begin
//swCanvas.pen.Style:=psclear;
//swCanvas.Brush.Color:=clyellow;
swCanvas.Rectangle(swcanvas.ClipRect);
end;

procedure TWFNode.Paint();
begin
Redraw();
end;

procedure TWFNode.OnNodeSelect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//MainForm.CurSelNode:=Self;
Redraw();
MainForm.f_wfe.HideAllGrabs();
//Invalidate();
Origin:=point(x,y);
end;

procedure TWFNode.OnNodeUnselect(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
redraw();
MainForm.CurSelNode:=Self;
MainForm.f_wfe.ShowAllGrabs();
Invalidate();
end;

procedure TWFNode.OnNodeMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (ssLeft in Shift) then
begin
Left := Left + X - Origin.x;
Top := Top + Y - Origin.y;
end else
redraw();

end;

procedure TWFNode.MoveWithOff(IncX1, IncY1, IncX2, IncY2: Integer);
var
X1, Y1, X2, Y2: Integer;
begin
X1 := Left + IncX1;
Y1 := Top + IncY1;
X2 := Left + Width + IncX2;
Y2 := Top + Height + IncY2;
Left := Min(X1, X2);
Top := Min(Y1, Y2);
Width := Abs(X1 - X2);
Height := Abs(Y1 - Y2);
end;

end.

to fhb:
nnd 那个东西要钱的，没钱！

这么多怎么看，高手指点

我正需要这方面的

怎么还没有人回答

up