VB备忘录（13） 鼠标键盘

鼠标

改变光标

LoadCursorFromFile  载入光标图形，返回一个句柄。（这个句柄用SetClassLong，可以将其设置为某个对象中的光标）

DestoryCursor              卸载光标句柄，用默认

SetClassLong               设置目的对象内的光标

Option ExplicitPrivate Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As LongPrivate Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As LongPrivate Const GCL_HCURSOR = (-12)    '指向这个类窗口默认光标的句柄,用括号防止减号与负号的混淆Dim AniCur As LongPrivate Sub Command1_Click()    AniCur = LoadCursorFromFile("D:\SoftDev\22个漂亮动画光标\026.ani") '根据文件创建一个鼠标指针，返回该指针的句柄    SetClassLong Me.hwnd, GCL_HCURSOR, AniCur     '在窗体上设置这个句柄为当前鼠标指针（形状）End SubPrivate Sub Form_Unload(Cancel As Integer)    DestroyCursor AniCur   '删除创建的指针End Sub

鼠标的常数：Button来标明是哪个键   vbLeftButton(1),   vbRightButton(2),   vbMiddleButton(4)

限定鼠标在范围内移动。

注意：若程序失误中，用程序快捷键停止调试，否则。。。。

Option ExplicitPrivate Declare Function ClipCursor Lib "user32" (lpRect As Any) As LongPrivate Type RECT    '用户自定义类型    Left As Long    Top As Long    Right As Long    Bottom As LongEnd TypeDim mouse As RECTPrivate 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 mouseEnd SubPrivate Sub Command2_Click()    Call UnMouseEnd SubPrivate Sub Form_Unload(Cancel As Integer)    Call UnMouseEnd SubPrivate 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 LongDim dy As LongDim l As LongDim t As Long'本例演示image1手动拖放Private Sub Form_Load() '保存原始位置    l = Image1.Left    t = Image1.Top    Command1.Visible = FalseEnd SubPrivate Sub Form_DragDrop(Source As Control, X As Single, Y As Single) '窗体上的拖放，是窗体在触发（不是控件）    Source.Move X - dx, Y - dyEnd SubPrivate Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '手动开始启动拖放    dx = X    dy = Y    Image1.Drag vbBeginDragEnd SubPrivate Sub Picture1_DragDrop(Source As Control, X As Single, 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 = TrueEnd SubPrivate 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 = FalseEnd Sub

内容的自动拖放

把一个控件内的内容播放至另一个控件内

窗体内把text1中的内容拖放到另一个text2中。（注意，按住Ctrl就会是复制，不按则是剪贴过来）

这个最简单：直接设置text1的OLEDragMode为Automatic（即起源自动），把text2的OLEDropMode设置为Automatic（即目的自动），

这样就完成 了自动 播放操作。有些没有这些属性的，须手动进行设置。

内容的手动拖动

这个最复杂，拖动的是内容，这个内容被看作对象即：DataObject

DataObject有OLEDrag,GetData,SetData,Clear等方法

内容手动拖放的事件有：

OLEDragDrop:  源内容放到目标内容时（视觉上是控件，这里用内容代）

OLEDragOver：源内容在另一内容上经过时

OLEStartDrag：OLEDrag执行时，或OLEdragMode设置为自动时，部件初始化操作发生。常用于指定源部件支持的数据格式和拖放效果

OLECompleteDrag：源部件放于目标部件时发生（并通知部件拖放操作被执行或取消（可在此事件中处理拖放结果，恢复资源等）

OLESetData：目标部件在DataObject对象上执行GetData方法时，但是还没有加载规定格式的数据时，在源部件上发生。

窗体上放两文本框，设置为手动

text1的OLEDragMode设置为自动，text2的OLeDropMOde设置为自动

Dim seleffect As Integer    '拖放效果Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)    If Text1.SelLength > 0 And Button > 0 Then        Text1.OLEDrag  '启动拖放    End IfEnd SubPrivate Sub Text1_OLECompleteDrag(Effect As Long)    If Effect = vbDropEffectMove Then  '移动方式时，源处清除        Text1.SelText = ""    End IfEnd SubPrivate Sub Text1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, 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 SelectEnd SubPrivate Sub Text1_OLESetData(Data As DataObject, DataFormat As Integer)    Data.SetData Text1.SelText, DataFormat '设置数据End SubPrivate Sub Text1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)    AllowedEffects = vbDropEffectCopy Or vbDropEffectMove    Data.Clear    Data.SetData , vbCFText '设置文本格式End SubPrivate Sub Text2_GotFocus()    Text2.SelLength = 0End SubPrivate Sub Text2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)    If Data.GetFormat(vbCFText) Then        Text2.SelText = Data.GetData(vbCFText) '取得数据        Effect = seleffect    Else        Effect = vbDropEffectNone  '非文本时拒绝    End IfEnd SubPrivate Sub Text2_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, 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 SelectEnd Sub