Question

VB代码 鼠标左击改为右击

设COMMAND1的功能为鼠标的右击变为左击，左击不变

COMMAND2为取消该功能。

Answer 1

在VB程序中实现鼠标右键双击

在Microsoft Visual BASIC(VB)中,窗体(Form)和控件(Control)等对象的单击(Click)和双击(Double-Click)事件都是指鼠标左键而言的。鼠标右键的单击和双击事件在VB中没有对应的事件驱动过程去响应和处理。但是在实际应用中(特别是一些可视化的图形软件)可能对鼠标键的功能定义比较丰富,单靠鼠标左键的单击和双击难以满足复杂的需要。因此有必要开发和扩充VB应用程序对鼠标右键的响应能力。 VB定义的鼠标事件 VB定义的鼠标事件有五种:单击(Click)、双击(DblClick)、鼠标键按下(MouseDown)、鼠标键松开(MouseUp)和鼠标光标移动(MouseMove)。其中前两种事件单击和双击是专指鼠标左键而言,后三种则适用于所有鼠标键。后三种鼠标事件的事件驱动过程有如下的形式: Sub对象名-鼠标事件(Button As Integer,Shift As Integer, X As Single, Y As Single) 用户插入的事件响应和处理代码 End Sub 传递给事件过程的参数中,整型数Button的最低三位从右到左分别对应鼠标左、右、中三个键。事件发生时,哪个或哪些键处于被按下的状态,Button 的对应位就为1,否则为0。程序中可以用VB的位运算AND来检测鼠标键的状态。整数Shift的最低三位从右到左分别对应事件发生时键盘的Shift、 Ctrl、Alt键。事件发生时,Shift、Ctrl、Alt中的哪个或哪些键处于被按下的状态,参数Shift的对应位就为1,否则为0。单精度值X 和Y存放的是事件发生时鼠标光标的X-Y坐标值。该值对于窗体对象而言是鼠标光标在窗体客户区中的坐标,对于控件对象则是鼠标光标在窗体客户区中相对于控件左上角的坐标。 鼠标右键事件的检测实际上,鼠标的单击事件可以被分解为MouseDown和MouseUp两个事件,所以我们可以用MouseDown事件来取代单击事件。同样,鼠标双击事件也可以分解为两个非常紧凑的单击事件。根据这一思路,我们可以在MouseDown事件过程中判定鼠标右键的单击和双击事件,并作出相应的响应和处理。 1.右键单击的判断和处理 鼠标右键单击事件的判断很简单,只需在MouseDown事件过程中检测一个Button参数。如下所示: Sub对象名-MouseDown(Button As Integer,Shift As Integer, X As Single, Y AsSingle) If Button = 2 Then '鼠标右键按下 鼠标右键单击的响应和处理代码 End If End Sub 2.右键双击的判断和处理 Windows对鼠标双击的定义是:同一鼠标键的两次快速按动-放开。只要两次按键的时间间隔不超过某一阈值,Windows就作为双击对待,否则认为是两次单击。这一阈值称为DoubleClickSpeed,它是在Widnows启动时从初始化文件WIN.INI中读入的。这一阈值在WIN.INI文件[Windows]段的Dou-bleClickSpeed项中存放,以毫秒为单位。一般情况下DoubleClickSpeed值为452毫秒,但是也可以在WIN.INI中人为地改变这一设定。为了判断鼠标右键的双击事件,我们需要在程序中读取WIN.INI中的DoubleClick-Speed值。以后每次鼠标右键按下时,在Mouse- Down事件过程中都要读当前的系统时间,并与上次按键的时间比较,看是否超过Dou-bleClickSpeed值:如果没超过,则转到双击事件的响应呼处理代码,否则作为单击事件处理。这里涉及读WIN.INI的问题。虽然WIN.INI是格式固定的文本文件,但是用读文本文件的方法去查找DoubleClickSpeed还是很麻烦。 Windows系统专门提供了一组函数用于访问Windows的初始化文件,这组函数同其它一些函数包含在Windows的三个系统动态链接库(DDL) 中。在Windows的软件开发环境中,一般都提供了访问这些函数的能力,这是通过Windows的应用程序接口(API)实现的。Windows API函数库中包含了几百个功能强大的系统函数,VB程序可以通过调用API函数完成很多VB系统本身不提供的功能。在VB中调用API函数之前,首先要用Declare语句对调用的函数、函数所在的动态链接库、函数的参数和返回类型进行必要的声明。声明格式为: Declare Function API函数名Lib"动态链接库名"(形式参数表) As 返回类型为了读取WIN.INI文件中某一项的值,我们需要调用API函数GetProfileInt,它的声明为 Declare Function GetProfileInt Lib "Kernel"(ByVal lpAppName As String,ByVal lpkeyName As String,ByVal nDefault As Integer)As Integer 其中字符串lpAppName为段名,lp-KeyName为项的名字,整型量nDefault为该项不存在时返回的缺省值。因此,以下语句可以读出Dou-bleClickSpeed值: DoubleClickSpeed=GetProfileInt("Windows","DoubleClickSpeed",452) 此外,VB程序只能读到以秒为单位的时间,精度显然不够。为了读到较为精确(毫秒为单位)的系统时间,需要求助于另外一个API函数:GetTickCount,它返回自Windows启动时经过的时间,以毫秒为单位。GetTickCount的声明如下: Declare Function GetTickCount Lib"User" () As Long 有了以下的技术准备,就可以在MouseDown事件过程中判断和处理鼠标右键的双击事件了。首先,在窗体启动时的加载(Load)事件过程中读取Windows系统的双击时间阈值DoubleClickSpeed。然后对MouseDown事件过程编程如下: Dim DoubleClickSpeed As Integer Dim FirstClickTick As Long '前一次鼠标右键按下的时刻 Sub对象名-MouseDown(Button As Integer,Shift As Integer, X As Single, Y AsSingle) If Button=2 Then '鼠标右键按下 Dim CurrentTick As Long CurrentTick = GetTickCount() '读取当前系统时间 If CurrentTick - FirstClickTick <= DoubleClickSpeed Then '没有超过时限,作双击对待 鼠标右键双击的响应和处理代码 Else '超过时限,作单击对待 鼠标右键单击的响应和处理代码 FirstClickTick = CurrentTick '记录本次右键按下的时刻 End If End If End Sub 程序的改进如果在窗体中加入一个命令钮(CommandButton,或称按钮)控件,当鼠标光标位于按钮上并按下左键时,按钮会自动显示被按下的样子,松开左键时,按钮又恢复原状。以上这些都是系统自动完成的,不需要用户干预。按钮对鼠标右键就没有类似的反应。前面虽然在功能上实现了对右键单击和双击的处理,但是从界面上还不尽如人意。鼠标右键点按钮时,只是完成一定的功能,按钮本身纹丝不动,用户无法得知刚才的按动是否有效。我们需要再调用一个API函数 SendMessage,让按钮对鼠标右键作出同对左键一样的反应。SendMessage给Windows窗口的处理函数(WndProc)发送一个消息,使函数作出相应的处理。 SendMessage的声明如下: Declare Punction SendMessage Lib "User" (ByVal hwnd As Integer,ByVal wMsgAs Integer,ByVal wParam As Integer,lParam As Any) As Long 其中的参数hwnd是窗口的句柄(handle),wMsg是消息的代码,wParam和lParam是与消息有关的两个参数。 VB中的控件在Windows系统中是被作为窗体的子窗口看待的。窗体和控件都有一个hWnd属性,该属性即窗体或控件的窗口句柄。我们用 SendMessage给按钮的窗口处理函数发送一个BM.SET-STATE消息,可以让按钮显示出被按下或放开的状态。BM.SETSTATE是一个常数,其值为十六进制的403。如果要显示按钮被按下,则调用 tmp = SendMessage(按钮名.hwnd, &H403, 1, 0&) 如果要显示按钮被松开,则调用 tmp = SendMessage(按钮名.hwnd, &H403, 0, 0&) SendMessage返回值无用,放在一个临时的变量tmp中。 于是我们可以在按钮的鼠标事件过程中进行如下的扩充: Const BM_SETSTATE = &H403 Sub按钮名-MouseDown(Button As Integer,Shift As Integer, X As Single, Y AsSingle) If Button = 2 Then '鼠标右键按下 …… tmp = SendMessage(按钮名.hwnd,BM_SETSTATE, 1, 0&) End If End Sub Sub按钮名-MouseMove(Button As Integer, Shift As Integer, X As Single, Y AsSingle) If Button And 2 Then '鼠标右键按下 If X < 0 Or Y < 0 Or X >按钮名.Width Or Y >按钮名.Height Then '鼠标光标移到了按钮以外 tmp = SendMessage(按钮名.hwnd, BM_SETSTATE, 0, 0&) Else tmp = SendMessage(按钮名.hwnd, BM_SETSTATE, 1, 0&) End If End If End If Sub按钮名-MouseUp(Button As Integer,Shift As Integer, X As Single, Y As Single) If Button And 2 Then tmp = Send Message(按钮名.hwnd, BM_SETSTATE, 0, 0&) End If End Sub 其中MouseDown和MouseUp事件过程中的处理比较简单。MouseMove事件中的处理结果是,如果按下鼠标右键,按钮显示被按下的状态,如果不松开右键而把鼠标光标移到按钮外,按钮会弹起;如果再移回按钮中,按钮再次显示被按下。这就和用鼠标左键做类似动作时的效果完全一样了。 程序示例以下是一个完整的VB程序例子。该程序实现了对鼠标右键双击事件的判断和响应处理,并从功能和外观上都达到了和左键双击一样的效果。程序的界面部分非常简单:一个标准的窗体Forml和一个位于窗体正中的标准的命令钮Command1。运行后,每当用户双击按钮时,程序都发出"嘟"的一声。该程序在 Microsoft Visual BASIC 4.0版下调试通过,Windows系统用的是3.2中文简体版。 FORM1.FRM源文件: VERSION 4.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 4230 ClientLeft = 1095 ClientTop = 1515 ClientWidth = 6720 Height = 4635 Left = 1035 LinkTopic = "Form1" ScaleHeight = 4230 ScaleWidth = 6720 Top = 1170 Width = 6840 Begin VB.CommandButton Command1 Caption = "Command1" Height = 495 Left = 2760 TabIndex = 0 Top = 1920 Width = 1215 End End Attribute VB_Name = "Form1" Attribute VB_Creatable = False Attribute VB_Exposed = False Private Declare Function GetTickCount Lib "User" () As Long Private Declare Function GetProfileInt Lib "Kernel" (ByVal lpappName As String, ByVal lpKeyName As String,ByVal nDefault As Integer) As Integer Private Declare Function SendMessage Lib"User"(ByVal hwnd As Integer, ByVal wMsg As g As Integer,ByVal wParam As Integer,lParam As Any) As Long Const BM_SETSTATE = &H403 Dim DoubleClickSpeed As Integer Dim FirstClickTick As Long Private Sub Command1_MouseDown(Button As Integer,Shift As Integer, X As Single, Y As Singie) If Button And 2 Then Dim CurrentTick As Long CurrentTick = GetTickCount() If CurrentTick - FirstClickTick <=DoubleClickSpeed Then Beep Else FirstClickTick = CurrentTick End If tmp = SendMessage(Command1.hwnd, BM_SETSTATE, 1, 0&) End If End Sub Private Sub Command1_MouseMove(Button As Integer,Shift As Integer, X As Single,Y As Single) If Button And 2 Then If X < 0 Or Y < 0 Or X > Command1.Width Or Y > Command1.Height Then tmp = SendMessage(Command1.hwnd, BM_SETSTATE, 0, 0&) Else tmp = SendMessage(Command1.hwnd, BM_SETSTATE, 1, 0&) End If End If End Sub Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button And 2 Then tmp = SendMessage(Command1.hwnd, BM_SETSTATE, 0, 0&) End If End Sub Private Sub Form_Load () DoubleClickSpeed = GetProfileInt("Windows","DoubleClickSpeed",500) End Sub

Answer 2

不用那么啰嗦。
○在窗体中输入以下代码：
Private Sub Command1_Click()
lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub
Private Sub Command2_Click()
UnhookWindowsHookEx lHook
End Sub

○新建一个模块，输入以下代码：
Option Explicit
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Type MOUSEMSGS
X As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type

Public Const WH_MOUSE_LL = 14
Public Const HC_ACTION = 0

'鼠标消息
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205

Public MouseMsg As MOUSEMSGS
Public lHook As Long
'----------------------------------------
'模拟鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pt As POINTAPI

If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)

If wParam = WM_RBUTTONDOWN Then '把中键改为左键
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
CallMouseHookProc = 1
End If

If wParam = WM_RBUTTONUP Then
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
CallMouseHookProc = 1
End If

End If

If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
End If

End Function

Answer 3

要用API函数 调用MOUSE_CLICK 函数