Энциклопедия Turbo Pascal. Главы 9-11 - Пример программы инвентаризации
ОГЛАВЛЕНИЕ
Пример программы инвентаризации
Для демонстрации того, как легко создать новые прикладные программы при наличии базового набора процедур, рассмотрим программу инвентаризации. Запись, используемая для хранения информации, выглядит следующим образом
type
inv = record
status: integer;
name: string[30];
descript := string[40];
guantity: integer;
cost: real;
end;
Длина ее, найденная с помощью SizeOf, равна 83. Используя данную длину и длину ключа, равную 30, программа SETCONST.PAS создает определение констант
Const
MaxDataRecSize = 82;
MaxKeyLen = 30;
PageSize = 24;
Order = 12;
PageStackSize = 10;
MaxHeight = 4;
Другие изменения, необходимые для преобразования процедур ведения почтового списка в процедуры инвентаризации, заключаются только в изменениях предложений печати. Целиком программа инвентаризации выглядит следующим образом:
program inventory;
Const
{ данные константы генерируются программой SETCONST.PA.
предоставляемой инструментарием баз данных }
MaxDataRecSize = 82;
MaxKeyLen = 30;
PageSize = 24;
Order = 12;
PageStackSize = 10;
MaxHeight = 4;
type
inv = record
status: integer;
name: string[30];
descript: string[40];
guantity: integer;
cost: real;
end;
{следующие файлы содержат процедуры баз данных}
{$i access.box} {основные процедуры баз данных}
{$i addkey.box} {добавить элементы }
{$i delkey.box} {удалить элементы }
{$i getkey.box} {поиск по дереву }
var
dbfile: DataFile;
ifile: IndexFile;
done: boolean;
function MenuSelect:char; {возврат пользовательского
выбора }
var
ch:char;
begin
WriteLn('1. Введите элемент ');
WriteLn('2. Удалить элемент ');
WriteLn('3. Отобразить инвентарный список');
WriteLn('4. Поиск элементов ');
WriteLn('5. Обновление ');
WriteLn('6. Выход ');
repeat
WriteLn;
Write('Введите ваш выбор: ');
Read(ch); ch:=UpCase(ch); WriteLn;
until (ch>='1') and (ch<='6');
MenuSelect:=ch;
end; {MenuSelect}
{добавить элемент к списку}
procedure Enter;
var
done: boolean;
recnum: integer;
temp: string[30];
info: inv;
begin
done:=FALSE;
repeat
Write('Введите имя элемента: ');
Read(info.name); WriteLn;
if Length(info.name)=0 then dont:=TRUE
else
begin
Write('Введите описание: ');
Read(info.descript); WriteLn;
Write('Введите количество: ');
Read(info.guantity); WriteLn;
Write('Введите стоимость: ');
Read(info.cost); WriteLn;
info.status:=0; { сделать активной }
FindKey(ifile, recnum, info.name);
if not OK then
begin
AddRec(dbfile, recnum, info);
AddKey(ifile, recnum, info.name};
end else WriteLn('дублированный ключ игнорирован');
end;
until done;
end; {Enter}
{изменение элемента в списке с сохранением поля имени}
procedure Update;
var
done: boolean;
recnum: integer;
temp: string[30];
info: inv;
begin
Write('Enter item name: ');
Read(info.name); WriteLn;
FindKey(ifile, recnum, info.name);
if OK then
begin
Write('Введите описание: ');
Read(info.descript); WriteLn;
Write('Введите количество: ');
Read(info.guantity); WriteLn;
Write('Введите стоимость: ');
Read(info.cost); WriteLn;
info.status:=0;
info.status:=0; {сделать активной}
PutRec(dbfile, recnum, info);
end else WriteLn('ключ не найден');
end; {Update}
{удалить элемент из инвентарного списка}
procedure Remove;
var
recnum: integer;
name: string[30];
begin
Write('Введите имя уничтожаемого элемента: ');
Read(name); WriteLn;
FindKey(ifile, recnum, name);
if OK then
begin
DeleteRec(dbfile, recnum);
DeleteKey(ifile, recnum, name);
end else WriteLn('Не найдено');
end; {Remove}
procedure Display(info: inv);
begin
WriteLn('Item name: ',info.name);
WriteLn('Description: ',info.descript);
WriteLn('Quantity on hand: ',info.quantity);
WriteLn('Initial cost: ',info.cost:10:2);
WriteLn;
end; {Display}
procedure ListAll;
var
info: inv;
len, recnum: integer;
begin
len := filelen(dbfile) -1;
for recnum:=1 to len do
begin
Getrec(dbfile, recnum, info);
if info.status = 0 then display(info);
end;
end; {ListAll}
{поиск элемента}
procedure Search;
var
name: string[30];
recnum: integer;
info: inv;
begin
Write('Введите имя элемента: ');
ReadLn(name);
{найти ключ, если он существует}
FindKey(ifile, recnum, name);
if OK then {если найден}
begin
GetRec(dbfile, recnum, info);
if info.status = 0 then Display(info);
end else WriteLn('не найден');
end; {Search}
begin
InitIndex;
OpenFile(dbfile, 'inv.lst', SizeOf(inv));
if not OK then
begin
WriteLn('Cоздание нового файла');
MakeFile(dbfile, 'inv.lst', SizeOf(inv));
end;
OpenIndex(ifile, 'inv.ndx', 30, 0);
if not OK then
begin
WriteLn('Cоздание нового файла');
MakeIndex(ifile, 'inv.ndx', 30, 0);
end;
done:=false;
repeat
case MenuSelect of
'1': Enter;
'2': Remove;
'3': ListAll;
'4': Search;
'5': Update;
'6': done:=true;
end;
until done;
CloseFile(dbfile);
CloseIndex(ifile);
end.
Программа ведения почтового списка и данная программа имеют один базовый скелет. Он может быть модифицирован для различных ситуаций использования баз данных.