Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0422: Eintrag unter der Maus bei Rechtsklick auf eine ListBox bestimmen

VB 5/6-Tipp 0422: Eintrag unter der Maus bei Rechtsklick auf eine ListBox bestimmen

 von Helge Rex

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SendMessageA (SendMessage)

Download: Download des Beispielprojektes [2,96 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 Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listen-Steuerelement "List1"

'Autor: Helge Rex
'E-Mail: helge@activevb.de
'WWW:  http://www.das-koenigreich.de

'Original nach Anmerkungen von wulle@c-w.de geändert:
'Es wird jetzt die Konstante LB_ITEMFROMPOINT verwendet.
'Bei Listen, in denen mehr Platz zur Verfügung steht, als
'Einträge vorhanden sind, lief das Beispiel von wulle aber
'ins offene Messer, deshalb wurde sein Code von mir weiter
'angepasst. Außerdem unterstützt der Code jetzt mehrspaltige
'Listboxen.

Option Explicit

Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long

'Datentyp für die Koordinaten eines Eintrags in der ListBox
Private Type ListRect
    XLeft As Long
    YTop As Long
    XRight As Long
    YBottom As Long
End Type

'Ein paar Konstanten
Private Const LB_GETITEMRECT As Long = &H198&
Private Const LB_ITEMFROMPOINT As Long = &H1A9&

Private Sub Form_Load()
    Dim lngCount As Long
    
    For lngCount = 1 To 150
        Me.List1.AddItem "Eintrag " & CStr(lngCount)
    Next lngCount
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
    
    Dim Idx As Long
    
    If Button = 2 Then
        Idx = GetRightClickedItem(List1, X, Y)
        
        If Idx <> -1 Then
            MsgBox "Sie haben auf den " & Idx & ". Eintrag (" & _
                 List1.List(Idx) & ") rechtsgeklickt!"
        Else
            MsgBox "Keinen Eintrag angeklickt!"
        End If
    End If
End Sub

Private Function GetRightClickedItem(DieListe As ListBox, _
    ByVal PosX As Single, ByVal PosY As Single) As Long
        
    Dim lngItem As Long   'Item mit der kürzesten Distanz
    Dim hwnd As Long      'Handle der Listbox
    Dim MSG As Long       'Nachricht, die gesendet wird
    Dim wParam As Long    'erster Nachrichten-Parameter
    Dim lParam As Long    'zweiter Nachrichten-Parameter
    Dim lngResult As Long 'Ergebnis des API-Calls
    Dim IRect As ListRect 'Rechteck um einen Eintrag
    
    'Handle der Listbox speichern
    hwnd = DieListe.hwnd
    
    'Koordinaten in Pixel umrechnen
    PosX = PosX \ Screen.TwipsPerPixelX
    PosY = PosY \ Screen.TwipsPerPixelY
    
    'Item auslesen, welches dem Click am nächsten liegt
    MSG = LB_ITEMFROMPOINT
    wParam = &H0&
    lParam = (CLng(PosY) * 65536) + CLng(PosX)
    lngItem = SendMessage(hwnd, MSG, wParam, ByVal lParam)
    
    'Abmessung des Items auslesen
    MSG = LB_GETITEMRECT
    wParam = lngItem
    lngResult = SendMessage(hwnd, MSG, wParam, VarPtr(IRect))
    
    'Ist außerhalb des Items geclickt worden?
    If Not (((PosY >= IRect.YTop) And (PosY <= IRect.YBottom)) _
        And ((PosX >= IRect.XLeft) And (PosX <= _
        IRect.XRight))) Then
        
        'Ja, also wurde ausserhalb der Liste geclickt
        lngItem = -1
    Else
        'Nein, es wurde ein Item in der Liste angeclickt
    End If
    
    'Rückgabe setzen
    GetRightClickedItem = lngItem
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.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.