运行后,拖动文本框,就可以看到效果了
Private Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Text1.Left = X
Text1.Top = Y
End Sub
Private Sub Form_Load()
Text1.DragMode = 1
End Sub
拖放是用鼠标拖动一个对象到其它对象的活动。在图形 *** 作过程中,拖放是最常用的功能之一,下面我们来看看怎样用 VB 实现拖放功能。首先介绍与拖放有关的控件:
1.属性:DragMode 决定拖动 *** 作的初始化是人工方式还是自动方式,DragIcon 确定在拖动过程中显示的指针的图标形状;
2.方法:Drag 开始,结束或取消拖动控件;
3.事件:MouseDown 事件发生于用户按下鼠标按钮时,DragOver 事件发生于拖动 *** 作完成时,DragDrop 事件发生于拖动 *** 作正在进行时。
然后编写一个小程序,这个程序能实现在窗口中或窗口间拖动图标的功能。建立窗口 Form1 和 Form2,在窗口中都加入 Image1,为它们设置初始显示的图片。键入以下代码(本程序在 VB5.0/6.0,Window95/98/NT4.0 环境下通过):
' Form1 下程序代码为:
Option Explicit
Dim dragx As Single
Dim dragy As Single
Const BEGIN_DRAG=1
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Image1.Picture=Source 'Sourse为被拖动的控件
Form2.Image1.Picture=LoadPicture("")
Image1.Move(X-dragx),(Y-dragy) ' X,Y为鼠标所在目标窗体或控件的当前坐标
End Sub
Private Sub Form_Load()
Load Form2
Form2.Show 0
End Sub
Private Sub Image1_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single)
dragx=X
dragy=Y
Image1.Drag BEGIN_DRAG'开始拖动 *** 作
Image1.DragIcon = LoadPicture("按下鼠标时想显示的光标")
End Sub
' Form2 下程序代码为:
Option Explicit
Dim dragx As Single
Dim dragy As Single
Const BEGIN_DRAG=1
Private Sub Form_DragDrop(Source As Control,X As Single,Y As Single)
Image1.Picture=Source
Form1.Image1.Picture=LoadPicture("")
Image1.Move(X-dragx),(Y-dragy)
End Sub
Private Sub Image1_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single)
dragx=X
dragy=Y
Image1.Drag BEGIN_DRAG
Image1.DragIcon=LoadPicture("按下鼠标时想显示的光标")
{鼠标:右击,左击,单击,双击,滚轮,拖曳} Delphi程序设计中的鼠标控制 在Windows环境下,鼠标和键盘是主要的输入设备。在Delphi中几乎每个对象都具有反映鼠标控制的事件, 这些事件的主要功能包括改变鼠标指针的形状,移动、触发、拖动鼠标等。 鼠标控制的三个相关属性是Cursor、DragCursor、DragMode; 鼠标(拖拽)控制的三个对象方法是BeginDrag、Dragging、EndDrag; 鼠标控制的七个事件包括OnDragDrop等。
一、改变鼠标指针的形状 改变鼠标指针的形状在Windows环境下是不可缺少的功能。 当应用程序在执行一个较长时间的指令或动作时, 我们可以改变鼠标指针的形状来通知用户程序执行的状态, 等到执行的动作完成之后,再把鼠标指针的形状变回来。 此外,在拖动的过程中我们也可以改变鼠标指针的形状,使拖动的过程更加清楚。 在编辑过程中,我们可以用属性Cursor和DragCursor改变鼠标指针的形状, 前者是记录鼠标指针在对象上出现的情况;后者是设定对象被拖动时鼠标指针的形状。 对于这两个属性,Delphi提供了如下值供用户选择:cdDefault、crArrow、cdCross、crBeam、crSize等十几个属性值。
二、鼠标的移动 鼠标移动时会触发事件OnMouseMove,语法如下: procedure ObjectMouseMove(Sender:TObjectShift:TshiftStateX,Y:Integer) 其中参数Sender代表((目标对象)),参数Shift代表鼠标移动时需同时按下的组合键, 由{ssShift,ssAlt,ssCtrl,ssRight,ssLeft,ssMiddle,ssDouble}组成。 此外,我们也可以利用参数X和Y取得鼠标移动的坐标位置,通常我们使用OnMouseMove事件时,最重要的就是这两个参数。
三、鼠标按键 鼠标按键在窗口环境中也是最重要的输入方法之一, 同时还可以配合Shift,Alt,Ctrl三个键而发挥不同的作用。 和鼠标按键有关的事件有OnMouseDown和OnMouseUp。 当用户按下鼠标的一个键后,会触发OnMouseDown事件,其语法如下: procedure ObjectMouseDown(Sender:TObjectButton:TMouseButtonShift:TShiftStateX,Y:Integer)参数Button指出按下的鼠标键是哪一个,可以是{mbLeft,mbRight,mbMiddle}三者之一。 参数Shift可以反映按下的键盘键与鼠标的关系, 其值是由{ssShift,ssAlt,ssCtrl,ssLeft,ssRight,ssMiddle,ssDouble}所组合而成的集合, 这些参数值分别代表Shift,Alt,Ctrl键、鼠标的左、中、右键,及同时按下左右键。 例如,同时按下鼠标的右键和Alt键,参数Shift的值就是{ssAlt,ssRight}。
四、鼠标的拖动(细节) (一)启动拖动状态 拖动状态的方式及启动是根据属性DragMode值的设定而决定的,可以分成两类情况: 1.不必程序控制 如果DragMode的值是dmAutomatic,当鼠标左键一按,对象就自动进入拖动状态。 2.需要程序控制 如果DragMode的值是dmManual,要使对象进入拖动状态,可以调用方法BeginDrag。 此外,Delphi提供一个对象方法Dragging,让程序判断对象是否进入拖动状态。 如果返回值是TRUE,代表已进入拖动状态,否则就是没有。 要使对象进入拖动状态,可以调用对象方法BeginDrag。 当对象进入拖动状态时,事件OnStartDrag会被触发,有关语法如下: 对象方法Dragging语法如下: function Dragging:Boolean对象方法BeginDrag语法如下: Procedure BeginDrag(Immediate:Boolean)事件OnStartDrag语法如下: Procedure ObjectStartDrag(Sender:TObjectVar DragObject:TDragObject)(二)拖动中的事件 关于对象在拖动状态的事件有两个:OnDragDrop和OnDragOver。 假设把对象A拖动并放入对象B中,此时对象B的事件OnDragDrop会被触发。其语法如下: procedure ObjectDragDrop(Sender,Source:TObjectX,Y:Integer)参数Sender和Source分别代表目标对象B及被拖动的对象A, 参数X,Y代表拖动结束时的位置坐标,此坐标是以目标对象的坐标为参考的, 而实际上拖动中的对象并不是真的移动,所以以X,Y的值将对象移到新的位置。 (三)停止拖动 如果要停止拖动,可以使用对象方法EndDrag来完成;其语法如下: procedure ObjectEndDrag(Drop:Boolean)参数Drop若是Ture,被拖动的对象将被放置于与目前所在的位置; 否则,对象的拖动就被放弃,而回到原来的位置。 例如下面的程序段就代表对象Lable1放弃拖动,并恢复原状: Lable1.EndDrag(False)而停止拖动会触发事件OnEndDrag,其语法如下: Procedure ObjectEndDrag(Sender,Target:TObjectX,Y:Integer)不管是放弃拖动或是对象已经拖动到目标对象,均会触发这个事件。 参数Sender和Target分别指向被拖动对象(源)及目标对象,但是如果拖动没有成功,则Target值为nil。
补充: DELPHI中拖放的 *** 作
拖放(DragDrop)是Windows提供的一种快捷的 *** 作方式。作为基于Windows的开发工 具,Delphi同样支持拖放 *** 作,而且开发应用系统的拖放功能十分方便,真正体现了 Delphi 的强大功能和方便性。 Delphi提供的所有控件(Control,即能获得输入焦点的部件)都支持拖放 *** 作,并有 相应的拖放属性、拖放事件和拖放方法。下面我们先介绍控件的拖放支持,而后再给出开 发拖放 *** 作的一般步骤和应用实例。 9.1 控件的拖放支持 拖放 *** 作中控件可以分为源控件和目标控件两类。绝大部分控件既可以作为源控件 也可以作为目标控件。但也有一部分控件只能支持其中的一种。 9.1.1拖放属性 拖放属性主要有两个: ●DragMode:拖动模式 它们都是在拖放的源控件中设置。DragMode控制用户在运行时间内当在控件上按 下鼠标时控件如何反应。 如果DragMode置为dmAutomatic,那么当用户在控件上按下鼠 标时拖动自动开始; 如果DragMode置为dmManual(这是缺省值),则将通过处理鼠标事件 来判断一个拖动是否可以开始。 ●DragCursor 用于选择拖动时显示的光标,缺省值是CrDrag,一般不要去修改它。 在程序设计过程中通用的界面规范应该得到开发者的尊重。但有时候为了特定的目的, 开发者也可以把自己设计的光标赋给DragCursor。 9.1.2拖放事件 拖放事件主要有三个(?): ●OnDragOver:拖动经过时激发 ●OnDragDrop:拖动放下时激发 ●OnEndDrag:拖动结束时激发 ●OnStartDrag:拖动开始时激发(?) 前两个事件由目标控件响应,后一个事件由源控件响应。 ●OnDragOver事件最主要的功能是确定当用户就地放下拖动时控件是否可以接受。 它的参数包括: Source:TObject; {源控件} X,Y:Integer{光标位置} State:TDragState;{拖动状态} var Accept:Boolean {能否接受} ●TDragState是一个枚举类型,表示拖放项目与目标控件的关系。 type TDragState = (dsDragEnter, dsDragLeave, dsDragMove)不同取值的意义如下表: 表9.1 DragState的取值与意义 ━━━━━━━━━━━━━━━━━━━━━━━━━━━ 取值意义 ─────────────────────────── dsDragEnter拖动对象进入一个允许拖动对象放的控件中。为缺省状态。 dsDragLeave拖动对象离开一个允许拖动对象放下的控件。 dsDragMove拖动对象在一个允许拖动对象放下的控件内移动。 ━━━━━━━━━━━━━━━━━━━━━━━━━━━ 用户可以利用提供的参数来确定放下的拖动是否可被接受,如:
●判断源控件类型: Accept := Source is TLabel●判断源控件对象: Accept := (Source = TabSet1)●判断光标位置: 见(9.2),(9.3)中的例程。 ●判断拖动状态: If (Source is TLabel) and (State = dsDragMove) then begin source.DragIcon := ' New.Ico 'Accept := Trueend else Accept := False
当Accept=True时,目标控件可以响应OnDragDrop事件,用于确定拖动被放下后程序 如何进行处理。 ●OnDragDrop事件处理过程的参数包括源控件和光标位置。这些信息可用于处理方式的确定。 本篇文章来源于 www.87717.com 原文链接:http://www.87717.com/delphi/delphi_9716.html ●OnEndDrag事件是在拖动 *** 作结束后由源控件来进行响应的,用于源控件进行相应的 处理。拖动 *** 作结束既包括拖动放下被接受,也包括用户在一个不能接受放下的控件上释 放了鼠标。该事件处理过程的参数包括目标控件(Target)和放下位置的坐标。如果 Target=nil, 表示拖动项目没有被任何控件接受。 在第3节将介绍的文件拖放移动、拖放拷贝 *** 作中,如果 *** 作成功,则文件列表框 应更新显示内容。下面这段程序用于实现这一功能。 procedure TFMForm.FileListEndDrag(Sender, Target: TObjectX, Y: Integer)begin if Target <>nil then FileList.Updateend●除以上介绍的三个事件外,还有一个事件OnMouseDown也常用于拖放 *** 作的响应。 OnMouseDown虽然不是一个专门的拖放事件,但在人工模式下拖动的开始是在这一 事件的处理过程中实现的。 9.1.3拖放方法:人工方式 拖放方法有三个: ●BeginDrag:人工方式下开始一个拖动 ●EndDrag:结束一个拖动 ●Dragging:判断一个控件是否正被拖动 这三个方法都被源控件使用。 当DragMode置为dmManual时,拖动必须调用控件的BeginDrag方法才能开始。 ●BeginDrag有一个布尔参数Immediate。如果输入参数为True,拖动立即开始,光标 改变到DragCursor的设置。如果输入参数为False,直到用户将光标移动了一定的距离 (5个象素点)后才改变光标,开始拖动。这就允许控件接受一个OnClick事件而并不开始 拖动 *** 作。 ●EndDrag方法中止一个对象的被拖动状态。它有一个布尔参数Drop。如果Drop设置 为True,被拖动的对象在当前位置放下(能否被接受由目标控件决定);如果Drop设置 为False,则拖动就地被取消。 下面一段程序表明当拖动进入一控制面板时拖动被取消。 procedure TForm1.Panel1DragOver(Sender, Source: TObjectX, Y: IntegerState: TDragStatevar Accept: Boolean)begin Accept := Falseif (Source is TLabel) and (State = dsDragEnter) then (Source as TLabel).EndDrag(False)
end●Draging方法判断一个控件是否正被拖动。在下面的例子中当用户拖动不同的检查框 时窗口改变为不同的颜色。 procedure TForm1.FormActivate(Sender: TObject)begin CheckBox1.DragMode := dmAutomaticCheckBox2.DragMode := dmAutomaticCheckBox3.DragMode := dmAutomaticendprocedure TForm1.FormDragOver(Sender, Source: TObjectX, Y: IntegerState: TDragStatevar Accept: Boolean)begin if CheckBox1.Dragging then Color := clAquaif CheckBox2.Dragging then Color := clYellowif CheckBox3.Dragging then Color := clLimeend本篇文章来源于 www.87717.com 原文链接:http://www.87717.com/delphi/delphi_9716_2.html
例子:
对于上述的鼠标 *** 作,我举一个例子。 例如模拟“鼠过留痕”(单击第一下鼠标,鼠标不管移动到哪里都会留下痕迹,单击第二下,就不再留下痕迹)。 unit Unit1
interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogstype TForm1=class(TForm) procedure FormCreate(Sender:TObject)procedure FormMouseDown(Sender:TObjectButtom:TMouseButtonShift:TShiftStateX,Y:Integer)procedure FormMouseUp(Sender:TObjectButtom:TMouseButtonShift:TShiftStateX,Y:Integer)private {Private declarations} public {Public declarations} endvar Form1:TForm1
implementation {$R *.DFM} var Canvas:TCanvas Flag:Booleanprocedure TForm1.FormCreate(Sender:TObject)begin Flag:=Falseend
rocedure TForm1.FormMouseDown(Sender:TObjectButtom:TMouseButtonShift:TShiftStateX,Y:Integer)begin if Flag=False Then begin Canvas.MoveTo(X,Y)Flag:=Ture end else Flag:=falseend
rocedure TForm1.FormMouseUp(Sender:TObjectButtom:TMouseButtonShift:TShiftStateX,Y:Integer)begin if Flag=Ture Then begin Canvas.Pen.Color:=clBlackCanvas.LineTo(X,Y) endend
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 : booleanStartPoint, LastPoint : TPoint//记录鼠标按下的点和移动后的点 NowRect : TRect//组件对象的边框 procedure PrepareToMove(Sender: TObjectButton: TMouseButtonShift: TShiftStateX, Y: Integer)procedure Moving(Sender: TObjectShift: TShiftStateX, Y: Integer)procedure MoveEnd(Sender: TObjectButton: TMouseButtonShift: TShiftStateX, Y: Integer)public { Public declarations } end
rocedure TForm1.FormCreate(Sender: TObject)var s : stringi : integerTempLabel : TLabelbegin 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 * 50tempLabel.Left := 100 + i * 50tempLabel.Parent := Form1tempLabel.OnMouseDown := PrepareToMove//设置三个事件 tempLabel.OnMouseMove := MovingtempLabel.OnMouseUp := MoveEndlstMyRect.Add(tempLabel)endend
{当鼠标按下时,记录下开始点,并得到组件对象的边框,在移动的时候给用户以参照,并且把该边框画出}
rocedure TForm1.PrepareToMove(Sender: TObjectButton: TMouseButtonShift: TShiftStateX, Y: Integer)var TmpLabel : TLabelbegin TmpLabel := Sender as TLabelFlag_Dragging := TrueStartPoint := 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{当鼠标移动的时候,计算出移动的距离,消隐上一个位置的边框,计算新位置的边框并画出}
rocedure TForm1.Moving(Sender: TObjectShift: TShiftStateX,Y: Integer)var TmpLabel : TLabelDeltaX, DeltaY : integerbegin TmpLabel := Sender as TLabelif Flag_Dragging then begin DeltaX := X - LastPoint.X//计算移动的横纵距离 DeltaY := Y - LastPoint.YLastPoint := 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)endend
{当鼠标放开时,不用再画边框,直接计算释放处与开始处的距离,然后把组件对象移动过来}
rocedure TForm1.MoveEnd(Sender: TObjectButton: TMouseButtonShift: TShiftStateX, Y: Integer)var TmpLabel : TLabelDeltax, Deltay : integerbegin TmpLabel := Sender as TLabelif Flag_Dragging then begin Flag_Dragging := FalseLastPoint := Point(X, Y)Deltax := LastPoint.X - StartPoint.XDeltay := LastPoint.Y - StartPoint.YTmpLabel.Top := Deltay + TmpLabel.Top//重新设置组件对象的位置 TmpLabel.Left := Deltax + TmpLabel.Leftendend
第二种: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, ExtCtrl
type TForm1 = class(TForm) Panel1: TPanelPanel2: TPanelMemo1: TMemoImage1: TImageEdit1: TEditButton1: TButtonprocedure Panel1DragDrop(Sender, Source: TObjectX, Y: Integer)procedure Panel1DragOver(Sender, Source: TObjectX, Y: IntegerState: TDragStatevar Accept: Boolean)procedure Panel2DragDrop(Sender, Source: TObjectX, Y: Integer)procedure Panel2DragOver(Sender, Source: TObjectX, Y: IntegerState: TDragStatevar Accept: Boolean)procedure Button1StartDrag(Sender: TObjectvar DragObject: TDragObject)procedure Image1StartDrag(Sender: TObjectvar DragObject: TDragObject)procedure Edit1StartDrag(Sender: TObjectvar DragObject: TDragObject)private { Private declarations } obj :Stringpublic { Public declarations } end
var Form1: TForm1
implementatio
{$R *.dfm}
rocedure TForm1.Panel1DragDrop(Sender, Source: TObjectX, Y: Integer)begin if obj = 'btn' then begin button1.Left :=xbutton1.Top :=ybutton1.Parent :=panel2end
if obj = 'edit' then begin edit1.Left :=xedit1.Top :=yedit1.Parent :=PANEL1end
if obj='img' then begin image1.left :=ximage1.Top:=yimage1.Parent :=panel1endmemo1.Lines.Add('Panel1 - drop' +IntToStr(x)+'='+IntToStr(y))end
rocedure TForm1.Panel1DragOver(Sender, Source: TObjectX, Y: IntegerState: TDragStatevar Accept: Boolean)begin Accept :=trueMemo1.Lines.Add('Panel1 - over' +IntToStr(x) +'='+IntToStr(y))end
rocedure TForm1.Panel2DragDrop(Sender, Source: TObjectX, Y: Integer)begin if obj = 'btn' then begin button1.Left :=xbutton1.Top :=ybutton1.Parent :=panel2end
if obj = 'edit' then begin edit1.Left :=xedit1.Top :=yedit1.Parent :=PANEL2end
if obj='img' then begin image1.left :=ximage1.Top:=yimage1.Parent :=panel2endmemo1.Lines.Add('Panel2 - drop' +inttostr(x)+'='+inttostr(y))end
rocedure TForm1.Panel2DragOver(Sender, Source: TObjectX, Y: IntegerState: TDragStatevar Accept: Boolean)begin Accept :=trueMemo1.Lines.Add('Panel2 - over' +IntToStr(x) +'='+IntToStr(y))end
rocedure TForm1.Button1StartDrag(Sender: TObjectvar DragObject: TDragObject)begin obj :='btn'// ShowMessage('Start Drag')end
rocedure TForm1.Image1StartDrag(Sender: TObjectvar DragObject: TDragObject)begin obj :='img'end
rocedure TForm1.Edit1StartDrag(Sender: TObjectvar DragObject: TDragObject)begin obj :='edit'end
end.
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)