Функция TrackMouseEvent

Declare Function TRACKMOUSEEVENT Lib "user32" Alias "TrackMouseEvent" ( _
        lpEventTrack As TRACKMOUSEEVENT) As Long

Возвращаемое значение

Функция возвращает ненулевое значение в успешном случае. В случае ошибки возвращается 0 (для получения кода ошибки используйте GetLastError

Параметры

lpEventTrack

Структура TRACKMOUSEEVENT, содержащая необходимую информацию

Пример

' Когда мышь покидает пределы картинки,
' то она меняет свой фон
' Поместите код в модуль Module1.bas,
' т.к. используется функция обратного вызова
Public Const WM_MOUSELEAVE As Long = &H2A3
Public Declare Function TRACKMOUSEEVENT Lib "user32" Alias "TrackMouseEvent" ( _
          lpEventTrack As TRACKMOUSEEVENT) As Long

Public Type TRACKMOUSEEVENT
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
End Type

Public Const TME_LEAVE As Long = &H2

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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 Const GWL_WNDPROC = (-4)
Dim PrevProc As Long
Public Track As TRACKMOUSEEVENT

Public Sub Hook(qHwnd As Long)
    PrevProc = SetWindowLong(qHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHook(qHwnd As Long)
    SetWindowLong qHwnd, GWL_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    If uMsg = WM_MOUSELEAVE Then

        If Form1.pic1.BackColor = vbGreen Then
           Form1.pic1.BackColor = vbRed
        Else
           Form1.pic1.BackColor = vbGreen
        End If
        
    End If
    
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End Function

' Добавьте на форму PictureBox с именем pic1
' Поместите код в модуль формы

Private Sub Form_Load()
   Hook pic1.hwnd

   With Track
       .cbSize = Len(Track)
       .dwFlags = TME_LEAVE
       '.dwHoverTime = 400
       .hwndTrack = pic1.hwnd
   End With
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   UnHook pic1.hwnd
End Sub

Private Sub pic1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   TRACKMOUSEEVENT Track
End Sub

Категория