在Delphi中幾乎每個對象都具有反映鼠標控制的事件， 這些事件的主要功能包括改變鼠標指針的形狀，移動、觸發、拖動鼠標等。 鼠標控制的三個相關屬性是Cursor、DragCursor、DragMode； 鼠標(拖拽)控制的三個對象方法是BeginDrag、Dragging、EndDrag； 鼠標控制的七個事件包括OnDragDrop等。
壹、改變鼠標指針的形狀 改變鼠標指針的形狀在Windows環境下是不可缺少的功能。 當應用程序在執行壹個較長時間的指令或動作時， 我們可以改變鼠標指針的形狀來通知用戶程序執行的狀態， 等到執行的動作完成之後，再把鼠標指針的形狀變回來。 此外，在拖動的過程中我們也可以改變鼠標指針的形狀，使拖動的過程更加清楚。 在編輯過程中，我們可以用屬性Cursor和DragCursor改變鼠標指針的形狀， 前者是記錄鼠標指針在對象上出現的情況；後者是設定對象被拖動時鼠標指針的形狀。 對於這兩個屬性，Delphi提供了如下值供用戶選擇：cdDefault、crArrow、cdCross、crBeam、crSize等十幾個屬性值。
二、鼠標的移動 鼠標移動時會觸發事件OnMouseMove，語法如下： procedure ObjectMouseMove(Sender:TObject;Shift:TshiftState;X，Y:Integer) 其中參數Sender代表((目標對象))，參數Shift代表鼠標移動時需同時按下的組合鍵， 由{ssShift，ssAlt，ssCtrl，ssRight，ssLeft，ssMiddle，ssDouble}組成。 此外，我們也可以利用參數X和Y取得鼠標移動的坐標位置，通常我們使用OnMouseMove事件時，最重要的就是這兩個參數。
三、鼠標按鍵 鼠標按鍵在窗口環境中也是最重要的輸入方法之壹， 同時還可以配合Shift，Alt，Ctrl三個鍵而發揮不同的作用。 和鼠標按鍵有關的事件有OnMouseDown和OnMouseUp。 當用戶按下鼠標的壹個鍵後，會觸發OnMouseDown事件，其語法如下： procedure ObjectMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X，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:TObject;Var DragObject:TDragObject); （二）拖動中的事件 關於對象在拖動狀態的事件有兩個：OnDragDrop和OnDragOver。 假設把對象A拖動並放入對象B中，此時對象B的事件OnDragDrop會被觸發。其語法如下： procedure ObjectDragDrop(Sender，Source:TObject;X，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:TObject;X，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 := True; end else Accept := False
當Accept=True時，目標控件可以響應OnDragDrop事件，用於確定拖動被放下後程序 如何進行處理。 ●OnDragDrop事件處理過程的參數包括源控件和光標位置。這些信息可用於處理方式的確定。 本篇文章來源於 www.87717.com 原文鏈接：/delphi/delphi_9716.html ●OnEndDrag事件是在拖動操作結束後由源控件來進行響應的，用於源控件進行相應的 處理。拖動操作結束既包括拖動放下被接受，也包括用戶在壹個不能接受放下的控件上釋 放了鼠標。該事件處理過程的參數包括目標控件(Target)和放下位置的坐標。如果 Target=nil, 表示拖動項目沒有被任何控件接受。 在第3節將介紹的文件拖放移動、拖放拷貝操作中，如果操作成功，則文件列表框 應更新顯示內容。下面這段程序用於實現這壹功能。 procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer); begin if Target <> nil then FileList.Update; end; ●除以上介紹的三個事件外，還有壹個事件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: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := False; if (Source is TLabel) and (State = dsDragEnter) then (Source as TLabel).EndDrag(False)
end; ●Draging方法判斷壹個控件是否正被拖動。在下面的例子中當用戶拖動不同的檢查框 時窗口改變為不同的顏色。 procedure TForm1.FormActivate(Sender: TObject); begin CheckBox1.DragMode := dmAutomatic; CheckBox2.DragMode := dmAutomatic; CheckBox3.DragMode := dmAutomatic; end; procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin if CheckBox1.Dragging then Color := clAqua; if CheckBox2.Dragging then Color := clYellow; if CheckBox3.Dragging then Color := clLime; end; 本篇文章來源於 www.87717.com 原文鏈接：/delphi/delphi_9716_2.html
例子:
對於上述的鼠標操作，我舉壹個例子。 例如模擬“鼠過留痕”（單擊第壹下鼠標，鼠標不管移動到哪裏都會留下痕跡，單擊第二下，就不再留下痕跡）。 unit Unit1
interface uses Windows，Messages，SysUtils，Classes，Graphics，Controls，Forms，Dialogs; typeTForm1=class(TForm) 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} varCanvas:TCanvas;Flag:Boolean; procedure TForm1.FormCreate(Sender:TObject); beginFlag:=False; end
rocedure TForm1.FormMouseDown(Sender:TObject;Buttom:TMouseButton; Shift:TShiftState;X，Y:Integer); begin if Flag=False Thenbegin Canvas.MoveTo(X，Y); Flag:=Ture;endelse Flag:=false; end
rocedure TForm1.FormMouseUp(Sender:TObject;Buttom:TMouseButton; Shift:TShiftState;X，Y:Integer); beginif Flag=Ture Thenbegin 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
rocedure 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
{當鼠標按下時，記錄下開始點，並得到組件對象的邊框，在移動的時候給用戶以參照，並且把該邊框畫出}
rocedure 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; {當鼠標移動的時候，計算出移動的距離，消隱上壹個位置的邊框，計算新位置的邊框並畫出}
rocedure 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
{當鼠標放開時，不用再畫邊框，直接計算釋放處與開始處的距離，然後把組件對象移動過來}
rocedure 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中實現托拽 版權聲明：轉載時請以超鏈接形式標明文章原始出處和作者信息及本聲明 /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: TPanel; Panel2: TPanel; Memo1: TMemo; Image1: TImage; Edit1: TEdit; Button1: TButton; procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Panel2DragDrop(Sender, Source: TObject; X, Y: Integer); procedure Panel2DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Button1StartDrag(Sender: TObject; var DragObject: TDragObject); procedure Image1StartDrag(Sender: TObject; var DragObject: TDragObject); procedure Edit1StartDrag(Sender: TObject; var DragObject: TDragObject); private { Private declarations } obj :String; public { Public declarations } end
var Form1: TForm1
implementatio
{$R *.dfm}
rocedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); begin if obj = 'btn' then begin button1.Left :=x; button1.Top :=y; button1.Parent :=panel2; end
if obj = 'edit' then begin edit1.Left :=x; edit1.Top :=y; edit1.Parent :=PANEL1; end
if obj='img' then begin image1.left :=x; image1.Top:=y; image1.Parent :=panel1; end; memo1.Lines.Add('Panel1 - drop' +IntToStr(x)+'='+IntToStr(y)); end
rocedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept :=true; Memo1.Lines.Add('Panel1 - over' +IntToStr(x) +'='+IntToStr(y)); end
rocedure TForm1.Panel2DragDrop(Sender, Source: TObject; X, Y: Integer); begin if obj = 'btn' then begin button1.Left :=x; button1.Top :=y; button1.Parent :=panel2; end
if obj = 'edit' then begin edit1.Left :=x; edit1.Top :=y; edit1.Parent :=PANEL2; end
if obj='img' then begin image1.left :=x; image1.Top:=y; image1.Parent :=panel2; end; memo1.Lines.Add('Panel2 - drop' +inttostr(x)+'='+inttostr(y)); end
rocedure TForm1.Panel2DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept :=true; Memo1.Lines.Add('Panel2 - over' +IntToStr(x) +'='+IntToStr(y)); end
rocedure TForm1.Button1StartDrag(Sender: TObject;var DragObject: TDragObject); begin obj :='btn'; // ShowMessage('Start Drag'); end
rocedure TForm1.Image1StartDrag(Sender: TObject;var DragObject: TDragObject); begin obj :='img'; end
rocedure TForm1.Edit1StartDrag(Sender: TObject;var DragObject: TDragObject); begin obj :='edit'; end
end.