• Home
 · 
• Windows API Call/Explanation
 · 
• Combobox Autofill / Quicken style combobox

Combobox Autofill / Quicken style combobox

This class module automatically fills the text of a combo box, using an API call to look up the text from its list.

Inputs
Dim goAutoFill as New clsComboFill ' In the Change event of the combo box: Call go_AutoFill.GetListValue(cboBoxName) ' In the KeyUp event of the combo box: Call go_AutoFill.SupressKeyStroke(cboBox, KeyCode)

Assumes
Copy this code into a class module called 'clsComboFill.'

Returns
Only returns the contents of the combobox's list, or ignores the rest.

API Declarations
' In the class module:
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const CB_FINDSTRINGEXACT = &H158
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)


Rate Combobox Autofill / Quicken style combobox

• 1
• 2
• 3
• 4
• 5

(7(7 Vote))

Option Explicit
' Created by [email protected] - 9/12/2000
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any) As Long
Private Const CB_FINDSTRINGEXACT = &H158
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)
' Used to hold the keycode supressions
Private m_bSupressKeyCode As Boolean
Private Property Let SupressKeyCode(bValue As Boolean)
  m_bSupressKeyCode = bValue
End Property
Private Property Get SupressKeyCode() As Boolean
  SupressKeyCode = m_bSupressKeyCode
End Property
Public Sub SupressKeyStroke(cboBoxName As ComboBox, KeyCode As Integer)
' This method is called from the KeyDown
' event of a ComboBox.
  ' Let's just assume we only want to supress
  ' backspace and the delete keys.
  If cboBoxName.Text <> "" Then
    Select Case KeyCode
      Case vbKeyDelete
        SupressKeyCode = True
      Case vbKeyBack
        SupressKeyCode = True
    End Select
  End If
End Sub
Public Sub GetListValue(cboBoxName As ComboBox)
' Call this method in the 'Change' event a
' ComboBox.
  Dim lSendMsgContainer As Long, lUnmatchedChars As Long
  Dim sPartialText As String, sTotalText As String
  ' Prevent processing as a result of changes from code
  If m_bSupressKeyCode Then
    m_bSupressKeyCode = False
    Exit Sub
  End If
  With cboBoxName
    ' Lookup list item matching text so far
    sPartialText = .Text
    lSendMsgContainer = SendMessage(.hWnd, CB_FINDSTRING, -1, ByVal sPartialText)
    ' If match found, append unmatched characters
    If lSendMsgContainer <> CB_ERR Then
      ' Get full text of matching list item
      sTotalText = .List(lSendMsgContainer)
      ' Compute number of unmatched characters
      lUnmatchedChars = Len(sTotalText) - Len(sPartialText)
      If lUnmatchedChars <> 0 Then
        ' Append unmatched characters to string
        SupressKeyCode = True
        .SelText = Right(sTotalText, lUnmatchedChars)
        ' Select unmatched characters
        .SelStart = Len(sPartialText)
        .SelLength = lUnmatchedChars
      End If
    End If
  End With
End Sub
Private Sub Class_Terminate()
' If there's any kind of err, let's just flush it
' and go about our business. Whoomp, there it 
' is!
  Err.Clear
End Sub