На Hiprog'е: статья >> ; пример>>
На MDBProgs: пример>>
Предпосылки
1. В просмотрах LotusNotes есть полезная штатная возможность быстрого поиска
записи: пользователь набирает с клавиатуры последовательность символов, и после
подтверждения ввода, система ищет первую соответствующую условию запись. Очень
удобно, но есть ограничения: поиск ведется только в одном столбце (в первом
отсортированном).
2. В различных приложениях БД есть варианты с использованием доп. текстбоксов
(по мере ввода значений в поле система бегает по набору записей, выискивая совпадения
по первым символам, и позиционирует форму).
Лично мне такой подход не нравится, поскольку особенного выигрыша в скорости/удобстве
я не ощущаю, в то же время нагрузка на систему возрастает значительно. Поэтому
в просмотрах своего приложения быстрый поиск я организовал так (А97):
Принцип работы.
Пользователь ставит курсор в поле (любое поле) и набирает с клавиатуры нужную
последовательность символов. После подтверждения ввода система начинает поиск
записей по совпадению первых символов в выделенном поле. Если поиск ОК, то курсор
устанавливается на найденную запись. Особенно удобно при использованиии схемы
интерфейса «Таблицы – для промотра, формы – для редактирования».
Ограничения
1. Корректно работает для СВЯЗАННЫХ элементов управления (controlSource - не
выражение, а имя поля из recordsource)
2. Не работает, если в приложении запущена форма с таймером
3. При вводе первый символ в инпутбоксе получается выделенным, поэтому для поиска
по нескольким символам начинать набор двойным нажатием первого символа.
Для работы необходимо в модуле класса формы прописать следующий код : ***************************************** Option Compare Database Private Sub Form_Load() ***************************************** |
И собственно класс clsFrmSeek: Dim WithEvents frm As
Form Private Sub frm_KeyPress(KeyAscii As Integer) On Error Resume Next Dim ctl As Control 'контрол, в котором проводим поиск Dim strFind As String 'строка поиска Dim varBookmark As Variant 'закладка на начальное положение Dim lngCurrentRecord(0 To 1) As Long 'для запомининия 'текущей записи до и после поиска Dim i As Integer 'принажатом ALT'e - выходим If intAltDown <> 0 Then intAltDown = 0 Exit Sub End If 'служебные символы не обрабатываем If KeyAscii <= 31 Then Exit Sub Set ctl = frm.ActiveControl 'работаем только с текстбоксами и комбобоксами If (ctl.ControlType <> acComboBox _ And ctl.ControlType <> acTextBox) Then Exit Sub 'выходим если : 'форма стоит на новой записи, 'ней разрешено редактирование, 'записей в форме нет If frm.NewRecord Then Exit Sub If frm.RecordsetClone.RecordCount = 0 Then Exit Sub If frm.RecordSource = "" Then Exit Sub If frm.RecordsetType <> 2 And frm.AllowEdits = True Then Exit Sub varBookmark = frm.Bookmark 'ставим закладку перед работой If Err Then Err.Clear Exit Sub End If 'выводим диалог для ввода строки поиска '(значение по умолчанию - первый символ, введенный пользователем) strFind = InputBox("Поиск по первым символам", , Chr(KeyAscii)) If strFind = "" Then Exit Sub 'нажали ESC For i = 0 To 1 'в цикле 1 или 2 прохода 'запоминаем значение текущей записи 'перед выполнением поиска lngCurrentRecord(0) = frm.CurrentRecord 'Здесь вызов поиска Call DoCmd.FindRecord( _ findwhat:=strFind, _ match:=acStart, _ onlycurrentfield:=acCurrent, _ searchasformatted:=True, _ FindFirst:=False) 'запоминаем значение текущей записи 'после выполнения поиска lngCurrentRecord(1) = frm.CurrentRecord If lngCurrentRecord(1) = lngCurrentRecord(0) Then 'после поиска номер записи не изменился '(поиск не дал рез-та) If lngCurrentRecord(0) = 1 Then 'если перед поиском стояли на первой записи 'и ничего не нашли - тогда возвращаемся 'на закладку и выходим frm.Bookmark = varBookmark Exit Sub Else 'перейдем на первую запись и проверим ctl.Text. 'Если сравнение успешно - значит нашли. выходим 'Иначе подйем на 2 заход Call DoCmd.GoToRecord(, , acFirst) If frm.CurrentRecord <> 1 Then Exit Sub If (ctl.Text Like strFind & "*") Then Exit Sub End If Else 'нашли. выходим Exit Sub End If Next i 'второй проход выполняем, если запись не найдена, 'а форма стояла не на первой записи End Sub Public Property Get my_prpFrm() As Form Set my_prpFrm = frm End Property Public Property Set my_prpFrm(ByVal vNewValue As Form) Set frm = vNewValue With frm .KeyPreview = True If .RecordsetType <> 2 Then .AllowEdits = False .OnKeyDown = "[Event Procedure]" .OnKeyPress = "[Event Procedure]" End With End Property ***************************************** |
Сергей Подосенов (SRG)