VB Coding Tip: Type Ahead Combo Box

Would you like to force users to select an itme from your combo box list and also allow them to just type the first few cahracters of a list item to bring the desired item into focus? Here is the API and code to do it.

Private Sub MyCombo_KeyPress( _
            KeyAscii As Integer)
 KeyAscii = AutoFind( MyCombo, _
                      KeyAscii, _
                      False)
End Sub

Put this in the Declarations Section:

Public Const CB_FINDSTRING = &H14C
Public Const CB_ERR = (-1)

Declare Function SendMessage _
        Lib "user32" Alias _ 
             "SendMessageA" _ 
             (ByVal hWnd As Long, _ 
              ByVal wMsg As Long, _
              ByVal wParam As Long, _ 
              lParam As Any) As Long

Public Function AutoFind( _
  ByRef cboCurrent As ComboBox, _ 
  ByVal KeyAscii As Integer, _ 
  Optional ByVal LimitToList As Boolean = False)
        
Dim lCB As Long
Dim sFindString As String

On Error GoTo Err_Handler
 If KeyAscii = 8 Then
  If cboCurrent.SelStart <= 1 Then
    cboCurrent = ""
    AutoFind = 0
    Exit Function
  End If
  If cboCurrent.SelLength = 0 Then
    sFindString = UCase(Left(cboCurrent, _
                             Len(cboCurrent) - 1))
  Else
    sFindString = Left$(cboCurrent.Text, _
                        cboCurrent.SelStart - 1)
  End If
 ElseIf KeyAscii < 32 Or KeyAscii > 127 Then
  Exit Function
 Else
  If cboCurrent.SelLength = 0 Then
    sFindString = UCase(cboCurrent.Text & _
                         Chr$(KeyAscii))
  Else
    sFindString = Left$(cboCurrent.Text, _
                        cboCurrent.SelStart) & _
                               Chr$(KeyAscii)
  End If
 End If
 lCB = SendMessage(cboCurrent.hWnd, _
                   CB_FINDSTRING, _
                   -1, _
                   ByVal sFindString)

 If lCB <> CB_ERR Then
  cboCurrent.ListIndex = lCB
  cboCurrent.SelStart = Len(sFindString)
  cboCurrent.SelLength = Len(cboCurrent.Text) - _
                         cboCurrent.SelStart
  AutoFind = 0
 Else
  If LimitToList = True Then
    AutoFind = 0
  Else
    AutoFind = KeyAscii
  End If
 End If
        
End Function

0 Comments (click to add your comment)

Comment and Contribute

 

Your name/nickname

Your email

Subject

(Maximum characters: 1200). You have characters left.