Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0773: Kontextmenü für ListBox realisieren

VB 5/6-Tipp 0773: Kontextmenü für ListBox realisieren

 von Henrik Ilgen

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SendMessageA (SendMessage)

Download: Download des Beispielprojektes [2.82 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"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Menü "mnuList1Context"
' Steuerelement: Menü "mnuNewEntryBefore" auf mnuList1Context
' Steuerelement: Menü "mnuNewEntry" auf mnuList1Context
' Steuerelement: Menü "mnuNewEntryAfter" auf mnuList1Context
' Steuerelement: Menü "mnuSeperator1" auf mnuList1Context
' Steuerelement: Menü "mnuDeleteAll" auf mnuList1Context
' Steuerelement: Menü "mnuDeleteEntry" auf mnuList1Context
Option Explicit

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

Const LB_ITEMFROMPOINT As Long = &H1A9

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim tmpX As Long, tmpY As Long, tmpPos As Long
   Dim tmpLng As Long
   
   If Button = vbRightButton Then
      tmpX = CLng(X / Screen.TwipsPerPixelX)
      tmpY = CLng(Y / Screen.TwipsPerPixelY)
      ' lParam erhält einen DWORD (Long),
      ' - oberes WORD (Integer): Y-Koordinate in Pixel
      ' - unteres WORD (Integer): X-Koordinate in Pixel
      tmpPos = (tmpY * &H10000) Or tmpY
      ' Rückgabe: DWORD (Long),
      ' - oberes WORD (Integer):
      '  -> 0 (Null), wenn ein Eintrag angeklickt wurde
      '  -> 1 (Eins), wenn in den weißen Bereich geklickt wurde)
      tmpLng = SendMessage(List1.hWnd, LB_ITEMFROMPOINT, 0&, tmpPos)
      
      ' Wenn (tmpLng And &H10000) = &H10000, dann wurde in den weißen
      ' Bereich geklickt
      If (tmpLng And &H10000) = &H10000 Then
         ' Alle Einträge anzeigen, die sich nicht auf ein spezielles
         ' Element beziehen
         
         mnuDeleteEntry.Enabled = False
         mnuNewEntryBefore.Enabled = False
         mnuNewEntryAfter.Enabled = False
         mnuDeleteAll.Enabled = False
         ' mnuNewEntry ist immer verfügbar
         mnuNewEntry.Enabled = True
      Else
         ' Angeklicktes Element markieren
         List1.ListIndex = tmpLng
         
         ' Alle Einträge anzeigen, die sich nur auf ein bestimmtes
         ' Element beziehen
         mnuDeleteEntry.Enabled = True
         mnuNewEntryBefore.Enabled = True
         mnuNewEntryAfter.Enabled = True
         mnuDeleteAll.Enabled = True
         ' mnuNewEntry ist immer verfügbar
         mnuNewEntry.Enabled = True
      End If
      
      ' Popup-Menu anzeigen
      Call Me.PopupMenu(mnuList1Context)
   End If
End Sub

Private Sub mnuDeleteAll_Click()
   ' Alle Elemente löschen
   Call List1.Clear
End Sub

Private Sub mnuDeleteEntry_Click()
   ' Gewähltes Element löschen
   Call List1.RemoveItem(List1.ListIndex)
End Sub

Private Sub mnuNewEntry_Click()
   Dim NewEntry As String
   
   ' Elementtext eingeben und hinzufügen
   NewEntry = InputBox("Geben sie den neuen Eintrag ein:", "Neuer Eintrag")
   If Trim$(NewEntry) <> "" Then
      Call List1.AddItem(NewEntry)
   End If
End Sub

Private Sub mnuNewEntryAfter_Click()
   Dim NewEntry As String
   
   ' Elementtext eingeben und hinzufügen
   NewEntry = InputBox("Geben sie den neuen Eintrag ein:", "Neuer Eintrag")
   If Trim$(NewEntry) <> "" Then
      Call List1.AddItem(NewEntry, List1.ListIndex + 1)
   End If
End Sub

Private Sub mnuNewEntryBefore_Click()
   Dim NewEntry As String
   
   ' Elementtext eingeben und hinzufügen
   NewEntry = InputBox("Geben sie den neuen Eintrag ein:", "Neuer Eintrag")
   If Trim$(NewEntry) <> "" Then
      Call List1.AddItem(NewEntry, List1.ListIndex)
   End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------