鼠标
改变光标
LoadCursorFromFile 载入光标图形,返回一个句柄。(这个句柄用SetClassLong,可以将其设置为某个对象中的光标)
DestoryCursor 卸载光标句柄,用默认
SetClassLong 设置目的对象内的光标
Option Explicit Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long,ByVal nIndex As Long,ByVal dwNewLong As Long) As Long Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long Private Const GCL_HCURSOR = (-12) '指向这个类窗口默认光标的句柄,用括号防止减号与负号的混淆 Dim AniCur As Long Private Sub Command1_Click() AniCur = LoadCursorFromFile("D:\SoftDev\22个漂亮动画光标\026.ani") '根据文件创建一个鼠标指针,返回该指针的句柄 SetClassLong Me.hwnd,GCL_HCURSOR,AniCur '在窗体上设置这个句柄为当前鼠标指针(形状) End Sub Private Sub Form_Unload(Cancel As Integer) DestroyCursor AniCur '删除创建的指针 End Sub
鼠标的常数:Button来标明是哪个键 vbLeftButton(1),vbRightButton(2),vbMiddleButton(4)
限定鼠标在范围内移动。
注意:若程序失误中,用程序快捷键停止调试,否则。。。。
Option Explicit Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long Private Type RECT '用户自定义类型 Left As Long Top As Long Right As Long Bottom As Long End Type Dim mouse As RECT Private Sub Command1_Click() '显示鼠标 mouse.Left = Me.Left / Screen.TwipsPerPixelX mouse.Top = Me.Top / Screen.TwipsPerPixelY mouse.Right = (Me.Left + Me.Width) / Screen.TwipsPerPixelX mouse.Bottom = (Me.Top + Me.Height) / Screen.TwipsPerPixelY ClipCursor mouse End Sub Private Sub Command2_Click() Call UnMouse End Sub Private Sub Form_Unload(Cancel As Integer) Call UnMouse End Sub Private Sub UnMouse() '解除锁定 mouse.Left = 0 mouse.Top = 0 mouse.Right = (Screen.Width) / Screen.TwipsPerPixelX mouse.Bottom = (Screen.Height) / Screen.TwipsPerPixelY ClipCursor mouse '整个屏幕的矩形 End Sub
设置KeyPreview,截获键盘,在其它控件前截获键盘事件(command例外)
command的default为真,接收回键触发,cancel为真接收ESC键触发
常数:vbKey
拖动
窗体内的控件可以拖动到另一位置,控件的内容也可以拖动到另一位置。
拖动有两种模式:手动拖动和自动拖动。 DragMode: 0-Manual,1-Automatic
拖动还有两个内容:控件或者内容。 这里分拖动起源的控件(OLEDragMode),拖动至目的地控件(OLEDropMode)
一直是Drag,一个是Drop,搞反了会出错。
手动时须代码进行激活拖动动作:
控件: Drag 动作 (一般是手动时用这个,自动亦可用)
动作有三种:0-vbDragCancel
1-vbDragBeginDrag
2-vbDragEndDrag
事件有:DragDrop(拖放放下时) DragOver(拖放经过时)
例: form1.drag vbdragbegindrag '开始拖动
当拖动控件时,该控件不能识别用户发出的其它鼠标或键盘事件(KeyDown、KeyPress 或 KeyUp,MouseDown、MouseMove 或 MouseUp)。
源:被拖动的控件称源控件
目:被放置的控件称为目控件
当源控件点击鼠标开始拖动时,会触发OLEstartDrag,然后是 drag,经过时dragover.
当源控件进入目的控件的方框内时,释放鼠标时,目的控件的drop就触发,若没进入方框内,窗体将成为目标。
控件的自动拖动
在窗体上添加command1,设置command1的dragmode为1(Automatic)即自动
Private Sub Form_DragDrop(Source As Control,X As Single,Y As Single) Source.Move (X - Source.Width / 2),(Y - Source.Height / 2) End Sub
控件的手动拖动
窗体上添加command1,image1,在右下角放picture1,分别弄上图片。
Dim dx As Long Dim dy As Long Dim l As Long Dim t As Long '本例演示image1手动拖放 Private Sub Form_Load() '保存原始位置 l = Image1.Left t = Image1.Top Command1.Visible = False End Sub Private Sub Form_DragDrop(Source As Control,Y As Single) '窗体上的拖放,是窗体在触发(不是控件) Source.Move X - dx,Y - dy End Sub Private Sub Image1_MouseDown(Button As Integer,Shift As Integer,Y As Single) '手动开始启动拖放 dx = X dy = Y Image1.Drag vbBeginDrag End Sub Private Sub Picture1_DragDrop(Source As Control,Y As Single) '手动停止拖放,承受者picture1在触发 Source.Drag vbEndDrag Source.Visible = False Picture1.Picture = LoadPicture("C:\Program Files\Microsoft Visual Studio\COMMON\Graphics\Icons\Computer\disk02.ico") Command1.Visible = True End Sub Private Sub Command1_Click() '恢复原状 Image1.Drag vbdragcancel Image1.Left = l Image1.Top = t Image1.Visible = True Image1.Picture = LoadPicture("C:\Program Files\Microsoft Visual Studio\COMMON\Graphics\Icons\Computer\disk03.ico") Picture1.Picture = LoadPicture("C:\Program Files\Microsoft Visual Studio\COMMON\Graphics\Icons\Computer\disk04.ico") Command1.Visible = False End Sub
把一个控件内的内容播放至另一个控件内
窗体内把text1中的内容拖放到另一个text2中。(注意,按住Ctrl就会是复制,不按则是剪贴过来)
这个最简单:直接设置text1的OLEDragMode为Automatic(即起源自动),把text2的OLEDropMode设置为Automatic(即目的自动),
这样就完成 了自动 播放操作。有些没有这些属性的,须手动进行设置。
内容的手动拖动
这个最复杂,拖动的是内容,这个内容被看作对象即:DataObject
DataObject有OLEDrag,GetData,SetData,Clear等方法
内容手动拖放的事件有:
OLEDragDrop: 源内容放到目标内容时(视觉上是控件,这里用内容代)
OLEStartDrag:OLEDrag执行时,或OLEdragMode设置为自动时,部件初始化操作发生。常用于指定源部件支持的数据格式和拖放效果
OLECompleteDrag:源部件放于目标部件时发生(并通知部件拖放操作被执行或取消(可在此事件中处理拖放结果,恢复资源等)
OLESetData:目标部件在DataObject对象上执行GetData方法时,但是还没有加载规定格式的数据时,在源部件上发生。
窗体上放两文本框,设置为手动
text1的OLEDragMode设置为自动,text2的OLeDropMOde设置为自动
Dim seleffect As Integer '拖放效果 Private Sub Text1_MouseUp(Button As Integer,Y As Single) If Text1.SelLength > 0 And Button > 0 Then Text1.OLEDrag '启动拖放 End If End Sub Private Sub Text1_OLECompleteDrag(Effect As Long) If Effect = vbDropEffectMove Then '移动方式时,源处清除 Text1.SelText = "" End If End Sub Private Sub Text1_OLEDragOver(Data As DataObject,Effect As Long,Button As Integer,Y As Single,State As Integer) Select Case Button Case 1 '左键 Effect = Effect And vbDropEffectMove Case 2 '右键 Effect = Effect And vbDropEffectCopy Case Is > 2 Effect = vbDropEffectNone Case Else seleffect = Effect End Select End Sub Private Sub Text1_OLESetData(Data As DataObject,DataFormat As Integer) Data.SetData Text1.SelText,DataFormat '设置数据 End Sub Private Sub Text1_OLEStartDrag(Data As DataObject,AllowedEffects As Long) AllowedEffects = vbDropEffectCopy Or vbDropEffectMove Data.Clear Data.SetData,vbCFText '设置文本格式 End Sub Private Sub Text2_GotFocus() Text2.SelLength = 0 End Sub Private Sub Text2_OLEDragDrop(Data As DataObject,Y As Single) If Data.GetFormat(vbCFText) Then Text2.SelText = Data.GetData(vbCFText) '取得数据 Effect = seleffect Else Effect = vbDropEffectNone '非文本时拒绝 End If End Sub Private Sub Text2_OLEDragOver(Data As DataObject,State As Integer) Select Case Button Case 1 Effect = Effect And vbDropEffectMove Case 2 Effect = Effect And vbDropEffectCopy Case Is > 2 Effect = vbDropEffectNone Case Else seleffect = Effect End Select End Sub