如何拦截鼠标点击某个按钮
如何拦截鼠标点击某个按钮 引起的事件。。。。
图片在这个论坛里
http://www.vbgood.com/viewthread.php?tid=49395&extra=page%3D1
[解决办法]
Private Sub Command1_Click()
Label1.BackColor = vbRed
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.Enabled = False
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.Enabled = False
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.Enabled = False
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.Enabled = True
End Sub
[解决办法]
晕，说清楚了就好办了。
Private Declare Function EnableWindow Lib "user32 " (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Sub Command1_Click()
EnableWindow Command2.hwnd, False
End Sub
想办法找到按钮的句柄就行了。
[解决办法]
思路：VB全局钩子,拦截点击时鼠标的位置,然后和某个按钮的矩形坐标比较,如果坐标内吃掉消息
*.bas部分
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll " Alias "RtlMoveMemory " (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32 " (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32 " (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_LBUTTONDOWN = &H201
Private Type POINTAPI
x As Long
y As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Public hHook As Long
Public butt_rect As RECT
Public Sub EnableHook()
If hHook = 0 Then
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0)
End If
End Sub
Public Sub FreeHook()
If hHook <> 0 Then
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
End Sub
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim typMHS As MSLLHOOKSTRUCT, pt As POINTAPI
HookProc = 0
If nCode < 0 Then
HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
Exit Function
End If
If wParam = WM_LBUTTONDOWN Then
Call CopyMemory(typMHS, ByVal lParam, LenB(typMHS))
pt = typMHS.pt
If pt.x > butt_rect.Left And pt.x < butt_rect.Right And pt.y > butt_rect.Top And pt.y < butt_rect.Bottom Then
HookProc = 1
End If
End If
End Function
Option Explicit
Private Declare Function FindWindow Lib "user32 " Alias "FindWindowA " (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32 " Alias "FindWindowExA " (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib "user32 " (ByVal hwnd As Long, lpRect As RECT) As Long
Private Sub Form_Load()
Dim xhwnd As Long
Dim yhwnd As Long
xhwnd = FindWindow( "SciCalc ", "计算器 ")
yhwnd = FindWindowEx(xhwnd, 0, "Button ", "= ")
Call GetWindowRect(yhwnd, butt_rect)
EnableHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
FreeHook
End Sub
[解决办法]
参考一下
'form code
Private Sub Form_Load()
On Error Resume Next
ProcOld = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLongA hwnd, GWL_WNDPROC, ProcOld
End Sub
'module code
Declare Function SetWindowLongA Lib "user32 " (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProcA Lib "user32 " (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowTextA Lib "user32 " (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public ProcOld As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_COMMAND = &H111
Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_COMMAND
Dim s As String * 255
GetWindowTextA lParam, s, 255
Dim i As Integer
Dim ss As String
For i = 1 To 255
If Mid(s, i, 1) <> Chr(0) Then
ss = ss & Mid(s, i, 1)
Else
Exit For
End If
Next i
Debug.Print "Caption= " & ss & " ID= " & wParam
End Select
WindowProc = CallWindowProcA(ProcOld, hwnd, iMsg, wParam, lParam)
End Function
