我想要个框框,运行的时候可以拖动，可以更改大小，大家谁有给我用用！求求大家了！ (88分)

doxpix:再次谢谢你，我就按照你的思路来做，我想我能搞定的！

doxpix:改变框框的大小该怎么做！
有人知道么？

还在调试中...

photoshop中一个画好的框框是不能改变大小的吧。
只能拖动，要不点一下其他的地方，重新画一个框框。

哦，我想要个可以的！

doxpix:我有了个思路，在橡皮筋周围画8个点，在拖动点的时候改变大小，不过我
不知道该怎么写？在次感谢你！

哎，画了半天线。没有达到目的。
于是去试Shape控件，哎，没想到对鼠标的响应那么差。

最好能找一个高效的shape控件，那样改变大小也可以
实现了。我到这个地方去看了:http://www.truevcl.com
，有一个TCAD好象能满足。可惜是要卖的，而且天价。

又会到控件了。

照你上边的思路实现起来有点麻烦。

我看过那个控件了，连试用版都没有，那该怎么办，你看看这段代码，是从
别人那里复制来的，我看不太懂，但是肯定有帮助的？
unit sizecontrol;

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);
Paint;
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.



在新的的FORM里的，

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


这代码应该怎么改？

这是《Delphi高级技术》里的代码，看看书吧，有很详细的解释

你是真的蔓草？

Haha,i think we are colse to you need!
the solution is Tshape+your sizecontrol control!
In the project,you need a timage control,a tshape control!
and you must set image1.align:=alclient,shape1.pen.style:=psdot,
shape1.brush.style:=bsclear,and bring shape1 to front,send image1
to back!OK,This is over!Please press F9!

These are codes you need:
*************************************************************************
unit Unit1;

interface

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

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;

TForm1 = class(TForm)
Shape1: TShape;
Image1: TImage;
procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
SizeControl: TSizerControl;
fdragging:boolean;
frect:Trect;
x1,y1:integer;

const
sc_DragMove: Longint = $F012;

implementation

{$R *.DFM}
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);
Paint;
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 TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
SizeControl := TSizerControl.Create(self, shape1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
fdragging:=false;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if fdragging then
begin
image1.canvas.DrawFocusRect(frect);
if x1>x then
begin
frect.left:=x;
frect.Right:=x1;
end
else
begin
frect.left:=x1;
frect.right:=x;
end;
if y1>y then
begin
frect.top:=y;
frect.Bottom:=y1;
end
else
begin
frect.top:=y1;
frect.bottom:=y;
end;
image1.canvas.DrawFocusRect(frect);
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fdragging:=false;
image1.canvas.DrawFocusRect(frect);
shape1.BoundsRect:=frect;
shape1.Visible:=true;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
shape1.Visible:=false;
if button=mbleft then
begin
fdragging:=true;
frect.Left:=x;
frect.Top:=y;
frect.BottomRight:=frect.TopLeft;
image1.canvas.DrawFocusRect(frect);
x1:=x;y1:=y;
end;
end;

end.

*************************************************************************

Oh,first you must set shape1.visible:=false.

hukaijt,Who are U?

我的程序就在上面了。你可以把shape先设成不可见，
等到鼠标释放后再设成可见就好了。

你要我玩整的源代码吗？你的信箱呢？
大小3KB。

终于做出来了，这个绝对没问题．
unit option;

interface

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

type
TOptionForm = class(TForm)
Image1: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);

private
{ Private declarations }
public
{ Public declarations }

DrawStyle:string;
Draw:Boolean;

end;

function IsInArea(X,Y:Integer):Boolean;
var

OptionForm: TOptionForm;
BeginPoint,MovePoint,EndPoint,MoveStart:Tpoint;

implementation


{$R *.DFM}

function IsInArea(X,Y:Integer):Boolean;
begin
result:=False;
if (X>BeginPoint.X) and (X<EndPoint.X) and (Y>BeginPoint.Y) and (Y<EndPoint.Y) then
begin
//showmessage('');
result:=True;
end
end;

procedure TOptionForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not IsInArea(x,y) then
begin
if Button=mbLeft then begin
Image1.Canvas.Ellipse(BeginPoint.X, BeginPoint.Y, EndPoint.X,EndPoint.Y);
Image1.Canvas.MoveTo(X, Y);
BeginPoint := Point(X, Y);
MovePOint := BeginPoint;
Draw:=True;
end;
end
else
begin
MoveStart:=Point(x,y);
end;

end;

procedure TOptionForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
temp:integer;
begin
if Draw then
if Button=mbLeft then begin
Image1.Canvas.Ellipse(BeginPoint.X, BeginPoint.Y, X,Y);
EndPoint:=Point(x,y);
if BeginPoint.x>endPoint.x then
begin
Temp:=BeginPoint.x;
BeginPoint.x:=EndPoint.x;
EndPoint.x:=Temp;
end;
if BeginPoint.y>endPoint.y then
begin
Temp:=BeginPoint.y;
BeginPoint.y:=EndPoint.y;
EndPoint.y:=Temp;
end;
Draw:=False;
end;
end;

procedure TOptionForm.FormCreate(Sender: TObject);
begin
BeginPoint := Point(0, 0);
EndPoint:=Point(0,0);

Image1.Canvas.Brush.Style:=bsClear;
image1.canvas.pen.Mode:=pmnotxor;
image1.canvas.pen.Color:=clblue;
end;

procedure TOptionForm.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (Shift=[ssleft]) and not Draw then begin
Image1.Canvas.Ellipse(BeginPoint.X, BeginPoint.Y, EndPoint.X,EndPoint.Y);
BeginPoint.x:=BeginPoint.x+x-MoveStart.x;
BeginPoint.Y:=BeginPoint.Y+Y-MoveStart.Y;
EndPoint.x:=EndPoint.x+x-MoveStart.x;
EndPoint.Y:=EndPoint.Y+Y-MoveStart.Y;
MoveStart.x:=x;
MoveStart.Y:=Y;
Image1.Canvas.Ellipse(BeginPoint.X, BeginPoint.Y, EndPoint.X,EndPoint.Y);
end;
end;

end.

doxpix：哦，我知道了，可以运行了，可是就是效果不是很好！

发错了！关注

knightlzf,:
你的程序只能移动，不能改变大小，有办法么？
不管怎么样，谢谢你！

是不是有时候闪烁，所以你不满意？
或者是那八个点显示不好？

每个图（任何图，矩形、圆。。。）主要有两点是定义它的位置的。
一个是左上角，一个是右下角，你只要改变这两点的坐标就可以改变图的大小和形状。
现在你只要判断你的鼠标是否放在这两点上，如果是这两点的坐标就随着鼠标的
移动而改变。
这样就可以做成改变大小了。
如果还是做不出来给我个e－mail
knightlzf@163.net

把 knightlzf, doxpix 的程序综合一下就对了嘛

doxpix,:在有背景的图片上拖动就会有闪烁！
knightlzf：lazycat521@263.net
谢谢各位大侠！！！
承蒙关照，不胜感激，只有多多送分给各位，
希望大家不要嫌弃！

星期六星期天我不用上班可能要星期一才能做给你