Дополнительная возможность поиска в формах
(статья + пример)
 

На Hiprog'е:  статья >> ;  пример>>

На MDBProgs: пример>>

 

Предпосылки


1. В просмотрах LotusNotes есть полезная штатная возможность быстрого поиска записи: пользователь набирает с клавиатуры последовательность символов, и после подтверждения ввода, система ищет первую соответствующую условию запись. Очень удобно, но есть ограничения: поиск ведется только в одном столбце (в первом отсортированном).
2. В различных приложениях БД есть варианты с использованием доп. текстбоксов (по мере ввода значений в поле система бегает по набору записей, выискивая совпадения по первым символам, и позиционирует форму).
Лично мне такой подход не нравится, поскольку особенного выигрыша в скорости/удобстве я не ощущаю, в то же время нагрузка на систему возрастает значительно. Поэтому в просмотрах своего приложения быстрый поиск я организовал так (А97):


Принцип работы.


Пользователь ставит курсор в поле (любое поле) и набирает с клавиатуры нужную последовательность символов. После подтверждения ввода система начинает поиск записей по совпадению первых символов в выделенном поле. Если поиск ОК, то курсор устанавливается на найденную запись. Особенно удобно при использованиии схемы интерфейса «Таблицы – для промотра, формы – для редактирования».


Ограничения


1. Корректно работает для СВЯЗАННЫХ элементов управления (controlSource - не выражение, а имя поля из recordsource)
2. Не работает, если в приложении запущена форма с таймером
3. При вводе первый символ в инпутбоксе получается выделенным, поэтому для поиска по нескольким символам начинать набор двойным нажатием первого символа.
 

Для работы необходимо в модуле класса формы прописать следующий код :

*****************************************

Option Compare Database
Option Explicit

Dim my_prpFrmSeek As New clsFrmSeek

Private Sub Form_Load()
    Set my_prpFrmSeek.my_prpFrm = Me
End Sub

*****************************************

 

И собственно класс clsFrmSeek:


*****************************************

Dim WithEvents frm As Form
Dim intAltDown As Integer 'флаг для отлова нажатий ALT

Private Sub frm_KeyDown(KeyCode As Integer, Shift As Integer)
intAltDown = (Shift And acAltMask) > 0
End Sub



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)

 
ГЛАВНАЯ СТРАНИЦА
 
E-mail: mdbprogs@yandex.ru
Hosted by uCoz