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.
AI
Shrnutí AI: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Zdrojový kód
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
Původní komentáře (3)
Obnoveno z Wayback Machine