Binaryworld - Incremental searches within list boxes ... [ VB -> Forms & Controls ]

The DBList and DBCombo controls expose a MatchEntry property, that - when set to True - permits to perform quick incremental searches by simply typing the searched sequence of characters. If MatchEntry is set to False, any time the user presses a key, the next item that begins with that character becomes the highlighted item. Unfortunately this feature has not been added to standard unbound list box and combo box controls, and we have to implement it using two separate controls, a text box and a listbox, and a lot of code. The principle is simple: when the search string typed in the text box changes, a fast search is performed on the list box (using the LB_FINDSTRING message).

When a match is found, the selection is moved on the corresponding item and it also appears in the text box editing area, with the remaining characters already selected (so that they can be easily overwritten by another key press).

Click here to copy the following block

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal _
  hWnd As Long, ByVal msg As Long, ByVal wParam As Long, _
  lParam As Any) As Long
Const LB_FINDSTRING = &H18F

' this is a form-level variable
Dim DoSearch As Integer

Sub List1_Click()
  ' user selected a new item
  ' (also activated by Text1_KeyDown)
  Text1.text = List1.text
End Sub

Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, _
  Y As Single)
  ' keep the two controls synchronized
  Text1.text = List1.text
End Sub

Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, _
  Y As Single)
  ' keep the two controls synchronized
  Text1.text = List1.text
End Sub

Sub Text1_Change()
  Static active As Boolean
  Dim index As Integer
  Dim search As String
  Dim found As Integer

  ' avoid recursive calls
  If active Or DoSearch = False Then Exit Sub
  active = True
  ' search is not case sensitive
  search = UCase$(Text1.text)
  found = -1

  ' search the first item in the listbox
  ' that matches the search string in the textbox
  found = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal search)
  If found >= 0 Then
    ' make the found value the current item
    List1.ListIndex = found
    Text1.text = List1
    ' select the remaining characters
    Text1.SelStart = Len(search)
    Text1.SelLength = 999
  End If
  active = False
End Sub

Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  If Shift Then
    ' do nothing if a shift key is pressed
  ElseIf KeyCode = vbKeyUp Then
    ' move on previous item
    If List1.ListIndex > 0 Then
      List1.ListIndex = List1.ListIndex - 1
    End If
    KeyCode = 0
  ElseIf KeyCode = vbKeyDown Then
    ' move on next item
    If List1.ListIndex < List1.ListCount - 1 Then
      List1.ListIndex = List1.ListIndex + 1
    End If
    KeyCode = 0
  End If
End Sub

Sub Text1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 8 And Text1.SelStart > 0 Then
    ' if BackSpace has be pressed, trim one
    ' character off the search string
    DoSearch = False
    Text1.text = Left$(Text1.text, Text1.SelStart)
    Text1.SelStart = Len(Text1.text)
  Else
    DoSearch = True
  End If
End Sub