请教想统计鼠标进入(离开)窗体次数,鼠标不点击窗体,只移入和移出,统计鼠标移入和移出窗体的次数?

解决方案 »

  1.   

    思路:定义一个全局变量,当鼠标进入窗体再到离开,这个全局变量加1
    具体例子:
    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
      

  2.   

    '模块代码
    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