Rubrik: Controls · ListBox | VB-Versionen: VB5, VB6 | 14.12.07 |
List/ComboBox: Hinzufügen nur wenn nicht vorhanden Mit diesen Prozeduren werden neue Einträge nur dann hinzugefügt, wenn diese noch nicht in der ListBox/ComboBox vorhanden sind. | ||
Autor: Rolf Wahlbrinck | Bewertung: | Views: 16.075 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Heute möchten wir Ihnen ein paar Prozeduren vorstellen, mit denen neue Einträge nur dann hinzugefügt werden, wenn diese noch nicht in der ListBox bzw. ComboBox vorhanden sind. Hierbei lässt sich auf Wunsch auch zwischen Groß-/Kleinschreibung unterscheiden.
Option Explicit ' benötigte API-Deklarationen Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Integer, _ ByVal lParam As Any) As Long
Code für die ListBox:
' Nur hinzufügen, wenn noch nicht vorhanden, unter ' Berücksichtigung exakter Groß-/Kleinschreibung Private Sub LBAddIfNewExakt(LB As ListBox, strText As String) Const LB_FINDSTRING_EXAKT As Long = &H1A2 Dim FundIndex As Long Dim StartIndex As Integer Dim LBListCount As Long StartIndex = -1 LBListCount = LB.ListCount FundIndex = SendMessage(LB.hwnd, LB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Do If FundIndex = -1& Then ' nicht gefunden -> Abbruch Suche LB.AddItem strText Exit Do Else If LB.List(FundIndex) = strText Then Exit Do ' schon exakt vorhanden Else ' gefunden aber nicht exakt gleich If FundIndex + 1 < LBListCount Then ' -> weitersuchen StartIndex = FundIndex + 1 Else ' Listenende wurde erreicht -> Abbruch Suche LB.AddItem strText Exit Do End If End If End If FundIndex = SendMessage(LB.hwnd, LB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Loop End Sub
' Groß- / Kleinschreibung ist egal Private Sub LBAddIfNewTolerant(LB As ListBox, strText As String) Const LB_FINDSTRING_EXAKT As Long = &H1A2 If SendMessage(LB.hwnd, LB_FINDSTRING_EXAKT, -1, _ ByVal strText) = -1& Then LB.AddItem strText End If End Sub
Code für die ComboBox:
' Nur hinzufügen, wenn noch nicht vorhanden, unter ' Berücksichtigung exakter Groß-/Kleinschreibung Private Sub CBAddIfNewExakt(CB As ComboBox, strText As String) Const CB_FINDSTRING_EXAKT As Long = &H158 Dim FundIndex As Long Dim StartIndex As Integer Dim CBListCount As Long StartIndex = -1 CBListCount = CB.ListCount FundIndex = SendMessage(CB.hwnd, CB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Do If FundIndex = -1& Then ' nicht gefunden -> Abbruch Suche CB.AddItem strText Exit Do Else If CB.List(FundIndex) = strText Then Exit Do ' schon exakt vorhanden Else ' gefunden aber nicht exakt gleich If FundIndex + 1 < CBListCount Then ' -> weitersuchen StartIndex = FundIndex + 1 Else ' Listenende wurde erreicht -> Abbruch Suche CB.AddItem strText Exit Do End If End If End If FundIndex = SendMessage(CB.hwnd, CB_FINDSTRING_EXAKT, _ StartIndex, ByVal strText) Loop End Sub
' Groß- / Kleinschreibung ist egal Private Sub CBAddIfNewTolerant(CB As ComboBox, strText As String) Const CB_FINDSTRING_EXAKT As Long = &H158 If SendMessage(CB.hwnd, CB_FINDSTRING_EXAKT, -1, _ ByVal strText) = -1& Then CB.AddItem strText End If End Sub
Beispiel:
Platzieren Sie auf die Form 2 ListBox-Controls (List1 und List2), sowie 2 ComboBox-Controls (Combo1 und Combo2). Fügen Sie nachfolgenden Code in das Form_Load Ereignis ein:
Private Sub Form_Load() ' ein paar Testeinträge Dim BeispielText(6) As String BeispielText(0) = "Herbert" BeispielText(1) = "Müller" BeispielText(2) = "Meyer" BeispielText(3) = "MEYER" BeispielText(4) = "Grever" BeispielText(5) = "Ofen" BeispielText(6) = "Ofen" Dim i As Integer ' ListBox/ComboBox mit allen Einträgen füllen, wobei ' bereits vorhandene Einträge nicht doppelt ' eingefügt werden. Hierbei soll die ' Groß-/Kleinschreibung UNBERÜCKSICHTIGT bleiben! List1.Clear For i = 0 To 6 LBAddIfNewExakt List1, BeispielText(i) Next i Combo1.Clear For i = 0 To 6 CBAddIfNewExakt Combo1, BeispielText(i) Next i ' jetzt alle nicht doppelten alle Einträge ' hinzufügen, wobe die Groß-/Kleinschreibung ' berücksichtigt werden soll List2.Clear For i = 0 To 6 LBAddIfNewTolerant List2, BeispielText(i) Next i Combo2.Clear For i = 0 To 6 CBAddIfNewTolerant Combo2, BeispielText(i) Next i End Sub