Поиск записи с помощью TQuery

Delphi , Базы данных , Поиск

Как мне найти запись (осуществить 'Find') в TQuery?

Я привел ниже код, который я использую в своей работе, правда, в нем еще необходимо организовать обработку исключительных ситуаций, но это дело времени. Когда пользователь нажимает кнопку "Найти", обработчик события OnClick вызывает процедуру SearchName.

Объявляем: FindSearch : Boolean и инициализируем значением True.

function LookForString(target, source: string): boolean;
{ в случае игнорирования перед вызовом pos необходимо
преобразовать source и target в верхний регистр }
begin
  LookForString := pos(target, source);
end;

procedure SearchName(searchtype: string; stringtofind: string);
var
  OldCursor: TCursor;
  CurrentPos: TBookmark;
  found: boolean;
begin
  if Form1.Query1.State = dsEdit then
    Form1.Query1.Post;
  if StringToFind = '' then
    exit;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  with Form1 do
  begin
    CurrentPos := Query1.GetBookmark;
    Query1.DisableControls;
    found := false;
    if searchtype <> 'prev' then { первый или следующий }
    begin
      if searchtype = 'first' then
        Query1.First
      else if not Query1.EOF then
        Query1.Next;
      while (not Query1.EOF) and (not found) do
      begin
        if LookForString(StringToFind, MemberName) <> 0 then
          found := true;
        if not found then
          Query1.Next;
      end;
    end
    else
    begin { prev }
      if not Query1.BOF then
        Query1.Prior;
      while (not Query1.BOF) and (not found) do
      begin
        if LookForString(StringToFind, MemberName) <> 0 then
          found := true;
        if not found then
          Query1.Prior;
      end;
    end;
    Screen.Cursor := OldCursor;
    if found then
    begin
      FindSearch := false;
      ChangeFindCaption;
      UpdateStatusLabel;
    end
    else
    begin
      MessageDlg('Больше ничего не найдено.', mtInformation,
        [mbOK], 0);
      Query1.GotoBookmark(CurrentPos);
    end;
    Query1.EnableControls;
    Query1.FreeBookmark(CurrentPos);
  end; { конец работы с Form1 }
end;

procedure TForm1.FindButtonClick(Sender: TObject);
begin
  if FindSearch then
    SearchName('first', Page0Edit.Text)
  else
    SearchName('next', Page0Edit.Text);
end;

Перевод текста на русский язык:

Код, предоставленный ниже, написан на Delphi и использует компонент TQuery для взаимодействия с базой данных. Цель - найти конкретный рекорд в базе данных по строке поиска, введенной пользователем.

Следующий процесс происходит при клике кнопки "Найти":

1. При клике кнопки "Найти" вызывается процедура SearchName.
2. В SearchName код сначала проверяет, находится ли запрос в режиме редактирования и отправляет любые pending обновления.
3. Если строка поиска пустая, процедура выходит без выполнения дальнейших действий.
4. Код отключает контролы запроса, чтобы предотвратить взаимодействие пользователя с базой данных во время поиска.
5. Он устанавливает маркер для текущей позиции в запросе с помощью Query1.GetBookmark.
6. В зависимости от того, является ли это первым или следующим поиском, код либо перемещается к первому рекорду (Query1.First), либо к следующему (Query1.Next).
7. Пока не достигнут конца результата и не найден, код проверяет, содержит ли текущий рекорд строку поиска, вызывая LookForString. Если он содержит, то устанавливает флаг found в True.
8. Если флаг все еще False после проверки всех рекордов, код перемещается к следующему (Query1.Next).
9. После выполнения поиска код восстанавливает контролы запроса и маркер, а также обновляет GUI.

Функция LookForString просто ищет целевую строку в исходной строке с помощью встроенной функции Delphi Pos, которая возвращает позицию первого вхождения целевой строки в исходную строку. Если целевая строка не найдена, она возвращает 0.

Для улучшения этого кода можно добавить более robust ошибку обработки для случаев, когда запрос fails или строка поиска является недопустимой. Может быть также полезно добавить визуальное обратное отображение при выполнении поиска, например, курсор busy или прогресс-бар.

Вот альтернативное решение с использованием TADOTable вместо TQuery:

procedure TForm1.SearchName(searchtype: string; stringtofind: string);
var
  OldCursor: TCursor;
  found: boolean;
begin
  if Form1.ADOQuery1.State = dsEdit then
    Form1.ADOQuery1.Post;

  if StringToFind = '' then
    exit;

  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;

  try
    Form1.ADOQuery1.DisableControls;
    found := false;
    if searchtype <> 'prev' then
    begin
      Form1.ADOQuery1.First;
      while not Form1.ADOQuery1.Eof and not found do
      begin
        if LookForString(StringToFind, ADOQuery1.FieldByName('MemberName').AsString) > 0 then
          found := true;
        if not found then
          Form1.ADOQuery1.Next;
      end;
    else
    begin
      Form1.ADOQuery1.Last;
      while not Form1.ADOQuery1.BeforeFirst and not found do
      begin
        if LookForString(StringToFind, ADOQuery1.FieldByName('MemberName').AsString) > 0 then
          found := true;
        if not found then
          Form1.ADOQuery1.Prior;
      end;
    end;

    Screen.Cursor := OldCursor;
    if found then
    begin
      FindSearch := false;
      ChangeFindCaption;
      UpdateStatusLabel;
    else
    begin
      MessageDlg('Больше ничего не найдено.', mtInformation, [mbOK], 0);
      Form1.ADOQuery1.GotoBeginning;
    end;

    Form1.ADOQuery1.EnableControls;
  finally
    Screen.Cursor := OldCursor;
  end;
end;

procedure TForm1.FindButtonClick(Sender: TObject);
begin
  if FindSearch then
    SearchName('first', Page0Edit.Text)
  else
    SearchName('next', Page0Edit.Text);
end;

В этом коде используется TADOTable вместо TQuery, а также включен блок try-finally для обеспечения восстановления курсора даже в случае возникновения исключения при выполнении поиска.

В статье описывается способ поиска записи в TQuery с помощью процедуры SearchName, которая выполняет поиск в направлении "первого" или "следующего" элемента, соответствующего введенному строковому параметру.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Поиск ::