救救我啊!要如何才能拖动控件呢? (100分)

  • 主题发起人 主题发起人 goodfriend1
  • 开始时间 开始时间
G

goodfriend1

Unregistered / Unconfirmed
GUEST, unregistred user!
[blue]我想达到点击按钮后,根据给出的X,Y参数,动态创建一个Shape控件,大小如X,Y参数,
并能够用鼠标拖动此控件,并调整它的大小,我现在只能达到动态创建控件,不知要怎么写,
敬请指教,不胜感激,谢谢![/blue]
 
PaintBox1: TPaintBox
PaintBox1:= TPaintBox.Create(self);
用完后记得释放free
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure myPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
pb:TPaintBox;
implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);

begin
pb:=tpaintbox.Create(self);
pb.Name:='pb';
pb.Top:=20;
pb.Left:=20;
pb.Width:=200;
pb.Height:=200;
pb.Parent:=form1;
pb.Canvas.Brush.Color:= clBackground;
pb.ParentColor:=false;
pb.Visible:=true;
pb.OnPaint:=mypaint;


end;

procedure TForm1.myPaint(Sender: TObject);
begin
pb.Canvas.Pen.Color:=clred;
pb.Canvas.Pen.Width:=6;
pb.Canvas.LineTo(200,200);

end;

end.
 
x-left, y-top得到宽和高,设控件的宽和高即可。
 
在其MouseDown,MouseUp,MouseMove中处理,以做到拖动和调整大小。
 
先根据鼠标位子创见后……
procedure XXXX.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
Shape.Perform(WM_SysCommand, $f017, 0);
end;
end;
 
procedure DragControl(WinControl: TWincontrol);
const SC_DRAGMOVE = $F012;
begin
ReleaseCapture;
WinControl.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
包你滿意:)




WinControl.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);


end
 
ljy_17 说的没错,后来我才想起,必须是TWinControl的子类才能那样用!
你可以先创见一个PANEL,把Shape1的父色为它,把MouseDown设为PANEL的
MouseDown事件,一样可行!
 
对于TGraphicControl,可以用下面的笨办法(只实现了拖动动):

unit ZWShape;

interface

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

const MAX_STATION = 8;

type

State_T =(stShutDown, stSilent, stSend, stReceive);
// this record may be changed according to the usage of this component.
Ctr_T = record
vx, vy: integer; // speed
SqrDist, LinkQ, HdErrorBits, DataErrorBits: array[1..MAX_STATION] of integer;
Active: boolean;
State: State_T;
Sender: integer;
end;

TZWShape = class(TShape)
private
{ Private declarations }
old_x,old_y: integer;
can_move: boolean;
PicLeft,PicTop,TexLeft,TexTop: integer;
//ImgRect: TRect;

FPicture: TPicture;
FNumber: Cardinal;
FTouch: TNotifyEvent;

procedure SetPicture(Value: TPicture);
procedure SetNumber(Value: Cardinal);
//procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
//procedure WMSize(var Msg: TWMSize); message WM_SIZE;
protected
{ Protected declarations }
procedure Paint; override;

public
{ Public declarations }
TextX, TextY: integer;
Ctr: Ctr_T;
neighbor_x,neighbor_y:integer;
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
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;
function CenterX:integer;
function CenterY:integer;
published
{ Published declarations }
property Picture: TPicture read FPicture write SetPicture;
property Number: Cardinal read FNumber write SetNumber default 0;
property OnTouch : TNotifyEvent read FTouch write FTouch;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('220', [TZWShape]);
end;

constructor TZWShape.Create(AOwner: TComponent);
begin

inherited Create(AOwner);
can_move := false;
FPicture := TPicture.Create;
Shape := stCircle;
Canvas.Font.Color := ClWhite;
Canvas.Font.Style := Canvas.Font.Style + [fsBold];
TextX := 0;
TextY := 0;
TexLeft := width div 2 - Canvas.Font.Height div 2 + TextX;
TexTop := height div 2 - Canvas.Font.Size div 2 + TextY;

end;


procedure TZWShape.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
old_x := x;
old_y := y;
can_move := true;
cursor := crSizeAll;
if assigned(OnMouseDown) then OnMouseDown(self,Button,shift,x,y);
end;

procedure TZWShape.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin

can_move := false;
cursor := crDefault;;
if assigned(OnMouseUp) then OnMouseUp(self,Button,shift,x,y);

end;

procedure TZWShape.MouseMove(Shift: TShiftState; X,
Y: Integer);
{var TemShape: TZWShape;
i: integer;}
begin
cursor := crSizeAll;
if can_move then
begin
Left := Left+x-old_x;
Top := Top+y-old_y;
end;

if assigned(OnMouseMove) then OnMouseMove(self,shift,x,y);

end;

procedure TZWShape.Paint;
var
SavedBrushStyle : TBrushStyle;
SavedBrushColor: TColor;
begin
SavedBrushStyle := Canvas.Brush.Style;
SavedBrushColor := Canvas.Brush.Color;
try
Canvas.Brush.Style := bsCross;
Canvas.Brush.Color := RGB(50,190,60);//clGreen;
Canvas.Pen.Color := RGB(50,190,60); //clGreen;
Canvas.Ellipse(ClientRect);

if assigned(FPicture) then
begin
//Canvas.StretchDraw(ImageRect,FPicture.Graphic);
Canvas.Draw(PicLeft,PicTop,Fpicture.Bitmap);

Canvas.TextOut(TexLeft,TexTop,inttostr(FNumber));
//if assigned(OnTouch) then OnTouch(self);
end;
finally
Canvas.Brush.Style := SavedBrushStyle;
Canvas.Brush.Color := SavedBrushColor;
end;
end;

{procedure TZWShape.WMSize(var Msg: TWMSize);
begin
inherited;
DeleteObject(FHRgn);
FHRgn := CreateEllipticRgn(ClientRect.Left, ClientRect.Top,
ClientRect.Right, ClientRect.Bottom);
SetWindowRgn(Handle, FHRgn, True);
end;}

procedure TZWShape.SetPicture(Value: TPicture);
begin

FPicture.Assign(Value);

//set transparent
Fpicture.Bitmap.TransparentMode := tmAuto;
Fpicture.Bitmap.TransparentColor := Fpicture.BitMap.canvas.pixels[5,5];
Fpicture.Bitmap.Transparent := true;

PicLeft := width div 2 - Value.Bitmap.Width div 2;
PicTop := height div 2 - Value.Bitmap.Height div 2;

TexLeft := width div 2 - Canvas.Font.Height div 2 + TextX;
TexTop := height div 2 - Canvas.Font.Size div 2 + TextY;

invalidate;

end;

procedure TZWShape.SetNumber(Value: Cardinal);
begin
FNumber := value;
end;

{procedure TZWShape.WMEraseBkgnd(var Msg: TMessage);
begin

inherited;
if assigned(OnTouch) then OnTouch(self);
end;}

function TZWShape.CenterX:integer;
begin
Result:=left + (width div 2);
end;

function TZWShape.CenterY:integer;
begin
Result:=top + (height div 2);
end;

destructor TZWShape.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;

end.

里面有一些东西是多余的,是我做其它东西是用的,看一下其中的MouseDown,MouseUp,MouseMove就够了。
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部