Scrolling a combo box as you type
If you use a combo box somewhere in your application, you might have noticed that typing the text is sometimes OK, but other times you'd wish the list would scroll according to the text you type. This code enables your list to do just that.
Author:


Option Explicit

'For Win16
Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal Msg As Integer, ByVal Wp As Integer, Lp As Any) As Long
' For Win32
'Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

Const Key_Enter = &HD
Const Key_Back = &H8
Const Key_Delete = &H2E
Const Key_Clear = &HC
Const WM_USER = &H400
Const Key_Down = &H28

Dim miNumKeys As Integer
Dim mfScrolling As Integer
Dim mfKeepKey As Integer
Dim DownKeyNum As Integer

Sub Search_ComboBox_GotFocus(InForm As Form, InItem As ComboBox)
   miNumKeys = 0
   InItem.SelStart = 0
   InItem.SelLength = Len(InItem.Text)
End Sub

Sub Search_ComboBox_Change(InItem As ComboBox)
  '=====================================================
  ' If a new character has been typed into the ComboBox,
  ' this procedure searches the ComboBox.list for an item
  ' matching the contents of InItem.  If found, the
  ' item in the list is selected and the portion of the
  ' text NOT typed by the user is highlighted in the
  ' ComboBox.  Note that mfScrolling is used to prevent
  ' re-entry into this event handler.
  '=====================================================
  '---Variable declaration
  Dim szSrchText As String    ' contents of text box
  Dim iTxtLen As Integer      ' length of search string
  Dim iListIndex As Integer   ' set by SearchListBox
  Dim fReturn As Integer      ' ret. from SearchListBox
  Dim lstSearch As ComboBox
  
  '---Start of Code
  On Error Resume Next

 
 If mfKeepKey And Not mfScrolling Then
   iTxtLen = Len(InItem.Text)
          
   If iTxtLen And InItem.ListCount > 0 Then
      miNumKeys = IIf(miNumKeys < iTxtLen, miNumKeys, iTxtLen)
      szSrchText = InItem.Text
      fReturn = SearchListBox(szSrchText, InItem, iListIndex)
      mfScrolling = True
      If iListIndex = -1 Then
         InItem.ListIndex = -1
      Else ' perfect match was found
         InItem = InItem.List(InItem.ListIndex)
         InItem.ListIndex = iListIndex
         InItem.SelStart = miNumKeys
         InItem.SelLength = (Len(InItem.Text) - miNumKeys)
      End If
      mfScrolling = False
   End If
End If
End Sub

Sub Search_ComboBox_KeyDown(ByVal KeyCode As Integer, InForm As Form, InItem As ComboBox)

Const CB_SHOWDROPDOWN = WM_USER + 15
Dim Tmp
Dim iIndexNum
   
   iIndexNum = InItem.ListIndex
   If KeyCode = Key_Enter Then DownKeyNum = False
   If KeyCode = Key_Down And DownKeyNum = True Then
      Tmp = SendMessage(InItem.hWnd, CB_SHOWDROPDOWN, 1, ByVal 0&)
      InItem.ListIndex = iIndexNum
   End If
   If KeyCode = Key_Down And DownKeyNum = False Then
      Tmp = SendMessage(InItem.hWnd, CB_SHOWDROPDOWN, 1, ByVal 0&)
      InItem.ListIndex = -1
      DownKeyNum = True
   End If
   If KeyCode = Key_Back Or KeyCode = Key_Delete Or KeyCode = Key_Clear Then
      mfKeepKey = False
      If KeyCode = Key_Back Then
         InItem.ListIndex = -1
      End If
   Else
      mfKeepKey = True
   End If
End Sub

Sub Search_ComboBox_KeyPress(KeyAscii As Integer, InForm As Form, InItem As ComboBox)

   If mfKeepKey Then
      miNumKeys = Len(InItem.Text) + 1
   End If
   
End Sub

Function SearchListBox(ByVal szSearchText As String, lbscroll As ComboBox, iListIndex As Integer) As Integer

'=======================================================
' The procedure will select the first item in the ComboBox
' in which Left(List box text,size of search string)
' matches the search string.
'==========================================================

'---Constants (returned from StrComp)
Const FOUND = 0
Const LT = -1
Const GT = 1

'---Variable declarations
Dim iListStart As Integer  ' starting point in list
Dim iListCount As Integer  ' no. of items in list box
Dim iTxtLen As Integer
Dim szListText As String   ' current list item
Dim vCompResult            ' result of string comp function
Dim fFound As Integer      ' match found?
Dim fDone As Integer       ' Terminates search if true

'---Start of Code
   
   fFound = False
   iTxtLen = Len(szSearchText)
   If iTxtLen > 0 And lbscroll.ListCount > 0 Then
      iListStart = lbscroll.ListIndex
      If iListStart = -1 Then
         iListStart = 0
         iListIndex = iListStart
         iListCount = lbscroll.ListCount
          
          szListText = Left(lbscroll.List(iListStart), iTxtLen)
           
         ' check to see if current item matches
         fFound = CInt(StrComp(szSearchText, szListText, 1))
          
         If fFound <> FOUND Then
            fDone = False
      
            If (fFound = LT) Then
            iListIndex = 0
            fFound = False
         Else
           iListIndex = iListIndex + 1
         End If
   
         Do While (iListIndex <= iListCount) And Not fDone
            szListText = Left(lbscroll.List(iListIndex), iTxtLen)
            vCompResult = StrComp(szSearchText, szListText, 1)
            If IsNull(vCompResult) Then iListIndex = -1
               Exit Do
            End If
            fFound = CInt(vCompResult)
            fDone = fFound Or (CInt(vCompResult) = -1)
            If Not fDone Then
               iListIndex = iListIndex + 1
            End If
         Loop
         If Not fFound Then
            iListIndex = -1
         End If
      End If
   End If
   
   SearchListBox = fFound
   
End Function ' ScrollListBox