VB6: How to Search Listbox using API and get all matchs? - vb6

Question

I have a listbox with a few thousand items. The code below given by #AngryHacker in this threat work perfect if i want to get the 1st match. But sometimes i have multiple items with the same data. So, i'd like to get all the match, how to do it?
oh, actually, its something like this:
aa4
sds
aa5
aa6
fdf
dsf
From the list, i want to get the index of the items starting with "aa"
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
'constants for searching the ListBox
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_FINDSTRING = &H18F
'function to get find an item in the Listbox
Public Function GetListBoxIndex(hWnd As Long, SearchKey As String, Optional FindExactMatch As Boolean = True) As Long
If FindExactMatch Then
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRINGEXACT, -1, ByVal SearchKey)
Else
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRING, -1, ByVal SearchKey)
End If
End Function

Answer 1

You can utilize the fact that wParam for LB_FINDSTRING and LB_FINDSTRINGEXACT messages lets the caller to specify the first item to be searched:
wParam
The zero-based index of the item before the first item to be searched. When the search reaches the bottom of the list box, it continues searching from the top of the list box back to the item specified by the wParam parameter. If wParam is – 1, the entire list box is searched from the beginning.
So your GetListBoxIndex takes the following form (note StartIndex argument instead of hardcoded -1):
'LB_ constants
Private Const LB_ERR = -1
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_FINDSTRING = &H18F
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
Public Function GetListBoxIndex(hWnd As Long _
, SearchKey As String _
, StartIndex As Long _
, Optional FindExactMatch As Boolean = True) As Long
If FindExactMatch Then
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRINGEXACT, StartIndex, SearchKey)
Else
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRING, StartIndex, SearchKey)
End If
End Function
The rest depends on what you intend to do with the results afterwards. Below is simple test that merely prints results to Immediate window:
Private Sub Command1_Click()
PrintAllMatches List1.hWnd, Text1.Text
End Sub
Private Sub Form_Load()
List1.AddItem "aa1"
List1.AddItem "bbb"
List1.AddItem "aa2"
End Sub
Private Sub PrintAllMatches(hWnd As Long, SearchKey As String)
Dim firstMatch As Long, nextMatch As Long
nextMatch = GetListBoxIndex(hWnd, SearchKey, -1, False)
If nextMatch = LB_ERR Then
Debug.Print "Not found"
Exit Sub
End If
firstMatch = nextMatch
Do
Debug.Print "Match is at index " & nextMatch
nextMatch = GetListBoxIndex(hWnd, SearchKey, nextMatch, False)
Loop While nextMatch <> firstMatch
End Sub

Answer 2

I have similar case like this how to solve the following code,
Adodc1.Recordset.MoveFirst Adodc1.Recordset.Find "DEBTOR_CODE = '" & Text11.Text & "'" If Adodc1.Recordset.EOF = True Or Adodc1.Recordset.BOF = True Then MsgBox "Record Not Found!", vbApplicationModal Adodc1.Recordset.MoveFirst Me.Combo1.SetFocus Me.Combo1.ListIndex = Me.Text11.Text End If
i have to search debtor_code and each debtor has multiple addresses, i need to get the multiple answers in a combo box