listsrch.bas

在Text中实现快速增量查询 用VB编 的,希望大家喜欢

Attribute VB_Name = "LISTSRCH1"
  '=======================================================================
  ' This module provides event handling and general routines for the
  ' LISTSRCH.FRM dialog.
  '
  ' Author:   Barth Riley
  '==========================================================================
  Option Explicit

  '--Key Code Constants
  Const KEY_BACK = &H8
  Const KEY_DELETE = &H2E
  Const KEY_CLEAR = &HC

  '---Focus constants
  Const TEXTBOX_FOCUS = 1       ' currently in text box
  Const LISTBOX_FOCUS = 2       ' currently in list box

  '---module level variables
  Dim miCtrlFocus As Integer      ' which control (textbox/listbox) has focus
  Dim miNumKeys As Integer        ' number of keys pressed by user
  Dim mfScrolling As Integer      ' True if textbox triggers listbox scroll.
  Dim mfKeepKey As Integer        ' False if user hit delete/backspace

Sub CursorArrow()
  Screen.MousePointer = 1
End Sub

Sub CursorWait()
  Screen.MousePointer = 11
End Sub

Sub LISTSRCH_Activate()
  MsgBox "Try typing:  " & Chr(34) & "Windows 3.11 for Workgroups" & Chr(34), 64
  frmListSearch.txtSearch.SetFocus
End Sub

Sub LISTSRCH_cmdClose_Click()
  Unload frmListSearch
  End
End Sub

Sub LISTSRCH_Load()
  '---Start of Code
  CursorWait
  frmListSearch.lstSearch.AddItem "Windows"
  frmListSearch.lstSearch.AddItem "Windows 3.1"
  frmListSearch.lstSearch.AddItem "Windows 3.0"
  frmListSearch.lstSearch.AddItem "Windows 3.1 API"
  frmListSearch.lstSearch.AddItem "Winows Program Manager"
  frmListSearch.lstSearch.AddItem "Windows File Manager"
  frmListSearch.lstSearch.AddItem "Windows File Manager API"
  frmListSearch.lstSearch.AddItem "VB"
  frmListSearch.lstSearch.AddItem "VB Programmers Journal"
  frmListSearch.lstSearch.AddItem "VB 1.0"
  frmListSearch.lstSearch.AddItem "VB 2.0"
  frmListSearch.lstSearch.AddItem "VB 3.0"
  frmListSearch.lstSearch.AddItem "VB 3.0 Professional"
  frmListSearch.lstSearch.AddItem "VBX's"
  frmListSearch.lstSearch.AddItem "VB for Applications"
  frmListSearch.lstSearch.AddItem "VB for DOS"
  frmListSearch.lstSearch.AddItem "VBAssist"
  frmListSearch.lstSearch.AddItem "VBA"
  frmListSearch.lstSearch.AddItem "Windows 3.11 for Workgroups"
  frmListSearch.lstSearch.AddItem "Windows 3.11"

  miNumKeys = 0
    
  CursorArrow
  '---End of Code
End Sub

Sub LISTSRCH_lstSearch_Click(lstSearch As ListBox, txtSearch As TextBox)
  '==========================================================
  ' This routine updates the contents of the txtSearch
  ' text box w. the current list item only if the list box
  ' has the focus and the current list index > 0.
  '============================================================
  '---Variable declarations
  Dim szListText As String
  Dim iListIndex As Integer
  '---Start of Code
  On Error Resume Next

  If lstSearch.ListIndex >= 0 And miCtrlFocus = LISTBOX_FOCUS Then
    ' user has clicked on the liat box
    iListIndex = lstSearch.ListIndex
    szListText = lstSearch.List(iListIndex)
    txtSearch.Text = szListText
  End If
End Sub

Sub LISTSRCH_lstSearch_KeyDown()
  '=================================================
  ' KeyDown event handler for the list box. Set
  ' variables to indicate that the user has "cliked"
  ' on the list box
  '====================================================
  miCtrlFocus = LISTBOX_FOCUS
  miNumKeys = 0
End Sub

Sub LISTSRCH_lstSearch_MouseDown()
  '=================================================
  ' MouseDown event handler for the list box. Sets
  ' variables to indciate that the user has clicked
  ' on the list box and now has the focus.  This is
  ' necessary since setting the Selected property of the
  ' list, as well as clicking on the list box, generates
  ' a Click event.
  '====================================================
  miCtrlFocus = LISTBOX_FOCUS
  miNumKeys = 0
End Sub

Sub LISTSRCH_txtSearch_Change(lstSearch As ListBox, txtSearch As TextBox)
  '=====================================================
  ' If a new character has been typed into the text box,
  ' this procedure searches the list box for an item
  ' matching the contents of txtSearch.  If found, the
  ' item in the list is selected and the portion of the
  ' text NOT typed by the user is highlighted in the
  ' text box.  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
  
  '---Start of Code
  On Error Resume Next

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

Sub LISTSRCH_txtSearch_GotFocus()
  miNumKeys = 0
  frmListSearch.txtSearch.SelStart = 0
  frmListSearch.txtSearch.SelLength = Len(frmListSearch.txtSearch.Text)
End Sub

Sub LISTSRCH_txtSearch_KeyDown(ByVal KeyCode As Integer)
  '=====================================================
  ' Determines if a valid (printable) character has been
  ' pressed.  If the character is printable, the
  ' the txtSearch_Change event handler will search
  ' the list box for a matching item.
  '=======================================================
  If KeyCode = KEY_BACK Or KeyCode = KEY_DELETE Or KeyCode = KEY_CLEAR Then
    mfKeepKey = False
    If KeyCode = KEY_BACK Then
      ' unhilight current item; next search
      ' will start at top of list
      frmListSearch.lstSearch.ListIndex = -1
    End If
  Else
    mfKeepKey = True
  End If
End Sub

Sub LISTSRCH_txtSearch_KeyPress(KeyAscii As Integer)
  '===============================================================
  ' Keeps track of number of keys pressed
  '===============================================================
  miCtrlFocus = TEXTBOX_FOCUS
  If mfKeepKey Then
    miNumKeys = Len(frmListSearch.txtSearch.Text) + 1
  End If
End Sub

Function SearchListBox(ByVal szSearchText As String, lbScroll As ListBox, iListIndex As Integer) As Integer
  '=======================================================
  ' Simple function to create a scrolling list box.
  ' The procedure will select the first item in the list
  ' box 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) = FOUND)
        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