- Код: Выделить всё
Dim sLstSearch As String 'строка поиска
Dim CurrentLetter As String 'загруженная в список буква
Dim sWaitForLetter As String 'выбранная, но еще незагруженная буква
'загрузка формы
Private Sub Form_Load()
While Not rsProducts.EOF
lstSearch.AddItem rsProducts.Fields("ProductID")
rsProducts.MoveNext
Wend
rsProducts.Close
Me.Caption = lstSearch.ListCount & " records loaded"
End Sub
'функция поиска слова в списке
Function SearchListBox(lstX As Control, KeyAscii As Integer)
Dim nSearchPos As Integer
Dim nSearchLen As Integer
Dim nResult As Integer
CurrentLetter = ""
If CurrentLetter = "" Then
CurrentLetter = "Я"
Else
CurrentLetter = Chr(Asc(CurrentLetter) + 1)
End If
nSearchPos = lstX.ListIndex
nSearchLen = Len(sLstSearch)
sWaitForLetter = ""
'проверям не нажата ли клавиша <BACKSPACE>
If KeyAscii = vbKeyBack Then
nSearchPos = 0
If nSearchLen > 0 Then sLstSearch = Left$(sLstSearch, _
nSearchLen - 1)
End If
'преобразуем введеный символ в верхний регистр
KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
'если нажата буква 'Х', а данные введены только до 'С', ждем...
If nSearchLen = 0 And KeyAscii > Asc(CurrentLetter) Then
lstX.ListIndex = lstX.ListCount - 1
sWaitForLetter = Chr$(KeyAscii)
Exit Function
End If
'добавляем в строку поиска новый символ
If KeyAscii >= 32 And KeyAscii <= 223 Then
sLstSearch = sLstSearch & Chr$(KeyAscii)
End If
'отображаем строку поиска
lblSrchtext = sLstSearch
'пересчитываем длину
nSearchLen = Len(sLstSearch)
'простой поиск - сравниваем каждый элемент со строкой поиска
While nSearchPos < lstX.ListCount
nResult = StrComp(sLstSearch, UCase$(Left$(lstX.List(nSearchPos), nSearchLen)))
If nResult <= 0 Then
lstX.ListIndex = nSearchPos
SearchListBox = 0
Exit Function
End If
nSearchPos = nSearchPos + 1
Wend
End Function
'нажатие клавиши в списке
Private Sub lstSearch_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Exit Sub
End If
KeyAscii = SearchListBox(Me.ActiveControl, KeyAscii)
End Sub