Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0488: MouseOver per Mousetrackevent auslösen

VB 5/6-Tipp 0488: MouseOver per Mousetrackevent auslösen

 von Alex Englhardt

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CallWindowProcA (CallWindowProc), DefWindowProcA (DefWindowProc), SendMessageA (SendMessage), SetWindowLongA (SetWindowLong), TrackMouseEvent

Download: Download des Beispielprojektes [3,57 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'-------- Anfang Projektdatei prjTrackMouseEvent.vbp --------
'--- Anfang Formular "frmTrackMouseEvent" alias frmTrackMouseEvent.frm  ---
' Steuerelement: TrackMouseEventControl "UCTrackMouseEvent1"
Option Explicit

'--- Ende Formular "frmTrackMouseEvent" alias frmTrackMouseEvent.frm  ---
'--- Anfang benutzerdefiniertes Steuerelement "UCTrackMouseEvent" alias UCTrackMouseEvent.ctl ---
Option Explicit
'*** Variables
    '*** tTrackMouseEventType
    Private tTrackMouseEventType As TRACKMOUSEEVENTTYPE
' ======================================================================================
' --------------------------------- UserControl ----------------------------------------
' ======================================================================================
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '*** Ignore Errors
    On Error Resume Next
    '*** Check hWndHoverControl
    If hWndHoverControl <> UserControl.hwnd Then
        '*** SendMessage
        Call SendMessage(hWndHoverControl, WM_MOUSELEAVE, 0&, 0&)
        '*** Set hWndHoverControl
        hWndHoverControl = UserControl.hwnd
        '*** Check lpPrevWindowProc
        If lpPrevWindowProc = 0 Then
            '*** SetWindowLong
            lpPrevWindowProc = SetWindowLong(UserControl.hwnd, GWL_WNDPROC, AddressOf WindowProc)
        End If
        '*** Set tTrackMouseEventType.cbSize
        tTrackMouseEventType.cbSize = Len(tTrackMouseEventType)
        '*** Set tTrackMouseEventType.dwFlags
        tTrackMouseEventType.dwFlags = TME_LEAVE
        '*** Set tTrackMouseEventType.hwndTrack
        tTrackMouseEventType.hwndTrack = UserControl.hwnd
        '*** TrackMouseEvent
        Call TrackMouseEvent(tTrackMouseEventType)
        '*** Paint UserControl
        Call UserControl_Paint
    End If
    '*** Disable ErrorHandler
    On Error Goto 0
End Sub
Private Sub UserControl_Paint()
    '*** Ignore Errors
    On Error Resume Next
    
    '*** Die Auswertung im Paint Ereignis funktioniert nur
    '*** wenn Autoredraw=False da bei Autoredraw=True kein
    '*** Paint Ereignis ausgelöst wird
    
    '*** Abfrage ob Maus auf dem UserControl ist.
    '*** Hier kann z.B. ein Event ausgelöst werden.
    
    If UserControl.hwnd <> hWndHoverControl Then
    
        '*** Maus ist nicht auf dem UserControl
        
        
        '*** Change BackColor
        UserControl.BackColor = &HFF&
    Else
    
        '*** Maus ist auf dem UserControl
    
        '*** Change BackColor
        UserControl.BackColor = &HFF00&
    End If
    
    
    '*** Disable ErrorHandler
    On Error Goto 0
End Sub

'--- Ende benutzerdefiniertes Steuerelement "UCTrackMouseEvent" alias UCTrackMouseEvent.ctl ---
'--- Anfang Modul "modTrackMouseEvent" alias modTrackMouseEvent.bas ---
Option Explicit

' *** Constants
' *** SetWindowLong
Public Const GWL_WNDPROC = (-4)

' *** Window Messages
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
Public Const WM_MOUSELEAVE = &H2A3&
Public Const WM_PAINT = &HF

' *** Variables
' *** lpPrevWindowProc
Public lpPrevWindowProc As Long

' *** hWndHoverControl
Public hWndHoverControl As Long

' *** Types
' *** TrackMouseEventType
Public Type TRACKMOUSEEVENTTYPE
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
End Type

' *** Functions
' *** Window Functions
Public 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
                        
Public Declare Function DefWindowProc Lib "user32" _
                        Alias "DefWindowProcA" ( _
                        ByVal hwnd As Long, _
                        ByVal wMsg As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
                        
Public Declare Function SendMessage Lib "user32" _
                        Alias "SendMessageA" ( _
                        ByVal hwnd As Long, _
                        ByVal wMsg As Long, _
                        ByVal wParam As Long, _
                        lParam As Any) As Long
                        
Public Declare Function SetWindowLong Lib "user32" _
                        Alias "SetWindowLongA" ( _
                        ByVal hwnd As Long, _
                        ByVal nIndex As Long, _
                        ByVal dwNewLong As Long) As Long
                        
Public Declare Function TrackMouseEvent Lib "user32" ( _
                        lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
                        
' ======================================================================================
' --------------------------------- WindowProc -----------------------------------------
' ======================================================================================
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
    ' *** Ignore Errors
    On Error Resume Next
    
    ' *** Select uMsg
    Select Case uMsg
    
    ' *** MouseLeave
    Case Is = WM_MOUSELEAVE
    
        ' *** Set hWndHoverControl
        hWndHoverControl = 0
        
        ' *** Set UMsg
        uMsg = WM_PAINT
        
        ' *** CallWindowProc
        WindowProc = CallWindowProc(lpPrevWindowProc, hwnd, uMsg, wParam, lParam)
        
        ' *** SetWindowLong
        If SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWindowProc) <> 0 Then
        
            ' *** Set lpPrevWWindowProc
            lpPrevWindowProc = 0
        End If
        
    ' *** Other
    Case Else
    
        ' *** CallWindowProc
        WindowProc = CallWindowProc(lpPrevWindowProc, hwnd, uMsg, wParam, lParam)
    End Select
    
    ' *** Disable ErrorHandler
    On Error Goto 0
End Function
'--- Ende Modul "modTrackMouseEvent" alias modTrackMouseEvent.bas ---
'--------- Ende Projektdatei prjTrackMouseEvent.vbp ---------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.