1.如果鼠标双击 则引发事件 的VB代码怎么写 帮帮忙不用那么啰嗦 。
○在窗体中输入以下代码:Private Sub Command1_Click() lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)End SubPrivate Sub Command2_Click() UnhookWindowsHookEx lHookEnd Sub○新建一个模块,输入以下代码:Option ExplicitPublic Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As LongPublic Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As LongPublic Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As LongPublic 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 TypePublic Type POINTAPI X As Long Y As LongEnd TypePublic Const WH_MOUSE_LL = 14Public Const HC_ACTION = 0'鼠标消息Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_RBUTTONDOWN = &H204Public Const WM_RBUTTONUP = &H205Public MouseMsg As MOUSEMSGSPublic lHook As Long'----------------------------------------'模拟鼠标Private Const MOUSEEVENTF_LEFTDOWN = &H2Private Const MOUSEEVENTF_LEFTUP = &H4Private 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 IfEnd Function 。
2.Vb 怎样获取双击事件以下在模块中 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_MOUSEMOVE = &H200 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 Declare Function GetDoubleClickTime Lib "user32" () As Long'鼠标钩子 Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim pt As POINTAPI, DBLCLK As Long Static DBtime As Long DBLCLK = GetDoubleClickTime If code = HC_ACTION Then CopyMemory MouseMsg, lParam, LenB(MouseMsg) If wParam = 513 And MouseMsg.time - DBtime <= DBLCLK Then MsgBox "双击" If wParam = 512 Then DBtime = 0 If wParam = 514 Then DBtime = MouseMsg.time End If If code <> 0 Then CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam) End If End Function 以下在 form1 中'安装钩子 Private Sub AddHook() '鼠标钩子 lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0) End Sub'卸钩子 Private Sub DelHook() UnhookWindowsHookEx lHook End Sub Private Sub Command1_Click() DelHook '卸钩子 End Sub Private Sub Form_Load() AddHook End Sub Private Sub Form_Unload(Cancel As Integer) DelHook End Sub 请参考 。