vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
TOP-Angebot: 17 bzw. 24 Entwickler-Vollversionen zum unschlagbaren Preis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB4, VB5, VB606.04.04
MouseIn/MouseOut für Controls ohne hWND (GES)

Um Aktionen ausführen lassen, wenn die Mouse ein Control überfährt, benötigt man bekannterweise eine Art MouseIn-/MouseOut-Ereignis.

Autor:  Guido EisenbeisBewertung:     [ Jetzt bewerten ]Views:  1.592 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Um Aktionen ausführen lassen, wenn die Mouse 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. Das Besondere an diesem Code ist, dass das Control kein hWnd besitzen muss (z.B. Label und Image). Geprüft wird die Maus-Position.

Diese MouseInOut-Überwachung funktioniert sehr präzise. In der aufrufenden Form können die "Pseudo-Ereignisse" "MouseIn","MouseOver" und "MouseOut" genauso wie "normale" Ereignisse (z.B. Click) aufgerufen werden. Der Aufruf erfolgt im MouseMove des jeweiligen Controls.

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
 
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 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 M_Enter As Boolean  ' Indikator für "MouseIn"
' Starten der MouseOver-Überwachung
Public Sub PrüfeMouseOver(ByVal Form As Form, ByVal cControl As Control)
  Dim Ret As Long
  Dim Cont As Object    ' Container des jeweiligen Controls
  Dim ContRect As RECT  ' Container-Recheck (Fläche)
  Dim P1 As POINTAPI    ' Begrenzungs-Punkte ...
  Dim P2 As POINTAPI    ' ... des Control-Rechtecks
 
  On Error Resume Next
 
  If Not Ctrl Is Nothing Then
 
    ' Falls 2 überwachte Controls sehr dicht
    ' beieinander liegen oder sich sogar überlappen
    If Not cControl.Container Is Ctrl.Container _
        Or Not cControl.Left = Ctrl.Left _
            Or Not cControl.Width = Ctrl.Width _
                Or Not cControl.Top = Ctrl.Top _
                    Or Not cControl.Height = Ctrl.Height Then
 
        ' Mouse hat das Control verlassen
        M_Enter = False
        DisableTimer
 
        ' MouseOut-Routine aufrufen
        Call DoByMouseOut
    End If
  End If
 
  Set fForm = Form
  Set Ctrl = cControl
 
  If M_Enter = False Then
    Ret = 0 ' zurücksetzen!
    Ret = Ctrl.hwnd ' Wegen "On Error ..."-Prüfung gesondert zuweisen
 
    If Ret <> 0 Then  ' Control besitzt ein HWND
 
      Ret = 0 ' zurücksetzen!
      Ret = Ctrl.ScaleMode ' Prüfen auf VB-konformen ScaleMode
 
      ' Begrenzungs-Punkte des Control-Rechtecks ermitteln
 
      If Ret > 0 Then
        ' Nur "Innen-Fläche" (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
 
      ' (nur Container mit VB-konformen ScaleMode werden unterstützt!)
      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
 
      ' 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, ...)
        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 MouseOver-Überwachung
Private Sub EnableTimer(ByVal msInterval As Long)
  If lEvent = 0 Then
    lEvent = SetTimer(fForm.hwnd, 44, msInterval, AddressOf TimerProc)
  End If
End Sub
' Die Timer-Prozedur löst im Abstand der festgelegten
' Millisekunden die Aktionen für die MouseOver-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
 
  On Error Resume Next
 
  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?
  If PtInRect(CtrlRect, CP.X, CP.Y) Then
    ' *** Maus ist über dem Control ***
 
    ' MouseOver-Routine aufrufen
    Call DoByMouseOver
  Else
    ' *** Maus hat das Control verlassen ***
    M_Enter = False
    DisableTimer
 
    ' MouseOut-Routine aufrufen
    Call DoByMouseOut
  End If
End Sub
' Beendet den Timer für die MouseOver-Ü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
 
  ' Entweder Aktion für Maus-Eintritt hier einsetzen, oder ...
  Beep
 
  ' ... direkt in der Form ein "Pseudo-Ereignis" aufrufen
  '     * Wichtiger Hinweis siehe Anmerkung am Ende des Tipps!
  Call CallByName(fForm, Ctrl.Name & "_MouseIn", VbMethod)
End Sub
' Auszuführende Aktionen für Maus-Drüber ("MouseOver")
Private Sub DoByMouseOver()
  Dim Indx As String
 
  On Error Resume Next
 
  ' Entweder Aktion für Maus-Drüber hier einsetzen, oder ...
  Ctrl.ForeColor = vbRed
  Form1.Label1.ForeColor = vbRed
  Indx = " (" & Ctrl.Index & ")"
  Form1.Label1.Caption = "Maus befindet sich über " & Ctrl.Name & Indx
 
  ' ... direkt in der Form ein "Pseudo-Ereignis" aufrufen
  '     * Wichtiger Hinweis siehe Anmerkung am Ende des Tipps!
  Call CallByName(fForm, Ctrl.Name & "_MouseOver", VbMethod)
End Sub
' Auszuführende Aktionen für Maus-Austritt ("MouseOut")
Private Sub DoByMouseOut()
 
  On Error Resume Next
 
  ' Entweder Aktion für Maus-Austritt hier einsetzen, oder ...
  Ctrl.ForeColor = vbBlack
  Form1.Label1.ForeColor = vbBlue
  Form1.Label1.Caption = "Außerhalb"
 
  ' ... direkt in der Form ein "Pseudo-Ereignis" aufrufen
  '     * Wichtiger Hinweis siehe Anmerkung am Ende des Tipps!
  Call CallByName(fForm, Ctrl.Name & "_MouseOut", VbMethod)
End Sub

Beispiele für die Anwendung

Beispiel 1:

Private Sub Picture1_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  Call PrüfeMouseOver(Me, Picture1)
End Sub

Beispiel 2 (Steuerelemente-Feld):

Private Sub Label2_MouseMove(Index As Integer, Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  Call PrüfeMouseOver(Me, Label2(Index))
End Sub

Wichtiger Hinweis für "CallByName"
Soll direkt in der Form ein "Pseudo-Ereignis" aufgerufen werden, so muss dort eine Prozedur ÖFFENTLICH (PUBLIC)!! deklariert werden und exakt mit dem aufrufenden String übereinstimmen!

Aufruf-Beispiel für "Pseudo-Ereignise":

' Starten der MouseInOut-Überwachung
Private Sub Label2_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  Call PrüfeMouseOver(Me, Label2)
End Sub
' "Pseudo-Ereignis" für Maus-Eintritt
Public Sub Label2_MouseIn()
  Beep
End Sub
 
' "Pseudo-Ereignis" für Maus-Drüber
Public Sub Label2_MouseOver()
  Label2.ForeColor = vbRed
  Label1.Caption = "Maus befindet sich über " & Label2.Name
End Sub
 
' "Pseudo-Ereignis" für Maus-Austritt
Public Sub Label2_MouseOut()
  Label2.ForeColor = vbBlack
  Label1.Caption = "Außerhalb"
End Sub