msgmouseleave.bas

来自「vb做的数据库 客户管理系统」· BAS 代码 · 共 85 行

Attribute VB_Name = "msgMouseLeave"
Option Explicit

Global FrmHeight As Long
Global FrmSettingHeight As Long
Global FrmWidth As Long

Global isSending As Boolean
Global isSetting As Boolean



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

Global 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
        MouseLeaveTerminate (hwnd)
    End If

    '处理鼠标移出消息
    If Msg = WM_MOUSELEAVE Then
        bTracking = False
    Else    'Mouse in
        bTracking = True
    End If

    SubWndProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End Function



Public Sub MouseLeaveInit(hwnd)
    PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubWndProc)
End Sub

Public Sub MouseLeaveTerminate(hwnd)
            Call SetWindowLong(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub