请教想统计鼠标进入(离开)窗体次数,鼠标不点击窗体,只移入和移出,统计鼠标移入和移出窗体的次数?
解决方案 »
- 多维数组问题-多边形首尾相连
- 『新手求助』listview设置了checkboxes属性后,如何让某一行不显示checkbox
- 请问哪位能够告诉我InstallShield7.02如何制作升级包
- 怎么把picture控件没有图象的部分变成透明的????
- 扩展名是.frx是一个什么文件..............
- 求教:怎样用VB来调用SolidWorks零件图中的系列零件设计表?
- 怎样做一个安装程序包
- 怎样用vb编写自动加入日志文件到数据库
- 向各位大虾请教一个问题!
- 我用Internet Transfer控件采集HTML时。返回的浏览器类型是Microsoft URL Control - 6.00.8169 我如何改变浏览器类型呢?(给分50~~~~~)
- vb6.0
- MSHFlexGrid 合并
具体例子:
Option Explicit
Dim intMouseIn As Integer
Dim bolMouseIn As Boolean
Dim bolMouseOldPos As Boolean
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim MousePos As POINTAPI
'取得鼠标位置
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'设置鼠标位置
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
'
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
'
Private Declare Function ReleaseCapture Lib "user32" () As Long
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'过程功能:初始化窗体
'功能描述:
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub Form_Load()
Dim lngP As Long
On Error GoTo errSub
intMouseIn = 0 '初始化进入窗体的次数
bolMouseIn = False
bolMouseOldPos = False
lngP = SetCursorPos(ByVal 0&, ByVal 0&) '每次装在窗体时都将鼠标位置设置在屏幕的左上角
Exit Sub
errSub:End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
bolMouseIn = (X >= 0) And (X <= Me.Width) And (Y >= 0) And (Y <= Me.Height)
If bolMouseIn Then
SetCapture Me.hWnd
Else
ReleaseCapture
End If
Debug.Print bolMouseIn
If bolMouseIn And Not bolMouseOldPos Then intMouseIn = intMouseIn + 1
bolMouseOldPos = bolMouseIn
Label1.Caption = CStr(intMouseIn)
End Sub
Option Explicit
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
'调用窗口处理
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
'跟踪鼠标事件
Private Type TRACKMOUSEEVENTTYPE
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type
Private Const WM_MOUSEMOVE = &H200
Private Const WM_MOUSELEAVE = &H2A3&
Private Const TME_LEAVE = &H2&
Private Const GWL_WNDPROC = (-4)
Private lpOldWndFunc As Long
Private lpTMET As TRACKMOUSEEVENTTYPE
Private dwMoveCount As Long
Private dwLeaveCount As Long
Private bMouseEnter As Boolean
'--------------------------------------------------------------------------------------
'函 数 名: WindowProcedure
'描 述: 窗口消息处理函数
'--------------------------------------------------------------------------------------
Private Function WindowProcedure(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wMsg
Case WM_MOUSELEAVE
bMouseEnter = False
dwLeaveCount = dwLeaveCount + 1
Form1.Caption = "进入: " & CStr(dwMoveCount) & "离开: " & CStr(dwLeaveCount)
Case WM_MOUSEMOVE
If bMouseEnter = False Then
bMouseEnter = True
dwMoveCount = dwMoveCount + 1
With lpTMET
.cbSize = Len(lpTMET)
.dwFlags = TME_LEAVE
.hwndTrack = hWnd
End With
Call TrackMouseEvent(lpTMET) '跟踪一次鼠标事件
Form1.Caption = "进入: " & CStr(dwMoveCount) & "离开: " & CStr(dwLeaveCount)
End If
End Select
WindowProcedure = CallWindowProc(lpOldWndFunc, hWnd, wMsg, wParam, lParam) '原窗口消息处理
End Function
'--------------------------------------------------------------------------------------
'函 数 名: SubClass
'描 述: 子类化窗口
'--------------------------------------------------------------------------------------
Public Sub SubClass(ByVal hWnd As Long)
lpOldWndFunc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProcedure) '新窗口消息处理
End Sub
'--------------------------------------------------------------------------------------
'函 数 名: UnSubClass
'描 述: 取消子类化
'--------------------------------------------------------------------------------------
Public Sub UnSubClass(ByVal hWnd As Long)
Call SetWindowLong(hWnd, GWL_WNDPROC, lpOldWndFunc) '恢复原窗口消息处理
End Sub
'窗口代码
Option Explicit
'--------------------------------------------------------------------------------------
'事 件 名: Form_Load
'描 述: ----
'--------------------------------------------------------------------------------------
Private Sub Form_Load()
Call SubClass(Me.hWnd) '子类化窗口
End Sub
'--------------------------------------------------------------------------------------
'事 件 名: Form_Unload
'描 述: ----
'--------------------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
Call UnSubClass(Me.hWnd) '取消子类化
End Sub