Delphi程序设计中的鼠标控制(2)

procedure FormCreate(Sender:TObject);

procedure FormMouseDown(Sender:TObject;Buttom:TMouseButton; Shift:TShiftState;X，Y:Integer);

procedure FormMouseUp(Sender:TObject;Buttom:TMouseButton; Shift:TShiftState;X，Y:Integer); private

{Private declarations} public

{Public declarations} end; var

Form1:TForm1;

implementation {＄R ＊.DFM} var

Canvas:TCanvas; Flag:Boolean;

procedure TForm1.FormCreate(Sender:TObject); begin

Flag:=False; end;

procedure TForm1.FormMouseDown(Sender:TObject;Buttom:TMouseButton; Shift:TShiftState;X，Y:Integer); begin

if Flag=False Then begin

Canvas.MoveTo(X，Y); Flag:=Ture; end else

Flag:=false; end;

procedure TForm1.FormMouseUp(Sender:TObject;Buttom:TMouseButton; Shift:TShiftState;X，Y:Integer); begin

if Flag=Ture Then begin

Canvas.Pen.Color:=clBlack; Canvas.LineTo(X，Y); end; end;

end.

两种方式实现拖曳：用七个事件分裂成两种方法（七武器） //第一种：onmousedown，onmouseup，onmousemove

//第二种：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver

第一种：onmousedown，onmouseup，onmousemove {

2008-06-28 20:00

onmousedown，onmouseup和onmousemove

delphi下如何实现动态对象的拖拽

昨天上午写了一个小程序，模仿delphi设计阶段组件的拖拽，实现了动态创建对象的拖拽。 首先动态创建三个TLabel对象，并且保存到TList中，分别设置他们的onmousedown，onmouseup和onmousemove事件。 } type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject); private

{ Private declarations }

lstMyRect : TList; //类似于控件数组 Flag_Dragging : boolean;

StartPoint, LastPoint : TPoint; //记录鼠标按下的点和移动后的点 NowRect : TRect; //组件对象的边框 procedure PrepareToMove(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure Moving(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure MoveEnd(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); public

{ Public declarations } end;

procedure TForm1.FormCreate(Sender: TObject); var

s : string; i : integer;

TempLabel : TLabel; begin

Flag_Dragging := False;

lstMyRect := TList.Create; //动态创建TLabel对象，并保存 for i := 0 to 2 do begin

tempLabel := TLabel.Create(Sender as TForm); tempLabel.Caption := 'i love you'; tempLabel.Top := 100 + i * 50; tempLabel.Left := 100 + i * 50; tempLabel.Parent := Form1;

tempLabel.OnMouseDown := PrepareToMove; //设置三个事件 tempLabel.OnMouseMove := Moving; tempLabel.OnMouseUp := MoveEnd; lstMyRect.Add(tempLabel); end; end;

{当鼠标按下时，记录下开始点，并得到组件对象的边框，在移动的时候给用户以参照，并且把该边框画出}

procedure TForm1.PrepareToMove(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var

TmpLabel : TLabel; begin

TmpLabel := Sender as TLabel; Flag_Dragging := True; StartPoint := Point(X, Y); LastPoint := Point(X, Y);

NowRect := Rect(TmpLabel.Left, TmpLabel.Top,

TmpLabel.Left + TmpLabel.Width, TmpLabel.Top + TmpLabel.Height); Form1.Canvas.DrawFocusRect(NowRect); end;

{当鼠标移动的时候，计算出移动的距离，消隐上一个位置的边框，计算新位置的边框并画出}

procedure TForm1.Moving(Sender: TObject; Shift: TShiftState; X,Y: Integer); var

TmpLabel : TLabel; DeltaX, DeltaY : integer; begin

TmpLabel := Sender as TLabel; if Flag_Dragging then begin

DeltaX := X - LastPoint.X; //计算移动的横纵距离 DeltaY := Y - LastPoint.Y;

LastPoint := Point(X, Y); //保存新点

Form1.Canvas.DrawFocusRect(NowRect); //消隐上一个位置的边框 NowRect := Rect(NowRect.Left + DeltaX, NowRect.Top + DeltaY,

NowRect.Right + DeltaX, NowRect.Bottom + DeltaY);//计算新边框的位置

Form1.Canvas.DrawFocusRect(NowRect); end; end;

{当鼠标放开时，不用再画边框，直接计算释放处与开始处的距离，然后把组件对象移动过来}

procedure TForm1.MoveEnd(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var

TmpLabel : TLabel; Deltax, Deltay : integer; begin

TmpLabel := Sender as TLabel; if Flag_Dragging then begin

Flag_Dragging := False; LastPoint := Point(X, Y);

Deltax := LastPoint.X - StartPoint.X; Deltay := LastPoint.Y - StartPoint.Y;

TmpLabel.Top := Deltay + TmpLabel.Top; //重新设置组件对象的位置 TmpLabel.Left := Deltax + TmpLabel.Left; end; end;

第二种：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver {

2008-06-28 20:08

OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver

在delphi中实现托拽

版权声明：转载时请以超链接形式标明文章原始出处和作者信息及本声明 http://kris.blogbus.com/logs/31441.html

我的理解是这样的,OnStartDrag-->OnDragOver-->OnDragDrop 开始拉,然后是在control的上面拉,最后是放下,

其中Drop处,对应的是最后被托拽物体所要释放到的control名(即是Target),

要把物体的parent设成对应的Control名,否则无法实现drag, 另外在Over事件中,要求把Accept变量设成True,才可以托拽; }

//*********************************************************************************** unit Unit1;

interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, jpeg, ExtCtrls; type

TForm1 = class(TForm) Panel1: TPanel; Panel2: TPanel; Memo1: TMemo; Image1: TImage; Edit1: TEdit;

Button1: TButton;

procedure Panel1DragDrop(Sender …… 此处隐藏：3206字，全部文档内容请下载后查看。喜欢就下载吧 ……