Помощь - Поиск - Пользователи - Календарь
Полная версия: Реализация прокрутки результатов поиска
Форум «Всё о Паскале» > Pascal, Object Pascal > Практика продвинутого программирования на Pascal
IUnknown
А не внести ли нам разнообразие в раздел? smile.gif

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

Обычно подобная задача возникает при написании баз данных. Когда ищутся записи, удовлетворяющие какому-либо критерию, и таких записей находится больше 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:
Нажмите для просмотра прикрепленного файла

Посмотрим, что он умеет делать. Для примера - возьмем ту самую БД, которая разрабатывалась по первой ссылке. Там этот модуль может использоваться в каждой из процедур 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 передается номер поля, в котором будем искать строку. Можно было передать и саму искомую строку через этот же параметр (например, объединив номер поля и строку в структуру), но это уже будет задача для самостоятельного решения... smile.gif

Подменю, как видите, тоже создается элементарно, через передачу 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;

, тогда в качестве аргумента процедурного типа можно будет использовать как глобальную, так и локальную функцию...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.