当前位置:编程学习 > VB >>

请教统计鼠标进入(离开)窗体次数的程序怎么写的~!

请教想统计鼠标进入(离开)窗体次数,鼠标不点击窗体,只移入和移出,统计鼠标移入和移出窗体的次数? --------------------编程问答-------------------- 思路:定义一个全局变量,当鼠标进入窗体再到离开,这个全局变量加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 Sub

Private 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
补充:VB ,  API
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,