处理鼠标移出事件
2004-10-24 14:32
399 查看
Windows提供的鼠标移出消息有时候很有用,但是VB6中没有把这个事件封装给我们。
但是我们仍然可以使用子类化技术实现他,下面的代码就是一个简单的例子来处理Windows的
WM_MOUSELEAVE消息的,我演示的是鼠标移出一个Button时的情形。
1.加入一个模块,专门用来处理子类函数:
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Copyright 2002 40Star, All Rights Reserved.
'
'E-Mail :40Star@163.com
'Distribution:你可以完全自由随便的使用这段代码,不管你用于任何目的
' 程序在于交流和学习
' 如有任何BUG请和我联系
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal _
hwnd As Long, ByVal Msg As Long, ByVal wParam As _
Long, ByVal lParam As Long) As Long
Const GWL_WNDPROC = (-4&)
Dim PrevWndProc&
Private Const WM_DESTROY = &H2
Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
Public Const TME_CANCEL = &H80000000
Public Const TME_HOVER = &H1&
Public Const TME_LEAVE = &H2&
Public Const TME_NONCLIENT = &H10&
Public Const TME_QUERY = &H40000000
Private Const WM_MOUSELEAVE = &H2A3&
Public Type TRACKMOUSEEVENTTYPE
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type
Public bTracking As Boolean
Dim evtTrack As TRACKMOUSEEVENTTYPE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function SubWndProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) _
As Long
If Msg = WM_DESTROY Then Terminate (hwnd)
'处理鼠标移出消息
If Msg = WM_MOUSELEAVE Then
bTracking = False
Form1.Print "The mouse left the form!"
End If
SubWndProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End Function
Public Sub Init(hwnd As Long)
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubWndProc)
End Sub
Public Sub Terminate(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
' -- 模块结束 -- '
2. 窗体中处理需要加入的代码:
Option Explicit
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bTracking = False Then
bTracking = True
Dim ET As TRACKMOUSEEVENTTYPE
'initialize structure
ET.cbSize = Len(ET)
ET.hwndTrack = Command1.hwnd
ET.dwFlags = TME_LEAVE
'start the tracking
TrackMouseEvent ET
End If
End Sub
Private Sub Form_Load()
Call Init(Command1.hwnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Terminate(Command1.hwnd)
End Sub
但是我们仍然可以使用子类化技术实现他,下面的代码就是一个简单的例子来处理Windows的
WM_MOUSELEAVE消息的,我演示的是鼠标移出一个Button时的情形。
1.加入一个模块,专门用来处理子类函数:
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Copyright 2002 40Star, All Rights Reserved.
'
'E-Mail :40Star@163.com
'Distribution:你可以完全自由随便的使用这段代码,不管你用于任何目的
' 程序在于交流和学习
' 如有任何BUG请和我联系
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal _
hwnd As Long, ByVal Msg As Long, ByVal wParam As _
Long, ByVal lParam As Long) As Long
Const GWL_WNDPROC = (-4&)
Dim PrevWndProc&
Private Const WM_DESTROY = &H2
Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
Public Const TME_CANCEL = &H80000000
Public Const TME_HOVER = &H1&
Public Const TME_LEAVE = &H2&
Public Const TME_NONCLIENT = &H10&
Public Const TME_QUERY = &H40000000
Private Const WM_MOUSELEAVE = &H2A3&
Public Type TRACKMOUSEEVENTTYPE
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type
Public bTracking As Boolean
Dim evtTrack As TRACKMOUSEEVENTTYPE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function SubWndProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) _
As Long
If Msg = WM_DESTROY Then Terminate (hwnd)
'处理鼠标移出消息
If Msg = WM_MOUSELEAVE Then
bTracking = False
Form1.Print "The mouse left the form!"
End If
SubWndProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End Function
Public Sub Init(hwnd As Long)
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubWndProc)
End Sub
Public Sub Terminate(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
' -- 模块结束 -- '
2. 窗体中处理需要加入的代码:
Option Explicit
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bTracking = False Then
bTracking = True
Dim ET As TRACKMOUSEEVENTTYPE
'initialize structure
ET.cbSize = Len(ET)
ET.hwndTrack = Command1.hwnd
ET.dwFlags = TME_LEAVE
'start the tracking
TrackMouseEvent ET
End If
End Sub
Private Sub Form_Load()
Call Init(Command1.hwnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Terminate(Command1.hwnd)
End Sub
相关文章推荐
- 鼠标移出/点击div外等事件处理,及键盘操作
- javascript父级鼠标移入移出事件中的子集影响父级的处理方法
- 处理鼠标移出事件
- 处理鼠标移出事件
- OpenCV对鼠标事件的处理
- Glut处理鼠标事件和键盘事件
- Qt Quick事件处理之鼠标、键盘、定时器
- 在WPF中强制捕获鼠标,鼠标移出控件后依然何以获取鼠标事件
- MFC 窗口按钮的鼠标事件(对于中文和英文按钮的处理)问题
- VC 怎么实现对鼠标离开对话框时,事件的处理
- GridView鼠标停留变色和客户端单击处理事件
- 直方图的均衡、直方图的反向投影算法,opencv鼠标和键盘处理事件
- 鼠标移入移出事件改变图片的分辨率的两种方法
- jQuery 鼠标经过(hover)事件的延时处理示例
- QT基础(二)----鼠标、键盘事件处理机制、信息拦截机制
- (4):Silverlight 2 鼠标事件处理
- 九、Qt Creator中鼠标键盘事件的处理实现自定义鼠标指针
- 用来动态添加某事件后处理函数 如鼠标单击时可动态添加其它处理函数
- mouse添加鼠标移出移入事件 两种方法
- CListCtrl控件主要事件及LVN_ITEMCHANGED消息和鼠标双击列表项事件的处理