Недавно на форуме поднималась подобная тема (Вот тут), помню, было еще несколько тем с подобными вопросами (что-то про написание железнодорожной или авиа-справочной, найти что-то не получилось).
Обычно подобная задача возникает при написании баз данных. Когда ищутся записи, удовлетворяющие какому-либо критерию, и таких записей находится больше 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 передается номер поля, в котором будем искать строку. Можно было передать и саму искомую строку через этот же параметр (например, объединив номер поля и строку в структуру), но это уже будет задача для самостоятельного решения...
Подменю, как видите, тоже создается элементарно, через передачу CreateSubmenu в функцию Menu.
Надеюсь, этот модуль, и приведенные примеры его использования, будут для кого-то полезны. Замечания/предложения по усовершенствованию/информация о багах - приветствуются.