"MouseInOut (GES)" für Controls MIT und OHNE hWnd Mit diesem Tipp spendieren Sie allen Controls ein MouseIn bzw. MouseOut-Ereignis.
Autor:   Guido Eisenbeis	Bewertung:     [ Jetzt bewerten ]	Views:  20.331
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 20 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Um Aktionen ausführen zu lassen, wenn die Maus ein Control überfährt, benötigt man bekannterweise eine Art MouseIn-/MouseOut-Ereignis. Leider besitzen die VB-Standard-Controls diese Ereignisse nicht, so dass wir uns wieder einmal selbst behelfen müssen.

In der jeweiligen Form werden "Pseudo-Ereignisse" ("MouseIn" und "MouseOut") angelegt. Diese können dann genauso wie "normale" Ereignisse (z.B. Click) aufgerufen werden.

Das Besondere an "MouseInOut (GES)" ist, dass das Control kein hWnd besitzen muss (z.B. Label und Image). Geprüft wird die Maus-Position und ein Comparing-hWnd.

Berücksichtigt wird auch, ob sich ein Control in anderen Controls (Container) befindet. Diese MouseInOut-Überwachung funktioniert sehr präzise. Im Gegensatz zu Codes mit "SetCapture, ReleaseCapture" gibt es hier kein "Hängenbleiben"!

Bereits vor einem knappen Jahr haben wir in unserem Extra-Tipps Bereich einen entsprechenden Code vorgestellt.

Dieser Tipp wurde jetzt nochmals überarbeitet und verbessert.

• Code überarbeitet und verfeinert: Er ist effektiver und übersichtlicher
• Die Form, die das Control enthält, wird automatisch ermittelt (d. h. der Aufruf ist einfacher)
• "MouseInOut (GES)" wird beendet, wenn die Form den Fokus verliert (inaktiv wird).
• "MouseInOut (GES)" bemerkt, falls das überwachte Control von einer inaktiven "OnTop"-Form oder "OnTop"-MsgBox teilweise verdeckt wird.

Fügen Sie Ihrem Projekt ein neues Modul hinzu und kopieren nachfolgenden Code in das Modul:

Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function SetTimer Lib "user32.dll" ( _
  ByVal hwnd As Long, _
  ByVal nIDEvent As Long, _
  ByVal uElapse As Long, _
  ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32.dll" ( _
  ByVal hwnd As Long, _
  ByVal nIDEvent As Long) As Long
 
Public lEvent As Long ' Timer-ID
 
Private Declare Function GetCursorPos Lib "user32" ( _
  lpPoint As POINTAPI) As Long
 
Private Declare Function ClientToScreen Lib "user32" ( _
  ByVal hwnd As Long, _
  lpPoint As POINTAPI) As Long
 
Private Declare Function GetWindowRect Lib "user32" ( _
  ByVal hwnd As Long, _
  lpRect As RECT) As Long
 
Private Declare Function PtInRect Lib "user32" ( _
  lpRect As RECT, _
  ByVal X As Long, _
  ByVal Y As Long) As Long
 
Private Declare Function WindowFromPoint Lib "user32" ( _
  ByVal xPoint As Long, _
  ByVal yPoint As Long) As Long
 
Private Declare Function GetForegroundWindow Lib "user32" () As Long
 
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Private Type POINTAPI
  X As Long
  Y As Long
End Type
 
Private fForm As Form         ' Wird für "CallByName" benötigt
Private Ctrl As Control       ' Ist das zu überwachende Control
Private CtrlRect As RECT      ' Ist das Control-Rechteck (die Fläche)
Private CompHWND As Long      ' hWnd, das zum Überwachen benutzt wird
Private M_Enter As Boolean    ' Indikator für "MouseIn"
Public CtrlIndex As Integer   ' Falls es sich um ein Steuerelementefeld handelt,
                              ' kann im "Pseudo-Ereignis" der Form der jeweilige
                              ' Index über "CtrlIndex" verwendet werden.
                              ' (Beispiel siehe ganz unten.)

' Starten der MouseInOut-Überwachung
Public Sub MouseInOutTracking(ByVal cControl As Control)
 
  Dim Ret As Long       ' für verschiedene Rückgabewerte
  Dim TmpCtrl As Object ' zum Ermitteln der (Parent-)Form
  Dim Cont As Object    ' Container des jeweiligen Controls
  Dim ContRect As RECT  ' Container-Rechteck (Fläche)
  Dim P1 As POINTAPI    ' Begrenzungs-Punkte ...
  Dim P2 As POINTAPI    ' ... des Control-Rechtecks
 
  ' MouseOut auslösen, falls das im MouseMove übergebene
  ' Control nicht das überwachte Control ist.
  ' (Sehr wichtig, falls 2 überwachte Controls sehr dicht
  ' beieinander, oder ineinander (Container) liegen, oder
  ' sich überlappen.)
  If ((Not Ctrl Is cControl)) Then
    ' MouseOut nur auslösen, falls der Timer schon läuft
    If (lEvent <> 0) Then
      ' ************ Maus hat das Control verlassen ************
      DisableTimer
      M_Enter = False
 
      ' MouseOut-Routine aufrufen
      Call DoByMouseOut
      ' ********************************************************
    End If
 
    ' Die (Parent-)Form des übergebenen Controls ermitteln
    Set TmpCtrl = cControl
    Do ' Solange den nächsthöheren Container prüfen,
      ' bis die Form gefunden ist.
      Set TmpCtrl = TmpCtrl.Container
      If (TypeOf TmpCtrl Is Form) Then
        Set fForm = TmpCtrl   ' Übergabe an Modul-weit gültige Variable
        Set TmpCtrl = Nothing ' Speicher freigeben
        Exit Do
      End If
    Loop
 
    Set Ctrl = cControl ' Übergabe an Modul-weit gültige Variable
  End If
 
  ' MouseInOut-Überwachung nur dann starten:
  ' - falls die Überwachung noch nicht gestartet ist
  ' - und falls die Form aktiv ist
  '   (verhindert das Flackern von Controls (Labels))
  If ((lEvent = 0) And (fForm.hwnd = GetForegroundWindow)) Then
 
    On Error Resume Next ' Fehlerbehandlung für Prüfungen ausschalten
 
    ' Index zuweisen, falls es sich um ein Steuerelementefeld handelt
    CtrlIndex = Ctrl.Index
 
    CompHWND = 0 ' zurücksetzen!
    CompHWND = Ctrl.hwnd ' Wegen "On Error ..."-Prüfung gesondert zuweisen
 
    If (CompHWND <> 0) Then ' Control besitzt ein HWND
 
      Ret = 0 ' zurücksetzen!
      Ret = Ctrl.ScaleMode ' Prüfen auf VB-konformen ScaleMode
      ' (nur Controls mit ScaleMode 1 bis 7 werden unterstützt!)
 
      On Error GoTo 0 ' Fehlerbehandlung wieder ausschalten
 
      ' Begrenzungs-Punkte des Control-Rechtecks ermitteln
      If (Ret > 0) Then
        ' Nur "Innen-Fläche" (Form, PictureBox) berücksichtigen
        ' (wo auch MouseMove beginnt). Emöglicht grosse Genauigkeit.
        P1.X = 0
        P1.Y = 0
        P2.X = Ctrl.ScaleX(Ctrl.ScaleWidth, Ctrl.ScaleMode, vbPixels)
        P2.Y = Ctrl.ScaleY(Ctrl.ScaleHeight, Ctrl.ScaleMode, vbPixels)
        Call ClientToScreen(Ctrl.hwnd, P1)
        Call ClientToScreen(Ctrl.hwnd, P2)
      Else
        Call GetWindowRect(Ctrl.hwnd, CtrlRect)
        P1.X = CtrlRect.Left
        P1.Y = CtrlRect.Top
        P2.X = CtrlRect.Right
        P2.Y = CtrlRect.Bottom
      End If
 
    Else ' Control ohne HWND
 
      ' Eine Prüfung per "WindowFromPoint" gibt bei einem
      ' Control ohne hWnd das hWnd des Containers zurück.
      ' Deshalb das Container-hWnd für Überprüfung zuweisen.
      CompHWND = Ctrl.Container.hwnd
 
      Set Cont = Ctrl.Container
 
      ' Container-Rechteck ermitteln
      Call GetWindowRect(Cont.hwnd, ContRect)
 
      Ret = 0 ' zurücksetzen!
      Ret = Cont.ScaleMode ' Prüfen auf VB-konformen ScaleMode
      ' (nur Container mit ScaleMode 1 bis 7 werden unterstützt!)
 
      ' Begrenzungs-Punkte des Control-Rechtecks ermitteln
      If (Ret > 0) Then ' (Form, PictureBox, ... mit ScaleMode ab 1)
        P1.X = Cont.ScaleX(Ctrl.Left, Cont.ScaleMode, vbPixels)
        P1.Y = Cont.ScaleY(Ctrl.Top, Cont.ScaleMode, vbPixels)
        P2.X = P1.X + Cont.ScaleX(Ctrl.Width, Cont.ScaleMode, vbPixels)
        P2.Y = P1.Y + Cont.ScaleY(Ctrl.Height, Cont.ScaleMode, vbPixels)
        Call ClientToScreen(Cont.hwnd, P1)
        Call ClientToScreen(Cont.hwnd, P2)
      Else ' (Frame, ... immer mit Twips)
        P1.X = ContRect.Left + (Ctrl.Left / Screen.TwipsPerPixelX)
        P1.Y = ContRect.Top + (Ctrl.Top / Screen.TwipsPerPixelY)
        P2.X = P1.X + (Ctrl.Width / Screen.TwipsPerPixelX)
        P2.Y = P1.Y + (Ctrl.Height / Screen.TwipsPerPixelY)
      End If
    End If
 
    ' Die Punkte dem Control-Rechteck zuweisen
    CtrlRect.Left = P1.X
    CtrlRect.Top = P1.Y
    CtrlRect.Right = P2.X
    CtrlRect.Bottom = P2.Y
 
    ' Timer starten (Interval-Angabe in Millisekunden)
    Call EnableTimer(50)
  End If
End Sub

' Startet den Timer für die MouseInOut-Überwachung
Private Sub EnableTimer(ByVal msInterval As Long)
  If (lEvent = 0) Then
    lEvent = SetTimer(fForm.hwnd, 44, msInterval, AddressOf TimerProc)
  End If
End Sub

' Timer-Prozedur: löst im Abstand der festgelegten
' Millisekunden die Aktionen für die MouseInOut-States aus.
Private Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
 
  Dim CP As POINTAPI
 
  If (M_Enter = False) Then
    ' ************* Maus tritt in das Control ein ************
     M_Enter = True
     ' MouseIn-Routine aufrufen
     Call DoByMouseIn
  End If
 
  ' Cursor-Position ermitteln
  Call GetCursorPos(CP)
 
  ' - Ist der Cursor innerhalb des Control-Rechtecks?
  '   - Ist die Form aktiv?
  '     - Ist das Control von einer inaktiven "OnTop"-Form
  '         oder "OnTop"-MsgBox teilweise verdeckt?
  If (PtInRect(CtrlRect, CP.X, CP.Y) _
    And (fForm.hwnd = GetForegroundWindow) _
    And (WindowFromPoint(CP.X, CP.Y) = CompHWND)) Then
    ' ************** Maus ist über dem Control ***************
    ' MouseOver-Routine aufrufen (optional)
    ' Call DoByMouseOver
  Else
    ' ************ Maus hat das Control verlassen ************
    DisableTimer
    M_Enter = False
    ' MouseOut-Routine aufrufen
    Call DoByMouseOut
  End If
End Sub

' Beendet den Timer für die MouseInOut-Überwachung
Public Sub DisableTimer()
  If (lEvent <> 0) Then
    KillTimer fForm.hwnd, lEvent
    lEvent = 0
  End If
End Sub

' Auszuführende Aktionen für Maus-Eintritt ("MouseIn")
Private Sub DoByMouseIn()
 
  On Error Resume Next
 
  ' "Pseudo-Ereignis" in der Form aufrufen
  '    * Wichtige Hinweise für "CallByName" siehe unten!
  Call CallByName(fForm, Ctrl.Name & "_MouseIn", VbMethod)
End Sub

' Auszuführende Aktionen für Maus-Austritt ("MouseOut")
Private Sub DoByMouseOut()
 
  On Error Resume Next
 
  ' "Pseudo-Ereignis" in der Form aufrufen
  '    * Wichtige Hinweise für "CallByName" siehe unten!
  Call CallByName(fForm, Ctrl.Name & "_MouseOut", VbMethod)
  CtrlIndex = -1 'Index als uniniziiert markieren (Optional)
End Sub

Wichtige Hinweise für "CallByName"
Um direkt in der Form ein "Pseudo-Ereignis" aufrufen zu können, muss dies erst (von Hand) erstellt werden. Man deklariert dort eine !!ÖFFENTLICHE!! (PUBLIC) Prozedur (Ereignis), die exakt mit dem aufrufenden "CallByName"-String in "MouseInOut (GES)" übereinstimmt!

Ein solches "Pseudo-Ereignis" besteht aus dem Namen des zu überwachenden Controls (z. B. Label1), plus einem Unterstrich, plus entweder MouseIn oder MouseOut.

Beispiele für die Anwendung

Beispiel 1 (Label):

' MouseInOut-Überwachung starten
Private Sub Label1_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  Call MouseInOutTracking(Label1)
End Sub

' "Pseudo-Ereignise"
 
' Maus-Eintritt
Public Sub Label1_MouseIn()
   Label1.ForeColor = vbRed
   Me.Caption = "Maus befindet sich über Label1"
End Sub
 
' Maus-Austritt
Public Sub Label1_MouseOut()
   Label1.ForeColor = vbBlack
   Me.Caption = "Außerhalb"
End Sub

Beispiel 2 (Label-Steuerelementfeld):

' MouseInOut-Überwachung starten
Private Sub Label1_MouseMove(Index As Integer, Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  Call MouseInOutTracking(Label1(Index))
End Sub

' "Pseudo-Ereignise"
 
' Maus-Eintritt
Public Sub Label1_MouseIn()
   Label1(CtrlIndex).ForeColor = vbRed
   Me.Caption = "Maus befindet sich über Label1(" & CtrlIndex & ")"
End Sub

' Maus-Austritt
Public Sub Label1_MouseOut()
    Label1(CtrlIndex).ForeColor = vbBlack
    Me.Caption = "Außerhalb"
End Sub