Реализация прокрутки результатов поиска, (работа с БД) Опции

[IUnknown]

А не внести ли нам разнообразие в раздел?

Недавно на форуме поднималась подобная тема (Вот тут), помню, было еще несколько тем с подобными вопросами (что-то про написание железнодорожной или авиа-справочной, найти что-то не получилось).

Обычно подобная задача возникает при написании баз данных. Когда ищутся записи, удовлетворяющие какому-либо критерию, и таких записей находится больше 25, на экран все одновременно они уже не помещаются. Поэтому было бы неплохо научиться делать вывод результатов таким образом, чтоб его можно было прокручивать в любую сторону, и выбирать любую запись из представленных на экране.

Проще всего для этой цели использовать реализацию меню. Я взял свой старый модуль, который использовался не в одном десятке программ, и чуть-чуть его подкорректировал. Почему понадобилось корректировать - попробую объяснить.

Дело в том, что изначально у меня заголовок функции Menu был вот таким:

function Menu(const s : array of string; Ystart, Yfinish : integer) : integer;

, то есть в нее передавался массив строк, с которым функция работала внутри так, как ей было нужно: выводила на экран разные строки в нужных местах. Это не очень подходит для описываемого случая, потому что тогда перед вызовом меню надо будет запускать поиск, где-то сохранять его результаты, передавать их в Menu, а потом, после того, как Menu отработает - еще и удалять результаты поиска, чтобы не было утечек памяти, и чтобы память не расходовалась зря. Я решил пойти другим путем: передать в Menu не сам массив строк, а функцию, с помощью которой можно будет получить результаты поиска:

type
   TDataFunc = Function (i : Integer; Var optional;
                         Var finished : Boolean) : String;
Function Menu (py, height : Integer;
               searchfunc : TDataFunc;
               Var optional) : Integer;

А уже внутри модуля MenuUnit происходит именно то, что я описал выше: там создается временный массив, в котором хранятся строки, а после завершения работы меню этот массив автоматически удаляется.

Собственно, вот этот модуль MenuUnit:
 menuunit.pas ( 3.89 килобайт ) Кол-во скачиваний: 1171


Посмотрим, что он умеет делать. Для примера - возьмем ту самую БД, которая разрабатывалась по первой ссылке. Там этот модуль может использоваться в каждой из процедур WriteAll, Edit, DeleteRecord и Search. К примеру, WriteAll должна вывести абсолютно все записи, присутствующие в БД. Для этого можно написать такую функцию:

Var
   foo : integer = 0; { <--- "Пустышка". Передается, если параметр Optional не нужен }

Function IterateAll (i : Integer; Var optional;
                     Var finished : Boolean) : String;
Begin
   finished := i > n;
   If finished Then
      IterateAll := ''
   Else
      IterateAll := RecToStr (Massive[i]);
End;

{ ... Тогда WriteAll можно переписать так: }

Procedure WriteAll;
Begin
   ClrScr;
   MainTitle;
   Menu (menuTop, menuHeight, @IterateAll, foo);
End;

Теперь возьмем пример посложнее - Edit. Здесь кроме того, что выводятся все записи, так добавляется еще один пункт: "Отмена редактирования" (в случае, если пользователь не хочет больше редактировать никакую запись, он выбирает этот пункт). Этот вариант тоже реализуется очень просто с помощью вот такой функции:

Function IterateEdit (i : Integer; Var Optional;
                      Var finished : Boolean) : String;
Begin
   finished := i > Succ(n);
   If finished Then
      IterateEdit := ''
   Else
      If i <= n Then IterateEdit := Format('%4d.%s', [i, RecToStr(Massive[ i ])])
      Else IterateEdit := 'Завершить';
End;

{ Сама процедура Edit теперь выглядит вот так: }
Procedure Edit;
Var
   value : Integer;
Begin
   Repeat
      Clrscr;
      WriteLn ('Редактирование');
      MainTitleEdit;
      WriteLn;
      
      value := Menu (menuTop, menuHeight, @IterateEdit, foo);
      If value = n + 1 Then { Выбрано "Завершить"? Ничего не делаем }
      Else
      Begin
         ClrScr;
         WriteLn ('Изменяем:');
         MainTitle;
         WriteLn (RecToStr (Massive[value]));
         WriteLn;
         WriteLn ('Введите новые данные:');
         InputRec (Massive[value]);
         SaveAll;
         ReadAll;
         WriteLn;
         Write ('Запись успешно отредактирована.');
         Delay (1000);
      End;
   Until value = n + 1; { Пока пользователь не выберет "Завершить", цикл не закончится }
End;

Ну, и теперь кое-что посложнее: поиск по определенному полю в БД. Поскольку все поля у топикстартера имеют тип String, я немного подкорректировал описание структуры Database:

Type
   dbString = string;
   DataBase =
   Record
      Case Boolean Of
      False :
      (
         SecondName: dbstring;
         FirstName:  dbstring;
         FatherName: dbstring;
         Group:      dbstring;
         Faculty:    dbstring;
         Number:     dbstring;
      );
      True : ( sArray : Array[1 .. 6] of dbstring; )
   End;

, теперь к полю SecondNumber можно обратиться и напрямую (Massive[ i ].SecondNumber), и через Massive[ i ].sArray[1]; то же самое касается и всех остальных полей. Так вот, теперь о поиске. Для реализации поиска недостаточно просто перебрать все записи, нужно еще сравнивать определенное поле каждой записи с некоторым образцом. Для этого я и добавил в TDataFunc параметр Optional. И именно по этой причине он - бестиповый, то есть, туда, в зависимости от необходимости, можно передать либо целочисленное значение, либо какую-нибудь структуру, либо строку, все, что угодно, поэтому можно реализовывать запросы практически любой сложности. Я покажу самый простой: допустим, надо найти все записи, в определенном поле которых присутствует какое-либо значение. Делаем так:

var
   SearchStr : String;

Function IterateFields (i : Integer; Var Optional;
                        var finished : Boolean) : String;
Const count : Integer = 0;
Begin
   If i = 1 Then count := 0;
   Repeat
      Inc (count);
   Until (count > n) Or (Massive[count].sArray[Integer (Optional)] = SearchStr);

   finished := count > Succ(n);
   If finished Then
      IterateFields := ''
   Else
      If count <= n Then IterateFields := RecToStr(Massive[count])
      Else IterateFields := 'Завершено';
End;


Function CreateSubmenu (i : Integer; Var Optional;
                        Var finished : Boolean) : String;
Const
   Submenu : Array[1 .. 3] Of String =
   (
      '    Повторный поиск',
      '    Выход из программы',
      '    Переход в основное меню'
   );
Begin
   finished := i > 3;
   If finished Then
      CreateSubmenu := ''
   Else
      CreateSubmenu := Submenu[i]
End;

{ Сама процедура Search }
Procedure Search (Field : Integer; Title : string);
Var
   value : Integer;
Begin
   Repeat
      Clrscr;
      SearchTitle;
      Write ('Введите ' + Title + ': ');
      ReadLn (SearchStr);
      WriteLn;
      MainTitle;
      
      Menu (menuTop, menuHeight, @IterateFields, Field);

      value := Menu (menuTop, menuHeight, @CreateSubmenu, foo);
      Case value Of
         1 : ;     (* Повторный поиск *)
         2 : Halt; (* Выход из программы *)
      End;
   Until value = 3;
End;

Функция IterateFields может потребовать дополнительных комментариев: здесь используется локальная типизированная константа, которая сохраняет значение между вызовами функций, поэтому при втором вызове функция продолжит просмотр там, где она остановилась в прошлый раз. Именно по этой причине понадобилось обнулять Count при i = 1 (если этого не сделать то первый запрос отработает нормально, а вот при втором уже будет вылет за границы массива)

Через Optional передается номер поля, в котором будем искать строку. Можно было передать и саму искомую строку через этот же параметр (например, объединив номер поля и строку в структуру), но это уже будет задача для самостоятельного решения...

Подменю, как видите, тоже создается элементарно, через передачу CreateSubmenu в функцию Menu.

Надеюсь, этот модуль, и приведенные примеры его использования, будут для кого-то полезны. Замечания/предложения по усовершенствованию/информация о багах - приветствуются.

[IUnknown]

С учетом новых возможностей FPC 2.6.0 хочу дополнить еще буквально одним предложением. Теперь необязательно выносить сор из избы описание функции в глобальную область видимости, можно использовать вложенные функции:

Procedure WriteAll;

   // Вот она, вложенная функция
   Function MyIterateAll (i : Integer; Var optional;
                        Var finished : Boolean) : String;
   Begin
      finished := i > Succ (n);
      If finished Then
         MyIterateAll := ''
      Else
         If i <= n Then MyIterateAll := RecToStr (Massive[i])
         Else MyIterateAll := 'finish';
   End;

Begin
   ClrScr;
   MainTitle;
   Menu (menuTop, menuHeight, @MyIterateAll, foo);
End;

. Все, что для этого понадобится - добавить в начало программы (и в начало модуля MenuUnit) директиву
{$modeswitch NestedProcVars}
, а также подправить описание типа TDataFunc:

type
   TDataFunc = Function (i : Integer; Var optional;
                         Var finished : Boolean) : String IS NESTED;

, тогда в качестве аргумента процедурного типа можно будет использовать как глобальную, так и локальную функцию...

Сообщение отредактировано: IUnknown - 15.01.2012 23:36