Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0787: Ausgewählte Einträge in einer ListBox per API finden

VB 5/6-Tipp 0787: Ausgewählte Einträge in einer ListBox per API finden

 von Dario

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SendMessageA (SendMessage)

Download: Download des Beispielprojektes [3,06 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: Schaltfläche "Command1"
' Steuerelement: Listen-Steuerelement "List1"
Option Explicit

Private Sub Command1_Click()
   Dim Selected() As Long
   Dim i          As Long
   
   Selected = GetSelItems(List1.hWnd) ' Die ausgewählen Eintragsindizes holen
   
   If HasSelectedItems(List1.hWnd) Then Exit Sub '  Gibt es überhaupt ausgewählte Einträge
   
   For i = LBound(Selected) To UBound(Selected)
      List1.Selected(Selected(i)) = False
   Next i
End Sub

Private Sub Form_Load()
   Call InitListbox
   If IsSingleSelection(List1.hWnd) Then Call MsgBox("Die Listbox soll Mehrfachauswahl unterstützen", vbCritical)
End Sub

Public Sub InitListbox()
   Dim i As Long
   
   For i = 65 To 90
      Call List1.AddItem(Chr(i))
   Next i
End Sub

Private Sub List1_Click()
   Caption = "Listboxen ( " & CStr(GetSelCountByAPI(List1.hWnd)) & " Einträge )"
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--- Anfang Modul "mdlListBoxAPI" alias mdlListBoxAPI.bas ---
Option Explicit

' Konstanten deklarieren
Global Const LB_GETSEL       As Long = &H187&
Global Const LB_GETSELCOUNT  As Long = &H190&
Global Const LB_GETSELITEMS  As Long = &H191&
Global Const LB_ERR          As Long = -1

' API's
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal LBsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

' ****************************************************************************

' Unterstützt die Listbox keine Mehrfachauswahl?
Public Function IsSingleSelection(ByVal hWnd As Long) As Boolean
   IsSingleSelection = (SendMessage(hWnd, LB_GETSELCOUNT, 0&, 0&) = LB_ERR)
End Function

' ListBox ist frei von ausgewählten Einträgen?
Public Function HasSelectedItems(ByVal hWnd As Long) As Boolean
   HasSelectedItems = (GetSelCountByAPI(hWnd) = 0)
End Function

' List1.SelCount mal anders ;-)
Public Function GetSelCountByAPI(ByVal hWnd As Long) As Integer
   Dim ret As Long
   
   ret = SendMessage(hWnd, LB_GETSELCOUNT, 0&, 0&)
   
   GetSelCountByAPI = ret
End Function

' Direkt die ausgewählten Einträge laden
Public Function GetSelItems(ByVal hWnd As Long) As Long()
   Dim SelCount As Long
   Dim Buffer() As Long
   
   SelCount = GetSelCountByAPI(hWnd)
   
   If SelCount = 0 Then Exit Function
   
   ReDim Buffer(0 To SelCount - 1)
   
   Call SendMessage(hWnd, LB_GETSELITEMS, SelCount, VarPtr(Buffer(0)))
   
   GetSelItems = Buffer
End Function

'---- Ende Modul "mdlListBoxAPI" alias mdlListBoxAPI.bas ----
'-------------- Ende Projektdatei Projekt1.vbp --------------