vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Maus & Tastatur · Maus   |   VB-Versionen: VB622.04.05
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 OtterBewertung:     [ Jetzt bewerten ]Views:  25.382 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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
 

Dieser Tipp wurde bereits 25.382 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (3 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel