在Delphi中怎樣抓取鼠標(biāo)形狀
{鼠標(biāo)：右擊，左擊，單擊，雙擊，滾輪，拖曳} Delphi程序設(shè)計(jì)中的鼠標(biāo)控制 在Windows環(huán)境下，鼠標(biāo)和鍵盤是主要的輸入設(shè)備。
在Delphi中幾乎每個(gè)對(duì)象都具有反映鼠標(biāo)控制的事件， 這些事件的主要功能包括改變鼠標(biāo)指針的形狀，移動(dòng)、觸發(fā)、拖動(dòng)鼠標(biāo)等。 鼠標(biāo)控制的三個(gè)相關(guān)屬性是Cursor、DragCursor、DragMode； 鼠標(biāo)(拖拽)控制的三個(gè)對(duì)象方法是BeginDrag、Dragging、EndDrag； 鼠標(biāo)控制的七個(gè)事件包括OnDragDrop等。
一、改變鼠標(biāo)指針的形狀 改變鼠標(biāo)指針的形狀在Windows環(huán)境下是不可缺少的功能。 當(dāng)應(yīng)用程序在執(zhí)行一個(gè)較長(zhǎng)時(shí)間的指令或動(dòng)作時(shí)， 我們可以改變鼠標(biāo)指針的形狀來(lái)通知用戶程序執(zhí)行的狀態(tài)， 等到執(zhí)行的動(dòng)作完成之后，再把鼠標(biāo)指針的形狀變回來(lái)。 此外，在拖動(dòng)的過(guò)程中我們也可以改變鼠標(biāo)指針的形狀，使拖動(dòng)的過(guò)程更加清楚。 在編輯過(guò)程中，我們可以用屬性Cursor和DragCursor改變鼠標(biāo)指針的形狀， 前者是記錄鼠標(biāo)指針在對(duì)象上出現(xiàn)的情況；后者是設(shè)定對(duì)象被拖動(dòng)時(shí)鼠標(biāo)指針的形狀。 對(duì)于這兩個(gè)屬性，Delphi提供了如下值供用戶選擇：cdDefault、crArrow、cdCross、crBeam、crSize等十幾個(gè)屬性值。
二、鼠標(biāo)的移動(dòng) 鼠標(biāo)移動(dòng)時(shí)會(huì)觸發(fā)事件OnMouseMove，語(yǔ)法如下： procedure ObjectMouseMove(Sender:TObject;Shift:TshiftState;X，Y:Integer) 其中參數(shù)Sender代表((目標(biāo)對(duì)象))，參數(shù)Shift代表鼠標(biāo)移動(dòng)時(shí)需同時(shí)按下的組合鍵， 由{ssShift，ssAlt，ssCtrl，ssRight，ssLeft，ssMiddle，ssDouble}組成。 此外，我們也可以利用參數(shù)X和Y取得鼠標(biāo)移動(dòng)的坐標(biāo)位置，通常我們使用OnMouseMove事件時(shí)，最重要的就是這兩個(gè)參數(shù)。
三、鼠標(biāo)按鍵 鼠標(biāo)按鍵在窗口環(huán)境中也是最重要的輸入方法之一， 同時(shí)還可以配合Shift，Alt，Ctrl三個(gè)鍵而發(fā)揮不同的作用。 和鼠標(biāo)按鍵有關(guān)的事件有OnMouseDown和OnMouseUp。 當(dāng)用戶按下鼠標(biāo)的一個(gè)鍵后，會(huì)觸發(fā)OnMouseDown事件，其語(yǔ)法如下： procedure ObjectMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X，Y:Integer); 參數(shù)Button指出按下的鼠標(biāo)鍵是哪一個(gè)，可以是{mbLeft，mbRight，mbMiddle}三者之一。 參數(shù)Shift可以反映按下的鍵盤鍵與鼠標(biāo)的關(guān)系， 其值是由{ssShift，ssAlt，ssCtrl，ssLeft，ssRight，ssMiddle，ssDouble}所組合而成的集合， 這些參數(shù)值分別代表Shift，Alt，Ctrl鍵、鼠標(biāo)的左、中、右鍵，及同時(shí)按下左右鍵。 例如，同時(shí)按下鼠標(biāo)的右鍵和Alt鍵，參數(shù)Shift的值就是{ssAlt，ssRight}。
四、鼠標(biāo)的拖動(dòng)（細(xì)節(jié)） （一）啟動(dòng)拖動(dòng)狀態(tài) 拖動(dòng)狀態(tài)的方式及啟動(dòng)是根據(jù)屬性DragMode值的設(shè)定而決定的，可以分成兩類情況： 1．不必程序控制 如果DragMode的值是dmAutomatic，當(dāng)鼠標(biāo)左鍵一按，對(duì)象就自動(dòng)進(jìn)入拖動(dòng)狀態(tài)。 2．需要程序控制 如果DragMode的值是dmManual，要使對(duì)象進(jìn)入拖動(dòng)狀態(tài)，可以調(diào)用方法BeginDrag。 此外，Delphi提供一個(gè)對(duì)象方法Dragging，讓程序判斷對(duì)象是否進(jìn)入拖動(dòng)狀態(tài)。 如果返回值是TRUE，代表已進(jìn)入拖動(dòng)狀態(tài)，否則就是沒(méi)有。 要使對(duì)象進(jìn)入拖動(dòng)狀態(tài)，可以調(diào)用對(duì)象方法BeginDrag。 當(dāng)對(duì)象進(jìn)入拖動(dòng)狀態(tài)時(shí)，事件OnStartDrag會(huì)被觸發(fā)，有關(guān)語(yǔ)法如下： 對(duì)象方法Dragging語(yǔ)法如下： function Dragging:Boolean; 對(duì)象方法BeginDrag語(yǔ)法如下： Procedure BeginDrag(Immediate:Boolean); 事件OnStartDrag語(yǔ)法如下： Procedure ObjectStartDrag(Sender:TObject;Var DragObject:TDragObject); （二）拖動(dòng)中的事件 關(guān)于對(duì)象在拖動(dòng)狀態(tài)的事件有兩個(gè)：OnDragDrop和OnDragOver。 假設(shè)把對(duì)象A拖動(dòng)并放入對(duì)象B中，此時(shí)對(duì)象B的事件OnDragDrop會(huì)被觸發(fā)。其語(yǔ)法如下： procedure ObjectDragDrop(Sender，Source:TObject;X，Y:Integer); 參數(shù)Sender和Source分別代表目標(biāo)對(duì)象B及被拖動(dòng)的對(duì)象A， 參數(shù)X，Y代表拖動(dòng)結(jié)束時(shí)的位置坐標(biāo)，此坐標(biāo)是以目標(biāo)對(duì)象的坐標(biāo)為參考的， 而實(shí)際上拖動(dòng)中的對(duì)象并不是真的移動(dòng)，所以以X，Y的值將對(duì)象移到新的位置。 (三)停止拖動(dòng) 如果要停止拖動(dòng)，可以使用對(duì)象方法EndDrag來(lái)完成；其語(yǔ)法如下： procedure ObjectEndDrag(Drop:Boolean); 參數(shù)Drop若是Ture，被拖動(dòng)的對(duì)象將被放置于與目前所在的位置； 否則，對(duì)象的拖動(dòng)就被放棄，而回到原來(lái)的位置。 例如下面的程序段就代表對(duì)象Lable1放棄拖動(dòng)，并恢復(fù)原狀： Lable1.EndDrag(False); 而停止拖動(dòng)會(huì)觸發(fā)事件OnEndDrag，其語(yǔ)法如下： Procedure ObjectEndDrag(Sender，Target:TObject;X，Y:Integer); 不管是放棄拖動(dòng)或是對(duì)象已經(jīng)拖動(dòng)到目標(biāo)對(duì)象，均會(huì)觸發(fā)這個(gè)事件。 參數(shù)Sender和Target分別指向被拖動(dòng)對(duì)象(源)及目標(biāo)對(duì)象，但是如果拖動(dòng)沒(méi)有成功，則Target值為nil。
補(bǔ)充： DELPHI中拖放的操作
拖放(DragDrop)是Windows提供的一種快捷的操作方式。作為基于Windows的開(kāi)發(fā)工 具，Delphi同樣支持拖放操作，而且開(kāi)發(fā)應(yīng)用系統(tǒng)的拖放功能十分方便，真正體現(xiàn)了 Delphi 的強(qiáng)大功能和方便性。 Delphi提供的所有控件(Control，即能獲得輸入焦點(diǎn)的部件)都支持拖放操作，并有 相應(yīng)的拖放屬性、拖放事件和拖放方法。下面我們先介紹控件的拖放支持，而后再給出開(kāi) 發(fā)拖放操作的一般步驟和應(yīng)用實(shí)例。 9.1 控件的拖放支持 拖放操作中控件可以分為源控件和目標(biāo)控件兩類。絕大部分控件既可以作為源控件 也可以作為目標(biāo)控件。但也有一部分控件只能支持其中的一種。 9.1.1拖放屬性 拖放屬性主要有兩個(gè)： ●DragMode：拖動(dòng)模式 它們都是在拖放的源控件中設(shè)置。DragMode控制用戶在運(yùn)行時(shí)間內(nèi)當(dāng)在控件上按 下鼠標(biāo)時(shí)控件如何反應(yīng)。 如果DragMode置為dmAutomatic，那么當(dāng)用戶在控件上按下鼠 標(biāo)時(shí)拖動(dòng)自動(dòng)開(kāi)始； 如果DragMode置為dmManual(這是缺省值)，則將通過(guò)處理鼠標(biāo)事件 來(lái)判斷一個(gè)拖動(dòng)是否可以開(kāi)始。 ●DragCursor 用于選擇拖動(dòng)時(shí)顯示的光標(biāo)，缺省值是CrDrag，一般不要去修改它。 在程序設(shè)計(jì)過(guò)程中通用的界面規(guī)范應(yīng)該得到開(kāi)發(fā)者的尊重。但有時(shí)候?yàn)榱颂囟ǖ哪康模?開(kāi)發(fā)者也可以把自己設(shè)計(jì)的光標(biāo)賦給DragCursor。 9.1.2拖放事件 拖放事件主要有三個(gè)(?)： ●OnDragOver：拖動(dòng)經(jīng)過(guò)時(shí)激發(fā) ●OnDragDrop：拖動(dòng)放下時(shí)激發(fā) ●OnEndDrag：拖動(dòng)結(jié)束時(shí)激發(fā) ●OnStartDrag：拖動(dòng)開(kāi)始時(shí)激發(fā)(?) 前兩個(gè)事件由目標(biāo)控件響應(yīng)，后一個(gè)事件由源控件響應(yīng)。 ●OnDragOver事件最主要的功能是確定當(dāng)用戶就地放下拖動(dòng)時(shí)控件是否可以接受。 它的參數(shù)包括： Source：TObject； {源控件} X，Y：Integer; {光標(biāo)位置} State：TDragState；{拖動(dòng)狀態(tài)} var Accept：Boolean {能否接受} ●TDragState是一個(gè)枚舉類型，表示拖放項(xiàng)目與目標(biāo)控件的關(guān)系。 type TDragState = (dsDragEnter, dsDragLeave, dsDragMove); 不同取值的意義如下表： 表9.1 DragState的取值與意義 ━━━━━━━━━━━━━━━━━━━━━━━━━━━ 取值意義 ─────────────────────────── dsDragEnter拖動(dòng)對(duì)象進(jìn)入一個(gè)允許拖動(dòng)對(duì)象放的控件中。為缺省狀態(tài)。 dsDragLeave拖動(dòng)對(duì)象離開(kāi)一個(gè)允許拖動(dòng)對(duì)象放下的控件。 dsDragMove拖動(dòng)對(duì)象在一個(gè)允許拖動(dòng)對(duì)象放下的控件內(nèi)移動(dòng)。 ━━━━━━━━━━━━━━━━━━━━━━━━━━━ 用戶可以利用提供的參數(shù)來(lái)確定放下的拖動(dòng)是否可被接受，如：
●判斷源控件類型： Accept := Source is TLabel; ●判斷源控件對(duì)象： Accept := (Source = TabSet1); ●判斷光標(biāo)位置： 見(jiàn)(9.2),(9.3)中的例程。 ●判斷拖動(dòng)狀態(tài)： If (Source is TLabel) and (State = dsDragMove) then begin source.DragIcon := ' New.Ico '; Accept := True; end else Accept := False
當(dāng)Accept=True時(shí)，目標(biāo)控件可以響應(yīng)OnDragDrop事件，用于確定拖動(dòng)被放下后程序 如何進(jìn)行處理。 ●OnDragDrop事件處理過(guò)程的參數(shù)包括源控件和光標(biāo)位置。這些信息可用于處理方式的確定。 本篇文章來(lái)源于 www.87717.com 原文鏈接：http://www.87717.com/delphi/delphi_9716.html ●OnEndDrag事件是在拖動(dòng)操作結(jié)束后由源控件來(lái)進(jìn)行響應(yīng)的，用于源控件進(jìn)行相應(yīng)的 處理。拖動(dòng)操作結(jié)束既包括拖動(dòng)放下被接受，也包括用戶在一個(gè)不能接受放下的控件上釋 放了鼠標(biāo)。該事件處理過(guò)程的參數(shù)包括目標(biāo)控件(Target)和放下位置的坐標(biāo)。如果 Target=nil, 表示拖動(dòng)項(xiàng)目沒(méi)有被任何控件接受。 在第3節(jié)將介紹的文件拖放移動(dòng)、拖放拷貝操作中，如果操作成功，則文件列表框 應(yīng)更新顯示內(nèi)容。下面這段程序用于實(shí)現(xiàn)這一功能。 procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer); begin if Target <> nil then FileList.Update; end; ●除以上介紹的三個(gè)事件外，還有一個(gè)事件OnMouseDown也常用于拖放操作的響應(yīng)。 OnMouseDown雖然不是一個(gè)專門的拖放事件，但在人工模式下拖動(dòng)的開(kāi)始是在這一 事件的處理過(guò)程中實(shí)現(xiàn)的。 9.1.3拖放方法:人工方式 拖放方法有三個(gè)： ●BeginDrag：人工方式下開(kāi)始一個(gè)拖動(dòng) ●EndDrag：結(jié)束一個(gè)拖動(dòng) ●Dragging：判斷一個(gè)控件是否正被拖動(dòng) 這三個(gè)方法都被源控件使用。 當(dāng)DragMode置為dmManual時(shí)，拖動(dòng)必須調(diào)用控件的BeginDrag方法才能開(kāi)始。 ●BeginDrag有一個(gè)布爾參數(shù)Immediate。如果輸入?yún)?shù)為True，拖動(dòng)立即開(kāi)始，光標(biāo) 改變到DragCursor的設(shè)置。如果輸入?yún)?shù)為False，直到用戶將光標(biāo)移動(dòng)了一定的距離 (5個(gè)象素點(diǎn))后才改變光標(biāo)，開(kāi)始拖動(dòng)。這就允許控件接受一個(gè)OnClick事件而并不開(kāi)始 拖動(dòng)操作。 ●EndDrag方法中止一個(gè)對(duì)象的被拖動(dòng)狀態(tài)。它有一個(gè)布爾參數(shù)Drop。如果Drop設(shè)置 為True，被拖動(dòng)的對(duì)象在當(dāng)前位置放下(能否被接受由目標(biāo)控件決定)；如果Drop設(shè)置 為False，則拖動(dòng)就地被取消。 下面一段程序表明當(dāng)拖動(dòng)進(jìn)入一控制面板時(shí)拖動(dòng)被取消。 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方法判斷一個(gè)控件是否正被拖動(dòng)。在下面的例子中當(dāng)用戶拖動(dòng)不同的檢查框 時(shí)窗口改變?yōu)椴煌念伾?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; 本篇文章來(lái)源于 www.87717.com 原文鏈接：http://www.87717.com/delphi/delphi_9716_2.html
例子:
對(duì)于上述的鼠標(biāo)操作，我舉一個(gè)例子。 例如模擬“鼠過(guò)留痕”（單擊第一下鼠標(biāo)，鼠標(biāo)不管移動(dòng)到哪里都會(huì)留下痕跡，單擊第二下，就不再留下痕跡）。 unit Unit1
interface uses Windows，Messages，SysUtils，Classes，Graphics，Controls，F(xiàn)orms，Dialogs; type TForm1=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} var Canvas:TCanvas; Flag:Boolean; procedure TForm1.FormCreate(Sender:TObject); begin Flag:=False; end
rocedure 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
rocedure 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.
兩種方式實(shí)現(xiàn)拖曳：用七個(gè)事件分裂成兩種方法（七武器） //第一種：onmousedown，onmouseup，onmousemove //第二種：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver
第一種：onmousedown，onmouseup，onmousemove { 2008-06-28 20:00 onmousedown，onmouseup和onmousemove
delphi下如何實(shí)現(xiàn)動(dòng)態(tài)對(duì)象的拖拽 昨天上午寫了一個(gè)小程序，模仿delphi設(shè)計(jì)階段組件的拖拽，實(shí)現(xiàn)了動(dòng)態(tài)創(chuàng)建對(duì)象的拖拽。 首先動(dòng)態(tài)創(chuàng)建三個(gè)TLabel對(duì)象，并且保存到TList中，分別設(shè)置他們的onmousedown，onmouseup和onmousemove事件。 } type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } lstMyRect : TList; //類似于控件數(shù)組 Flag_Dragging : boolean; StartPoint, LastPoint : TPoint; //記錄鼠標(biāo)按下的點(diǎn)和移動(dòng)后的點(diǎn) NowRect : TRect; //組件對(duì)象的邊框 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; //動(dòng)態(tài)創(chuàng)建TLabel對(duì)象，并保存 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; //設(shè)置三個(gè)事件 tempLabel.OnMouseMove := Moving; tempLabel.OnMouseUp := MoveEnd; lstMyRect.Add(tempLabel); end; end
{當(dāng)鼠標(biāo)按下時(shí)，記錄下開(kāi)始點(diǎn)，并得到組件對(duì)象的邊框，在移動(dòng)的時(shí)候給用戶以參照，并且把該邊框畫(huà)出}
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; {當(dāng)鼠標(biāo)移動(dòng)的時(shí)候，計(jì)算出移動(dòng)的距離，消隱上一個(gè)位置的邊框，計(jì)算新位置的邊框并畫(huà)出}
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; //計(jì)算移動(dòng)的橫縱距離 DeltaY := Y - LastPoint.Y; LastPoint := Point(X, Y); //保存新點(diǎn) Form1.Canvas.DrawFocusRect(NowRect); //消隱上一個(gè)位置的邊框 NowRect := Rect(NowRect.Left + DeltaX, NowRect.Top + DeltaY, NowRect.Right + DeltaX, NowRect.Bottom + DeltaY);//計(jì)算新邊框的位置 Form1.Canvas.DrawFocusRect(NowRect); end; end
{當(dāng)鼠標(biāo)放開(kāi)時(shí)，不用再畫(huà)邊框，直接計(jì)算釋放處與開(kāi)始處的距離，然后把組件對(duì)象移動(dòng)過(guò)來(lái)}
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; //重新設(shè)置組件對(duì)象的位置 TmpLabel.Left := Deltax + TmpLabel.Left; end; end
第二種：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver { 2008-06-28 20:08
OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver
在delphi中實(shí)現(xiàn)托拽 版權(quán)聲明：轉(zhuǎn)載時(shí)請(qǐng)以超鏈接形式標(biāo)明文章原始出處和作者信息及本聲明 http://kris.blogbus.com/logs/31441.html 我的理解是這樣的,OnStartDrag-->OnDragOver-->OnDragDrop 開(kāi)始拉,然后是在control的上面拉,最后是放下, 其中Drop處,對(duì)應(yīng)的是最后被托拽物體所要釋放到的control名(即是Target), 要把物體的parent設(shè)成對(duì)應(yīng)的Control名,否則無(wú)法實(shí)現(xiàn)drag, 另外在Over事件中,要求把Accept變量設(shè)成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.
調(diào)用GetCursorInfo方法
憑翠13925767562： 在Delphi中如何自定義自己的鼠標(biāo)指針 -
云龍縣移動(dòng)： ______ 1、先建立你自己的資源文件.如Cursor.res, 把你的光標(biāo)加入到資源文件里. 2、在你的APPLICATION里面加入編譯指示器{$R Cursor.res} 3、Screen.Cursors[cursor1] := LoadCursor(HInstance, '光標(biāo)1') ...... Screen.Cursors[cursorN] := LoadCursor(HInstance, '光標(biāo)N') 4、剩下的就是調(diào)用光標(biāo)了.
憑翠13925767562： delphi中怎樣判斷鼠標(biāo)是否在panel范圍內(nèi)? panel里含有button等其他控件 -
云龍縣移動(dòng)： ______ 可以在將panel和他包含的每個(gè)其他控件的onMouseMove設(shè)置為同一個(gè)事件,一起判斷既可
憑翠13925767562： delphi 怎樣抓取部分屏幕 -
云龍縣移動(dòng)： ______ procedure TForm1.Button1Click(Sender: TObject); var C:TCanvas; B:TBitmap; begin B :=TBitmap.Create; C :=TCanvas.Create; try// 設(shè)置Bitmap的大小 B.Width := Screen.Width; B.Height := Screen.Height;// 取屏幕的設(shè)備上下文句柄并拷貝 C....
憑翠13925767562： 21Delphi中如何將鼠標(biāo)限定在一定的范圍內(nèi)? -
云龍縣移動(dòng)： ______ 使用Windows API函數(shù) ClipCursor, 可以限制鼠標(biāo)在屏幕中指定的矩形范圍里移動(dòng): 函數(shù)功能;該函數(shù)把光標(biāo)限制在屏幕上的一個(gè)矩形區(qū)域內(nèi),如果調(diào)用SetCursor或用鼠標(biāo)設(shè)置的一個(gè)隨后的光標(biāo)位置在該矩形區(qū)域的外面,則系統(tǒng)自動(dòng)調(diào)整該位...
憑翠13925767562： 在Delphi中如何自定義自己的鼠標(biāo)指針?
云龍縣移動(dòng)： ______ 先用image editor 創(chuàng)建 MyCursor.rescode:crMyCursor = 1; Button1.Cursor := crMyCursor;//指定Button1的cursor為自訂鼠標(biāo)varForm1: TForm1;{$R mycursor.res}//這行$R弗成少, 不然自訂的鼠游標(biāo)就出不來(lái)了implementation{$R *.DFM}//將鼠標(biāo)資...
憑翠13925767562： delphi 怎么檢測(cè)鼠標(biāo)坐標(biāo)
云龍縣移動(dòng)： ______ 在窗體的OnMouseMove時(shí)間中寫入下列代碼,就可以隨時(shí)監(jiān)控鼠標(biāo)坐標(biāo)了: var P : TPoint; GetCursorPos(P);//得到鼠標(biāo)坐標(biāo) label1.Caption := inttostr(p.X) + ' ,' + inttostr(p.Y);//label控件顯示鼠標(biāo)坐標(biāo)
憑翠13925767562： Delphi中如何在自己的程序中處理鼠標(biāo)鉤子返回的系統(tǒng)信息? -
云龍縣移動(dòng)： ______ 你在掛鉤的時(shí)候,需要提供一個(gè)函數(shù)啊,那個(gè)自己的鼠標(biāo)函數(shù)里面就可以獲取鼠標(biāo)的信息.
憑翠13925767562： delphi 如何顯示自定義鼠標(biāo)指針? -
云龍縣移動(dòng)： ______ 主程序單元:uses Forms, Windows,//Added Main in 'Main.pas' ;{$R *.RES} //Addedbegin Application.Initialize; Screen.Cursors LoadCursor(hInstance,'MYCUR1');//Added Application.CreateForm(TForm1, Form1); Application.Run;end.然后把你的...
憑翠13925767562： delphi7如何獲取鼠標(biāo)當(dāng)前的坐標(biāo)
云龍縣移動(dòng)： ______ var P:TPoint; begin GetCursorPos(P); Edit1.Text:='IntToStr(P.X); Edit2.Text:=IntToStr(P.Y); end;
在Delphi中幾乎每個(gè)對(duì)象都具有反映鼠標(biāo)控制的事件， 這些事件的主要功能包括改變鼠標(biāo)指針的形狀，移動(dòng)、觸發(fā)、拖動(dòng)鼠標(biāo)等。 鼠標(biāo)控制的三個(gè)相關(guān)屬性是Cursor、DragCursor、DragMode； 鼠標(biāo)(拖拽)控制的三個(gè)對(duì)象方法是BeginDrag、Dragging、EndDrag； 鼠標(biāo)控制的七個(gè)事件包括OnDragDrop等。
一、改變鼠標(biāo)指針的形狀 改變鼠標(biāo)指針的形狀在Windows環(huán)境下是不可缺少的功能。 當(dāng)應(yīng)用程序在執(zhí)行一個(gè)較長(zhǎng)時(shí)間的指令或動(dòng)作時(shí)， 我們可以改變鼠標(biāo)指針的形狀來(lái)通知用戶程序執(zhí)行的狀態(tài)， 等到執(zhí)行的動(dòng)作完成之后，再把鼠標(biāo)指針的形狀變回來(lái)。 此外，在拖動(dòng)的過(guò)程中我們也可以改變鼠標(biāo)指針的形狀，使拖動(dòng)的過(guò)程更加清楚。 在編輯過(guò)程中，我們可以用屬性Cursor和DragCursor改變鼠標(biāo)指針的形狀， 前者是記錄鼠標(biāo)指針在對(duì)象上出現(xiàn)的情況；后者是設(shè)定對(duì)象被拖動(dòng)時(shí)鼠標(biāo)指針的形狀。 對(duì)于這兩個(gè)屬性，Delphi提供了如下值供用戶選擇：cdDefault、crArrow、cdCross、crBeam、crSize等十幾個(gè)屬性值。
二、鼠標(biāo)的移動(dòng) 鼠標(biāo)移動(dòng)時(shí)會(huì)觸發(fā)事件OnMouseMove，語(yǔ)法如下： procedure ObjectMouseMove(Sender:TObject;Shift:TshiftState;X，Y:Integer) 其中參數(shù)Sender代表((目標(biāo)對(duì)象))，參數(shù)Shift代表鼠標(biāo)移動(dòng)時(shí)需同時(shí)按下的組合鍵， 由{ssShift，ssAlt，ssCtrl，ssRight，ssLeft，ssMiddle，ssDouble}組成。 此外，我們也可以利用參數(shù)X和Y取得鼠標(biāo)移動(dòng)的坐標(biāo)位置，通常我們使用OnMouseMove事件時(shí)，最重要的就是這兩個(gè)參數(shù)。
三、鼠標(biāo)按鍵 鼠標(biāo)按鍵在窗口環(huán)境中也是最重要的輸入方法之一， 同時(shí)還可以配合Shift，Alt，Ctrl三個(gè)鍵而發(fā)揮不同的作用。 和鼠標(biāo)按鍵有關(guān)的事件有OnMouseDown和OnMouseUp。 當(dāng)用戶按下鼠標(biāo)的一個(gè)鍵后，會(huì)觸發(fā)OnMouseDown事件，其語(yǔ)法如下： procedure ObjectMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X，Y:Integer); 參數(shù)Button指出按下的鼠標(biāo)鍵是哪一個(gè)，可以是{mbLeft，mbRight，mbMiddle}三者之一。 參數(shù)Shift可以反映按下的鍵盤鍵與鼠標(biāo)的關(guān)系， 其值是由{ssShift，ssAlt，ssCtrl，ssLeft，ssRight，ssMiddle，ssDouble}所組合而成的集合， 這些參數(shù)值分別代表Shift，Alt，Ctrl鍵、鼠標(biāo)的左、中、右鍵，及同時(shí)按下左右鍵。 例如，同時(shí)按下鼠標(biāo)的右鍵和Alt鍵，參數(shù)Shift的值就是{ssAlt，ssRight}。
四、鼠標(biāo)的拖動(dòng)（細(xì)節(jié)） （一）啟動(dòng)拖動(dòng)狀態(tài) 拖動(dòng)狀態(tài)的方式及啟動(dòng)是根據(jù)屬性DragMode值的設(shè)定而決定的，可以分成兩類情況： 1．不必程序控制 如果DragMode的值是dmAutomatic，當(dāng)鼠標(biāo)左鍵一按，對(duì)象就自動(dòng)進(jìn)入拖動(dòng)狀態(tài)。 2．需要程序控制 如果DragMode的值是dmManual，要使對(duì)象進(jìn)入拖動(dòng)狀態(tài)，可以調(diào)用方法BeginDrag。 此外，Delphi提供一個(gè)對(duì)象方法Dragging，讓程序判斷對(duì)象是否進(jìn)入拖動(dòng)狀態(tài)。 如果返回值是TRUE，代表已進(jìn)入拖動(dòng)狀態(tài)，否則就是沒(méi)有。 要使對(duì)象進(jìn)入拖動(dòng)狀態(tài)，可以調(diào)用對(duì)象方法BeginDrag。 當(dāng)對(duì)象進(jìn)入拖動(dòng)狀態(tài)時(shí)，事件OnStartDrag會(huì)被觸發(fā)，有關(guān)語(yǔ)法如下： 對(duì)象方法Dragging語(yǔ)法如下： function Dragging:Boolean; 對(duì)象方法BeginDrag語(yǔ)法如下： Procedure BeginDrag(Immediate:Boolean); 事件OnStartDrag語(yǔ)法如下： Procedure ObjectStartDrag(Sender:TObject;Var DragObject:TDragObject); （二）拖動(dòng)中的事件 關(guān)于對(duì)象在拖動(dòng)狀態(tài)的事件有兩個(gè)：OnDragDrop和OnDragOver。 假設(shè)把對(duì)象A拖動(dòng)并放入對(duì)象B中，此時(shí)對(duì)象B的事件OnDragDrop會(huì)被觸發(fā)。其語(yǔ)法如下： procedure ObjectDragDrop(Sender，Source:TObject;X，Y:Integer); 參數(shù)Sender和Source分別代表目標(biāo)對(duì)象B及被拖動(dòng)的對(duì)象A， 參數(shù)X，Y代表拖動(dòng)結(jié)束時(shí)的位置坐標(biāo)，此坐標(biāo)是以目標(biāo)對(duì)象的坐標(biāo)為參考的， 而實(shí)際上拖動(dòng)中的對(duì)象并不是真的移動(dòng)，所以以X，Y的值將對(duì)象移到新的位置。 (三)停止拖動(dòng) 如果要停止拖動(dòng)，可以使用對(duì)象方法EndDrag來(lái)完成；其語(yǔ)法如下： procedure ObjectEndDrag(Drop:Boolean); 參數(shù)Drop若是Ture，被拖動(dòng)的對(duì)象將被放置于與目前所在的位置； 否則，對(duì)象的拖動(dòng)就被放棄，而回到原來(lái)的位置。 例如下面的程序段就代表對(duì)象Lable1放棄拖動(dòng)，并恢復(fù)原狀： Lable1.EndDrag(False); 而停止拖動(dòng)會(huì)觸發(fā)事件OnEndDrag，其語(yǔ)法如下： Procedure ObjectEndDrag(Sender，Target:TObject;X，Y:Integer); 不管是放棄拖動(dòng)或是對(duì)象已經(jīng)拖動(dòng)到目標(biāo)對(duì)象，均會(huì)觸發(fā)這個(gè)事件。 參數(shù)Sender和Target分別指向被拖動(dòng)對(duì)象(源)及目標(biāo)對(duì)象，但是如果拖動(dòng)沒(méi)有成功，則Target值為nil。
補(bǔ)充： DELPHI中拖放的操作
拖放(DragDrop)是Windows提供的一種快捷的操作方式。作為基于Windows的開(kāi)發(fā)工 具，Delphi同樣支持拖放操作，而且開(kāi)發(fā)應(yīng)用系統(tǒng)的拖放功能十分方便，真正體現(xiàn)了 Delphi 的強(qiáng)大功能和方便性。 Delphi提供的所有控件(Control，即能獲得輸入焦點(diǎn)的部件)都支持拖放操作，并有 相應(yīng)的拖放屬性、拖放事件和拖放方法。下面我們先介紹控件的拖放支持，而后再給出開(kāi) 發(fā)拖放操作的一般步驟和應(yīng)用實(shí)例。 9.1 控件的拖放支持 拖放操作中控件可以分為源控件和目標(biāo)控件兩類。絕大部分控件既可以作為源控件 也可以作為目標(biāo)控件。但也有一部分控件只能支持其中的一種。 9.1.1拖放屬性 拖放屬性主要有兩個(gè)： ●DragMode：拖動(dòng)模式 它們都是在拖放的源控件中設(shè)置。DragMode控制用戶在運(yùn)行時(shí)間內(nèi)當(dāng)在控件上按 下鼠標(biāo)時(shí)控件如何反應(yīng)。 如果DragMode置為dmAutomatic，那么當(dāng)用戶在控件上按下鼠 標(biāo)時(shí)拖動(dòng)自動(dòng)開(kāi)始； 如果DragMode置為dmManual(這是缺省值)，則將通過(guò)處理鼠標(biāo)事件 來(lái)判斷一個(gè)拖動(dòng)是否可以開(kāi)始。 ●DragCursor 用于選擇拖動(dòng)時(shí)顯示的光標(biāo)，缺省值是CrDrag，一般不要去修改它。 在程序設(shè)計(jì)過(guò)程中通用的界面規(guī)范應(yīng)該得到開(kāi)發(fā)者的尊重。但有時(shí)候?yàn)榱颂囟ǖ哪康模?開(kāi)發(fā)者也可以把自己設(shè)計(jì)的光標(biāo)賦給DragCursor。 9.1.2拖放事件 拖放事件主要有三個(gè)(?)： ●OnDragOver：拖動(dòng)經(jīng)過(guò)時(shí)激發(fā) ●OnDragDrop：拖動(dòng)放下時(shí)激發(fā) ●OnEndDrag：拖動(dòng)結(jié)束時(shí)激發(fā) ●OnStartDrag：拖動(dòng)開(kāi)始時(shí)激發(fā)(?) 前兩個(gè)事件由目標(biāo)控件響應(yīng)，后一個(gè)事件由源控件響應(yīng)。 ●OnDragOver事件最主要的功能是確定當(dāng)用戶就地放下拖動(dòng)時(shí)控件是否可以接受。 它的參數(shù)包括： Source：TObject； {源控件} X，Y：Integer; {光標(biāo)位置} State：TDragState；{拖動(dòng)狀態(tài)} var Accept：Boolean {能否接受} ●TDragState是一個(gè)枚舉類型，表示拖放項(xiàng)目與目標(biāo)控件的關(guān)系。 type TDragState = (dsDragEnter, dsDragLeave, dsDragMove); 不同取值的意義如下表： 表9.1 DragState的取值與意義 ━━━━━━━━━━━━━━━━━━━━━━━━━━━ 取值意義 ─────────────────────────── dsDragEnter拖動(dòng)對(duì)象進(jìn)入一個(gè)允許拖動(dòng)對(duì)象放的控件中。為缺省狀態(tài)。 dsDragLeave拖動(dòng)對(duì)象離開(kāi)一個(gè)允許拖動(dòng)對(duì)象放下的控件。 dsDragMove拖動(dòng)對(duì)象在一個(gè)允許拖動(dòng)對(duì)象放下的控件內(nèi)移動(dòng)。 ━━━━━━━━━━━━━━━━━━━━━━━━━━━ 用戶可以利用提供的參數(shù)來(lái)確定放下的拖動(dòng)是否可被接受，如：
●判斷源控件類型： Accept := Source is TLabel; ●判斷源控件對(duì)象： Accept := (Source = TabSet1); ●判斷光標(biāo)位置： 見(jiàn)(9.2),(9.3)中的例程。 ●判斷拖動(dòng)狀態(tài)： If (Source is TLabel) and (State = dsDragMove) then begin source.DragIcon := ' New.Ico '; Accept := True; end else Accept := False
當(dāng)Accept=True時(shí)，目標(biāo)控件可以響應(yīng)OnDragDrop事件，用于確定拖動(dòng)被放下后程序 如何進(jìn)行處理。 ●OnDragDrop事件處理過(guò)程的參數(shù)包括源控件和光標(biāo)位置。這些信息可用于處理方式的確定。 本篇文章來(lái)源于 www.87717.com 原文鏈接：http://www.87717.com/delphi/delphi_9716.html ●OnEndDrag事件是在拖動(dòng)操作結(jié)束后由源控件來(lái)進(jìn)行響應(yīng)的，用于源控件進(jìn)行相應(yīng)的 處理。拖動(dòng)操作結(jié)束既包括拖動(dòng)放下被接受，也包括用戶在一個(gè)不能接受放下的控件上釋 放了鼠標(biāo)。該事件處理過(guò)程的參數(shù)包括目標(biāo)控件(Target)和放下位置的坐標(biāo)。如果 Target=nil, 表示拖動(dòng)項(xiàng)目沒(méi)有被任何控件接受。 在第3節(jié)將介紹的文件拖放移動(dòng)、拖放拷貝操作中，如果操作成功，則文件列表框 應(yīng)更新顯示內(nèi)容。下面這段程序用于實(shí)現(xiàn)這一功能。 procedure TFMForm.FileListEndDrag(Sender, Target: TObject; X, Y: Integer); begin if Target <> nil then FileList.Update; end; ●除以上介紹的三個(gè)事件外，還有一個(gè)事件OnMouseDown也常用于拖放操作的響應(yīng)。 OnMouseDown雖然不是一個(gè)專門的拖放事件，但在人工模式下拖動(dòng)的開(kāi)始是在這一 事件的處理過(guò)程中實(shí)現(xiàn)的。 9.1.3拖放方法:人工方式 拖放方法有三個(gè)： ●BeginDrag：人工方式下開(kāi)始一個(gè)拖動(dòng) ●EndDrag：結(jié)束一個(gè)拖動(dòng) ●Dragging：判斷一個(gè)控件是否正被拖動(dòng) 這三個(gè)方法都被源控件使用。 當(dāng)DragMode置為dmManual時(shí)，拖動(dòng)必須調(diào)用控件的BeginDrag方法才能開(kāi)始。 ●BeginDrag有一個(gè)布爾參數(shù)Immediate。如果輸入?yún)?shù)為True，拖動(dòng)立即開(kāi)始，光標(biāo) 改變到DragCursor的設(shè)置。如果輸入?yún)?shù)為False，直到用戶將光標(biāo)移動(dòng)了一定的距離 (5個(gè)象素點(diǎn))后才改變光標(biāo)，開(kāi)始拖動(dòng)。這就允許控件接受一個(gè)OnClick事件而并不開(kāi)始 拖動(dòng)操作。 ●EndDrag方法中止一個(gè)對(duì)象的被拖動(dòng)狀態(tài)。它有一個(gè)布爾參數(shù)Drop。如果Drop設(shè)置 為True，被拖動(dòng)的對(duì)象在當(dāng)前位置放下(能否被接受由目標(biāo)控件決定)；如果Drop設(shè)置 為False，則拖動(dòng)就地被取消。 下面一段程序表明當(dāng)拖動(dòng)進(jìn)入一控制面板時(shí)拖動(dòng)被取消。 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方法判斷一個(gè)控件是否正被拖動(dòng)。在下面的例子中當(dāng)用戶拖動(dòng)不同的檢查框 時(shí)窗口改變?yōu)椴煌念伾?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; 本篇文章來(lái)源于 www.87717.com 原文鏈接：http://www.87717.com/delphi/delphi_9716_2.html
例子:
對(duì)于上述的鼠標(biāo)操作，我舉一個(gè)例子。 例如模擬“鼠過(guò)留痕”（單擊第一下鼠標(biāo)，鼠標(biāo)不管移動(dòng)到哪里都會(huì)留下痕跡，單擊第二下，就不再留下痕跡）。 unit Unit1
interface uses Windows，Messages，SysUtils，Classes，Graphics，Controls，F(xiàn)orms，Dialogs; type TForm1=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} var Canvas:TCanvas; Flag:Boolean; procedure TForm1.FormCreate(Sender:TObject); begin Flag:=False; end
rocedure 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
rocedure 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.
兩種方式實(shí)現(xiàn)拖曳：用七個(gè)事件分裂成兩種方法（七武器） //第一種：onmousedown，onmouseup，onmousemove //第二種：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver
第一種：onmousedown，onmouseup，onmousemove { 2008-06-28 20:00 onmousedown，onmouseup和onmousemove
delphi下如何實(shí)現(xiàn)動(dòng)態(tài)對(duì)象的拖拽 昨天上午寫了一個(gè)小程序，模仿delphi設(shè)計(jì)階段組件的拖拽，實(shí)現(xiàn)了動(dòng)態(tài)創(chuàng)建對(duì)象的拖拽。 首先動(dòng)態(tài)創(chuàng)建三個(gè)TLabel對(duì)象，并且保存到TList中，分別設(shè)置他們的onmousedown，onmouseup和onmousemove事件。 } type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } lstMyRect : TList; //類似于控件數(shù)組 Flag_Dragging : boolean; StartPoint, LastPoint : TPoint; //記錄鼠標(biāo)按下的點(diǎn)和移動(dòng)后的點(diǎn) NowRect : TRect; //組件對(duì)象的邊框 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; //動(dòng)態(tài)創(chuàng)建TLabel對(duì)象，并保存 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; //設(shè)置三個(gè)事件 tempLabel.OnMouseMove := Moving; tempLabel.OnMouseUp := MoveEnd; lstMyRect.Add(tempLabel); end; end
{當(dāng)鼠標(biāo)按下時(shí)，記錄下開(kāi)始點(diǎn)，并得到組件對(duì)象的邊框，在移動(dòng)的時(shí)候給用戶以參照，并且把該邊框畫(huà)出}
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; {當(dāng)鼠標(biāo)移動(dòng)的時(shí)候，計(jì)算出移動(dòng)的距離，消隱上一個(gè)位置的邊框，計(jì)算新位置的邊框并畫(huà)出}
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; //計(jì)算移動(dòng)的橫縱距離 DeltaY := Y - LastPoint.Y; LastPoint := Point(X, Y); //保存新點(diǎn) Form1.Canvas.DrawFocusRect(NowRect); //消隱上一個(gè)位置的邊框 NowRect := Rect(NowRect.Left + DeltaX, NowRect.Top + DeltaY, NowRect.Right + DeltaX, NowRect.Bottom + DeltaY);//計(jì)算新邊框的位置 Form1.Canvas.DrawFocusRect(NowRect); end; end
{當(dāng)鼠標(biāo)放開(kāi)時(shí)，不用再畫(huà)邊框，直接計(jì)算釋放處與開(kāi)始處的距離，然后把組件對(duì)象移動(dòng)過(guò)來(lái)}
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; //重新設(shè)置組件對(duì)象的位置 TmpLabel.Left := Deltax + TmpLabel.Left; end; end
第二種：OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver { 2008-06-28 20:08
OnStartDrag,OnEndDrag,OnDragDrop,OnDragOver
在delphi中實(shí)現(xiàn)托拽 版權(quán)聲明：轉(zhuǎn)載時(shí)請(qǐng)以超鏈接形式標(biāo)明文章原始出處和作者信息及本聲明 http://kris.blogbus.com/logs/31441.html 我的理解是這樣的,OnStartDrag-->OnDragOver-->OnDragDrop 開(kāi)始拉,然后是在control的上面拉,最后是放下, 其中Drop處,對(duì)應(yīng)的是最后被托拽物體所要釋放到的control名(即是Target), 要把物體的parent設(shè)成對(duì)應(yīng)的Control名,否則無(wú)法實(shí)現(xiàn)drag, 另外在Over事件中,要求把Accept變量設(shè)成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.
調(diào)用GetCursorInfo方法
DELPHI基礎(chǔ)教程:Delphi圖形圖像編程(一)[3]
響應(yīng)鼠標(biāo)事件 鼠標(biāo)常被用作繪圖的工具 應(yīng)用程序利用鼠標(biāo)位置的變化來(lái)繪制各種不同的圖形 鼠標(biāo)有三個(gè)動(dòng)作 鼠標(biāo)按鈕按下 鼠標(biāo)移動(dòng) 鼠標(biāo)按鈕彈起 在Delphi中 對(duì)應(yīng)三個(gè)動(dòng)作有三個(gè)不同的事件 OnMouseDown OnMouseMove OnMouseUp 當(dāng)Dlephi應(yīng)用程序探測(cè)到一個(gè)鼠標(biāo)動(dòng)作時(shí) 它傳遞五個(gè)參數(shù) 并調(diào)用相應(yīng)的事件響應(yīng) 程序...
delphi 組件屬性詳解 記得以前有一個(gè)小工具 鼠標(biāo)移動(dòng)到組件上能自動(dòng)查看...
DELPHI常見(jiàn)屬性說(shuō)明:ALIGN 設(shè)置組件對(duì)齊(同其父容器)方式BORDERSTYLE 設(shè)置組件邊框形狀CAPTION 設(shè)置組件標(biāo)題CTL3D 設(shè)置組件邊框是否為3D模式,若BORDERSTYLE設(shè)置為BSNONE則此屬性無(wú)效COLOR 設(shè)定組件背景顏色CURSOR 設(shè)定鼠標(biāo)經(jīng)過(guò)組件時(shí)光標(biāo)所顯示的形狀ENABLED 設(shè)定組件是否能使用,當(dāng)設(shè)為FALSE時(shí)組件會(huì)呈灰色FONT 設(shè)定組件內(nèi)文字...
delphi怎么取得鼠標(biāo)當(dāng)前的坐標(biāo)
寫在OnMouseDown事件上，不要寫在OnClick上。代碼如下（窗體名為Form1，編輯框?yàn)镋dit1)procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);begin Edit1.Text := 'X:' + IntToStr(X) + ' Y:' + IntToStr(Y);end;其實(shí)你需要寫的...
Delphi如何知道ListView中鼠標(biāo)下是哪項(xiàng)
procedure TForm2.lv1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);begin if lv1.GetItemAt(x,y)<>nil then Caption:=lv1.GetItemAt(x,y).Caption;end;
DELPHI中 screen.Cursor:=crhourglass; adoQuery.close; adoquery.O...
這段代碼大概是用來(lái)演示鼠標(biāo)的用法的。具體解釋如下：使鼠標(biāo)指針為沙漏狀。（以表示程序正忙）screen.Cursor:=crhourglass;把（打開(kāi)的）數(shù)據(jù)庫(kù)關(guān)閉。adoQuery.close;（個(gè)人以為改成這樣更好：if adoQuery.Active then adoAuery.close;）打開(kāi)數(shù)據(jù)庫(kù)。adoquery.Open;把鼠標(biāo)指針恢復(fù)成缺省狀態(tài)。screen.Cursor...
Delphi 中 鼠標(biāo)的移動(dòng)消息
SendInput( 1, @rInput, SizeOf( rInput ) ); \/\/ 發(fā)送消息（鼠標(biāo)）FillChar( rInput, SizeOf( rInput ), 0 );rInput.Itype := INPUT_KEYBOARD; \/\/ 鍵盤消息 rInput.ki.wVk := VK_LEFT; \/\/ 左箭頭的鍵碼 rInput.ki.dwFlags := KEYEVENTF_KEYUP; \/\/ 指示鍵被抬起，如沒(méi)有...
delphi怎樣寫鼠標(biāo)滑過(guò)label上方時(shí)變形的語(yǔ)句
看你的意思是想做網(wǎng)站鏈接 手型：把label的Cursor屬性設(shè)成crHandPoint就行了 procedure TForm1.Label7MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);begin \/\/鼠標(biāo)移動(dòng)到LABEL1控件上 Label7.Font.Style:=[fsunderline]; \/\/下劃線 Label7.Font.Color:=clmaroon;\/\/顏色 end;proc...
Delphi 截圖的問(wèn)題,有代碼,請(qǐng)高手幫幫
procedure TForm1.GetActiveWndImg;var C: TCanvas; b: TBitmap; H: HDC; R: TRect; hand: THandle;p: TPoint;J: TJpegImage;m, n: INTEGER;name: array[0..255] of char;begin B := TBitmap.Create;C := TCanvas.Create;GetCurSorPos(P); \/\/取得鼠標(biāo)所在區(qū)域坐標(biāo) Hand := ...
請(qǐng)問(wèn)一下在Delphi平臺(tái)下如何實(shí)現(xiàn)鼠標(biāo)單擊窗體某點(diǎn)時(shí),能把相應(yīng)的坐標(biāo)顯示...
Self.Edit1.Text := IntToStr(Mouse.CursorPos.X);Self.Edit2.Text := IntToStr(Mouse.CursorPos.Y);{ 其中Mouse是TMouse對(duì)象，TMouse類在classes里面聲明，Mouse對(duì)象的構(gòu)造也在Classes里面，所以可以直接使用 }
delphi中怎樣判斷鼠標(biāo)是否在panel范圍內(nèi)? panel里含有button等其他控 ...
你可以捕捉鼠標(biāo)在當(dāng)前界面或者窗體的位置，然后根據(jù)panel的top或者left去判斷
相關(guān)評(píng)說(shuō)：
云龍縣移動(dòng)： ______ 1、先建立你自己的資源文件.如Cursor.res, 把你的光標(biāo)加入到資源文件里. 2、在你的APPLICATION里面加入編譯指示器{$R Cursor.res} 3、Screen.Cursors[cursor1] := LoadCursor(HInstance, '光標(biāo)1') ...... Screen.Cursors[cursorN] := LoadCursor(HInstance, '光標(biāo)N') 4、剩下的就是調(diào)用光標(biāo)了.
云龍縣移動(dòng)： ______ 可以在將panel和他包含的每個(gè)其他控件的onMouseMove設(shè)置為同一個(gè)事件,一起判斷既可
云龍縣移動(dòng)： ______ procedure TForm1.Button1Click(Sender: TObject); var C:TCanvas; B:TBitmap; begin B :=TBitmap.Create; C :=TCanvas.Create; try// 設(shè)置Bitmap的大小 B.Width := Screen.Width; B.Height := Screen.Height;// 取屏幕的設(shè)備上下文句柄并拷貝 C....
云龍縣移動(dòng)： ______ 使用Windows API函數(shù) ClipCursor, 可以限制鼠標(biāo)在屏幕中指定的矩形范圍里移動(dòng): 函數(shù)功能;該函數(shù)把光標(biāo)限制在屏幕上的一個(gè)矩形區(qū)域內(nèi),如果調(diào)用SetCursor或用鼠標(biāo)設(shè)置的一個(gè)隨后的光標(biāo)位置在該矩形區(qū)域的外面,則系統(tǒng)自動(dòng)調(diào)整該位...
云龍縣移動(dòng)： ______ 先用image editor 創(chuàng)建 MyCursor.rescode:crMyCursor = 1; Button1.Cursor := crMyCursor;//指定Button1的cursor為自訂鼠標(biāo)varForm1: TForm1;{$R mycursor.res}//這行$R弗成少, 不然自訂的鼠游標(biāo)就出不來(lái)了implementation{$R *.DFM}//將鼠標(biāo)資...
云龍縣移動(dòng)： ______ 在窗體的OnMouseMove時(shí)間中寫入下列代碼,就可以隨時(shí)監(jiān)控鼠標(biāo)坐標(biāo)了: var P : TPoint; GetCursorPos(P);//得到鼠標(biāo)坐標(biāo) label1.Caption := inttostr(p.X) + ' ,' + inttostr(p.Y);//label控件顯示鼠標(biāo)坐標(biāo)
云龍縣移動(dòng)： ______ 你在掛鉤的時(shí)候,需要提供一個(gè)函數(shù)啊,那個(gè)自己的鼠標(biāo)函數(shù)里面就可以獲取鼠標(biāo)的信息.
云龍縣移動(dòng)： ______ 主程序單元:uses Forms, Windows,//Added Main in 'Main.pas' ;{$R *.RES} //Addedbegin Application.Initialize; Screen.Cursors LoadCursor(hInstance,'MYCUR1');//Added Application.CreateForm(TForm1, Form1); Application.Run;end.然后把你的...
云龍縣移動(dòng)： ______ var P:TPoint; begin GetCursorPos(P); Edit1.Text:='IntToStr(P.X); Edit2.Text:=IntToStr(P.Y); end;
