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