А не внести ли нам разнообразие в раздел?
Недавно на форуме поднималась подобная тема (http://forum.pascalnet.ru/index.php?s=&showtopic=29018&view=findpost&p=158937), помню, было еще несколько тем с подобными вопросами (что-то про написание железнодорожной или авиа-справочной, найти что-то не получилось).
Обычно подобная задача возникает при написании баз данных. Когда ищутся записи, удовлетворяющие какому-либо критерию, и таких записей находится больше 25, на экран все одновременно они уже не помещаются. Поэтому было бы неплохо научиться делать вывод результатов таким образом, чтоб его можно было прокручивать в любую сторону, и выбирать любую запись из представленных на экране.
Проще всего для этой цели использовать реализацию меню. Я взял свой старый модуль, который использовался не в одном десятке программ, и чуть-чуть его подкорректировал. Почему понадобилось корректировать - попробую объяснить.
Дело в том, что изначально у меня заголовок функции Menu был вот таким:
function Menu(const s : array of string; Ystart, Yfinish : integer) : integer;
type
TDataFunc = Function (i : Integer; Var optional;
Var finished : Boolean) : String;
Function Menu (py, height : Integer;
searchfunc : TDataFunc;
Var optional) : Integer;
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;
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;
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;
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;
С учетом новых возможностей FPC 2.6.0 хочу дополнить еще буквально одним предложением. Теперь необязательно выносить сор из избы описание функции в глобальную область видимости, можно использовать вложенные функции:
Procedure WriteAll;. Все, что для этого понадобится - добавить в начало программы (и в начало модуля MenuUnit) директиву
// Вот она, вложенная функция
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;
type
TDataFunc = Function (i : Integer; Var optional;
Var finished : Boolean) : String IS NESTED;