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