Die Community zu .NET und Classic VB.
Menü

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

 von 

Beschreibung 

Eine Listbox kann normalerweise nicht mitteilen, auf welchen Eintrag mit der rechten Maustaste geklickt wurde. Dieser Tipp zeigt, wie man es herausfinden kann.

Änderung am 08. März 2003: Kleinere Fehler wurden behoben. Nähere Infos im Sourcecode.
Update am 23. September 2004 von Herfried K. Wagner: Die API-Deklaration wurde korrigiert.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

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 --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

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.

Kommentar von Simon Frankenberger am 26.08.2007 um 20:46

Danke an Timon, deine Lösung funktioniert einwandfrei und ist einfacher als die obige Lösung (welche übrigends bei mir nicht funktioniert!).

Kommentar von Timon am 15.05.2007 um 11:22

hmm ich hatte ein ähnliches Problem:
Beim Rechtsklick auf ein Eintrag wird dieser Markiert und z.B ein InputBox mit dem Eintrag geöffnet. Das Ganze braucht dazu die "mouse_event" API.

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags _
As Long, ByVal dx As Long, ByVal dy As Long, ByVal _
cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_ABSOLUTE = &H8000

Private Sub List1_MouseDown(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
If Button = vbRightButton Then
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End If
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
If Button = vbRightButton Then
Dim str As String
str = InputBox("", "Titel", List1.List(List1.ListIndex))
End If
End Sub

Ich dänke das löst die meisten Probleme auf einfache Art..
FeedBack erwünscht!

Kommentar von wulle am 08.08.2001 um 05:24

Hi Helge,
hmmm der Tipp ist ja ganz nett, innsbesondere die Verwendung von LB_GETITEMRECT ist gut erklärt.
Dennoch halte ich diesen Code für problematisch, denn es werden alle Einträge bis zum gesuchten durchlaufen. Du könntest ja wenigstens mit LB_GETTOPINDEX den Start der Schleife setzen.
Ausserdem beinhaltet der Ansatz sehr viel Code.
Hier mein Vorschlag:
Idx = ListBoxItemByPos(List1, x / Screen.TwipsPerPixelX, Y / Screen.TwipsPerPixelY)
Und die Funktion:
Public Function ListBoxItemByPos(Li As ListBox, ByVal xPixel As Integer, ByVal yPixel As Integer) As Long
ListBoxItemByPos = SendMessage(Li.hWnd, LB_ITEMFROMPOINT, 2, ByVal CLng((yPixel * 65536) + xPixel))
If ListBoxItemByPos = SendMessage(Li.hWnd, LB_GETCOUNT, &H0&, ByVal &H0&) Then ListBoxItemByPos = -1
End Function
Beim Testen der Funktionen sind mir einige typische MS-Ungereimtheiten aufgefallen:
LB_GETITEMRECT - Fehler ab 2^15. Eintrag.
LB_GETITEMHEIGHT - Fehler ab 2^15. Eintrag.
LB_ITEMFROMPOINT - Fängt ab 2^16 Einträgen wieder bei 0 an. (Deshalb funktioniert meine Routine nur bis zum 64k. Eintrag)
LB_GETCOUNT liefert auch jenseits dieser Grenzen korrekte Werte.
Ich möchte Wetten das der Quality-Manager bei MS schon 1978 wegrationalisiert wurde, anders kann ich mir ein solches Chaos nicht vorstellen. (Hey Bill gimme this job!)
Ich bin gespannt was bei mehrspaltigen Listboxes passiert. (Feedback erwünscht)
enjoy wulle