Mausklick formweit abfragen Dieser Tipp zeigt, wie man formweit auf Mausklicks reagieren kann - egal, auf welches Control auf der Form der Mausklick erfolgte.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  28.953
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Manchmal ist es notwendig, formweit auf Mausklicks zu reagieren, um bspw. ein einheitliches Programm-Menü per Rechtsklick anzuzeigen. Spontan würde der ein oder andere jetzt sagen: "Wo ist da das Problem? Einfach im Form_MouseDown den Button-Parameter abfragen und bei Rechtsklick das Programm-Menü anzeigen:"

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  If Button = 2 Then
    ...
  End If
End Sub

Jetzt aber der Haken an der Geschichte: Befindet sich der Mauszeiger zum Zeitpunkt des Mausklicks auf einem Control auf der Form, erhält das Control die Maus-Message - und nicht die Form. D.h. man müsste jetzt im MouseDown-Ereignis aller Controls den Mausklick abfragen

Wie man diesen doch ernormen "Schreibaufwand" umgehen kann, dass zeitg nachfolgender Code.

Wir platzieren hierzu ein Timer-Control auf die Form und fragen zyklisch über die API-Funktion "GetAsyncKeyState" die Mausklicks ab. Somit können wir formweit in einer einzigen Prozedur die Mausklicks auswerten und entsprechend darauf reagieren.

Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function GetAsyncKeyState Lib "user32.dll" ( _
  ByVal vKey As Long) As Integer
 
Private Declare Function GetForegroundWindow Lib "user32" () As Long
 
Private Const VK_RBUTTON = &H2
Private Const VK_LBUTTON = &H1

Private Sub Form_Load()
  ' Timer initialisieren und starten
  Timer1.Interval = 100
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  ' rechte Maustaste abfragen
  ' aber nur, wenn unsere Form das aktive Fenster ist!
  If GetForegroundWindow() = Me.hwnd Then
    If GetAsyncKeyState(VK_RBUTTON) And 1 = 1 Then
      ' rechte Maustaste wurde gedrückt
      ' jetzt Kontextmenü anzeigen
      Me.PopUpMenu ...
    End If
  End If
End Sub

Gehen wir noch einen Schritt weiter. Nehmen wir an, bei dem Kontextmenü handelt es sich nicht um ein "Standard"-Menü, sondern um eine PictureBox mit individuellen Menü-Schaltflächen. Per Rechtsklick soll die PictureBox dann an der aktuellen Mausposition angezeigt werden. Hierzu müssen wir aber erst einmal die aktuelle Mausposition ermitteln, was mit Hilfe der API-Funktion "GetCursorPos" aber kein großes Problem darstellt. Befindet sich der Mauszeiger jedoch zu weit am unteren Form-Rand, sollte die PictureBox "nach oben" aufklappen - eben ganz nach dem Vorbild des Standard-Menüs.

Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function GetAsyncKeyState Lib "user32.dll" ( _
  ByVal vKey As Long) As Integer
 
Private Declare Function GetForegroundWindow Lib "user32" () As Long
 
Private Declare Function GetCursorPos Lib "user32" ( _
  lpPoint As POINTAPI) As Long
 
Private Declare Function ScreenToClient Lib "user32" ( _
  ByVal hwnd As Long, _
  lpPoint As POINTAPI) As Long
 
Private Const VK_RBUTTON = &H2
Private Const VK_LBUTTON = &H1
 
Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Sub Form_Load()
  ' Timer initialisieren und starten
  Timer1.Interval = 100
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  ' rechte Maustaste abfragen
  If GetForegroundWindow() = Me.hwnd Then
    If GetAsyncKeyState(VK_RBUTTON) And 1 = 1 Then
      ' rechte Maustaste wurde gedrückt
      ' jetzt Mauskoordinaten ermitteln
      Dim P As POINTAPI
 
      GetCursorPos P
      ScreenToClient Me.hwnd, P
 
      P.X = P.X * Screen.TwipsPerPixelX
      P.Y = P.Y * Screen.TwipsPerPixelY
 
      ' Menü (PictureBox) anzeigen
      With Picture1
        ' zunächst korrekt positionieren
        .Move P.X, P.Y
        If .Top + .Height > Me.ScaleHeight Then .Top = P.Y - .Height
        If .Top < 0 Then .Top = 0
        If .Left + .Width > Me.ScaleWidth Then .Left = P.X - .Width
        If .Left < 0 Then .Left = 0
 
        ' sicherstellen, dass die PictureBox im Vordergrund ist
        .ZOrder
 
        ' und letztendlich das Ganze dann auch anzeigen
        .Visible = True
      End With
 
    ElseIf GetAsyncKeyState(VK_LBUTTON) And 1 = 1 Then
      ' Menü (PictureBox) wieder ausblenden
      Picture1.Visible = False
    End If
  End If
End Sub

Sodala... das funktioniert jetzt ja schon wunderprächtig.

Aber HALT: Befindet sich der Mauszeiger zum Zeitpunkt des Rechtsklick innerhalb einer TextBox wird sowohl das Programm-Menü (PictureBox), als auch das Standard-Kontextmenü der TextBox angezeigt. In diesem Fall soll aber jetzt nur das Standard-Kontextmenü der TextBox erscheinen.

Hierfür "merken" wir uns im Form_Load-Ereignis die Fensterhandle aller auf der Form vorhandenen TextBox-Controls und prüfen dann im Timer-Event, ob sich der Mauszeiger zufällig auf eines dieser gemerkten Controls befindet. Die Fensterhandle der Controls speichern wir am besten in einem Collection-Objekt.

Ergänzen wir obigen Code noch um folgende Codezeilen (fett gedruckt):

Option Explicit
 
' Benötigte API-Deklarationen
...
Private Declare Function WindowFromPoint Lib "user32" ( _
  ByVal xPoint As Long, _
  ByVal yPoint As Long) As Long
 
Private Declare Function GetWindowRect Lib "user32" ( _
  ByVal hwnd As Long, _
  lpRect As RECT) As Long
 
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
...
 
' Collection-Objekt für die Fensterhandles der TextBox-Controls
Private oTBCol As Collection

Im Form_Load-Ereignis durchlaufen wir jetzt erst einmal alle Controls der Form und merken uns die Fensterhandle all derjenigen Controls, bei denen unser Programm-Menü nicht angezeigt werden soll.

Private Sub Form_Load()
  ' alle Controls durchlaufen und Fensterhandle merken
  Dim oControl As Control
 
  Set oTBCol = New Collection
  For Each oControl In Me.Controls
    If TypeOf oControl Is VB.TextBox Then
      With oControl
        oTBCol.Add CStr(.hwnd), "k" & CStr(.hwnd)
      End With
    End If
  Next
  ...
End Sub

Im Timer-Event prüfen wir nun zusätzlich, ob der Rechtsklick auf einem der gemerkten Controls erfolgte...

Private Sub Timer1_Timer()
  ' rechte Maustaste abfragen
  If GetForegroundWindow() = Me.hwnd Then
    If GetAsyncKeyState(VK_RBUTTON) And 1 = 1 Then
      ' rechte Maustaste wurde gedrückt
      ' jetzt Mauskoordinaten ermitteln
      Dim P As POINTAPI
 
      GetCursorPos P
 
      ' Fensterhandle des Objekts ermitteln, auf dem der
      ' Mausklick erfolgte und die Ganze Prozedur verlassen,
      ' falls es sich hierbei um ein Control aus unserer
      ' Controls-Collection handelt
      If IsInCollection(oTBCol, "k" & WindowFromPoint(P.X, P.Y)) Then
        Picture1.Visible = False
        Exit Sub
      End If
 
      ScreenToClient Me.hwnd, P
      ...
 
    ElseIf GetAsyncKeyState(VK_LBUTTON) And 1 = 1 Then
      ' Menü (PictureBox) wieder ausblenden
      If Picture1.Visible Then
        ' Erfolgte der Klick innerhalb des Menü (der PictureBox?)
        ' Falls ja - Menü angezeigt lassen, damit die Controls innerhalb der 
        ' PictureBox auf den Klick reagieren können!
        GetCursorPos P
        GetWindowRect Picture1.hwnd, R
        If PtInRect(R, P.x, P.y) Then Exit Sub
      End If
 
      Picture1.Visible = False
    End If
  End If
End Sub
 
End Sub

' Existiert ein Element mit einem bestimmten Key-Wert?
Private Function IsInCollection(ByRef oCol As Collection, ByRef sKey As String) As Boolean
  On Error Resume Next
  IsInCollection = Not IsEmpty(oCol(sKey))
  On Error GoTo 0
End Function

Puh... geschafft: jetzt funktioniert unsere "formweite" Mausklickabfrage perfekt