Текст программы (с комментариями)
program BD_Book;
uses Crt, Graph; {подключаем модули для работы с текстом и графикой}
type
Book = record {структура для представления записи БД}
Name: string; {название книги}
Author: string; {автор книги}
Page: integer; {количество страниц в книге}
Price: real; {стоимость книги}
end;
List = ^Rec; {структура "Список" для хранения записей}
Rec = record
Data: Book; {информация}
Next: List; {ссылка на следующий элемент}
end;
var menu: integer; {выбранный пункт меню}
YesBD: boolean; {имеется ли БД для работы}
BD: List; {список - база данных}
procedure DelBD; {уничтожение базы данных}
begin
Dispose(BD); {уничтожаем ссылку на начало списка}
YesBD:=false; {БД для работы нет}
GotoXY(4,7); TextColor(10);
Write('БД удалена!');
end;
procedure NewBD; {создание новой базы данных}
begin
if YesBD then DelBD; {если есть база, то ее надо уничтожить}
BD:=nil; {БД пустая}
end;
procedure NewEl(t: Book); {добавление нового элемента в список}
var x: List;
S: List;
begin
if BD=nil then {если добавляется первый элемент в список}
begin
new(x); {выделить память под элемент}
x^.Data:=t; {скопировать содержимое}
x^.Next:=nil; {следующего элемента пока нет}
BD:=x; {перенос указателя на БД}
end
else {добавление не первого элемента в список}
begin {добавление элемента в конец списка}
S:=BD; {вспомогательная ссылка}
while S^.Next<>nil do {перемещение в конец списка}
S:=S^.Next;
new(x); {создание нового элемента}
x^.Data:=t;
x^.Next:=nil;
S^.Next:=x; {добавление его в конец списка}
end;
end;
procedure GraphInit; {инициализация графики}
var
ErrorCode: Integer;
GrDriver, GrMode: Integer;
begin
GrDriver := Detect;
InitGraph(GrDriver, GrMode, '');
ErrorCode := GraphResult; {ошибка при инициализации графики}
if ErrorCode <> grOk then {в случае возникновения ошибки}
begin
Writeln('Ошибка графики:');
Writeln(GraphErrorMsg(ErrorCode));
Writeln('Невозможно показать красивую заставку :-(');
ReadKey;
end;
end;
procedure Zastavka; {заставка в графическом режиме}
var i: integer;
begin
GraphInit; {инициализация графики}
SetBkColor(1); {синий цвет экрана}
ClearDevice; {очистить экран}
for i:=0 to 15 do {рамка из прямоугольников}
begin
SetColor(i);
Rectangle(0+i*2, 0+i*2, GetMaxX-i*2, GetMaxY-i*2);
end;
SetColor(4); {Вывод информации}
SetTextStyle(DefaultFont, HorizDir, 3);
OutTextXY(200, 130, 'БД КНИГИ');
SetColor(14);
OutTextXY(110, 230, 'Выполнил ПУПКИН');
SetColor(13);
SetTextStyle(DefaultFont, HorizDir, 2);
OutTextXY(80, 330, 'студент группы №07');
SetColor(2);
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(250, GetMaxY-50, 'Нажмите любую клавишу');
ReadKey;
CloseGraph; {закрыть графический режим}
end;
procedure LoadBD; {Чтение БД из файла}
var FileName: string; {имя файла}
F: file of Book; {файл из структур}
tmp: Book;
begin
ClrScr;
NewBD; {создать новый список для хранения БД}
TextColor(14); GotoXY(4,2);
Write('Задайте имя файла: '); ReadLn(FileName);
Assign(F, FileName); {связать с файлом на диске}
{$I-} {отключить проверку ошибок}
Reset(F); {попытка открыть файл}
{$I+} {включить проверку ошибок}
if IOResult <> 0 then {если была ошибка при открытии файла}
begin
TextColor(12);
WriteLn('Указанный Вами файл не найден!!!');
WriteLn('Создан новый файл и создана пустая БД');
Rewrite(F); {перезаписать файл}
end
else {если файл был найден}
begin
while not eof(F) do {пока не конец файла}
begin
Read(F, tmp); {читать из файла запись}
NewEl(tmp); {добавить ее в список}
end;
TextColor(10);
GotoXY(4,7);
WriteLn('БД успешно прочитана');
end;
YesBD:=true; {БД имеется}
Close(F); {закрыть файл}
end;
procedure ViewBD; {просмотр БД}
var S: List;
i: integer;
begin
TextBackground(7);
ClrScr;
Window(4,3,78,21);
TextBackGround(0);
ClrScr;
Window(3,2,77,20);
TextBackground(1);
ClrScr; {вывод шапки таблицы}
WriteLn(' +----+---+-+------++');
WriteLn(' |№п\п| Название | Автор | Стр. | Цена |');
WriteLn(' +----+---+-+------++');
S:=BD; i:=1; {в начало БД}
while S<>nil do {пока не дошли до конца БД}
begin {вывод каждой записи из списка БД}
WriteLn(' |',i:3,' | ',S^.Data. Name:23,' | ',S^.Data. Author:21,' | ',S^.Data. Page:4,' | ',S^.Data. Price:7:2,' |');
S:=S^.Next; {переход на следующую запись}
inc(i); {увеличить количество записей}
end;
WriteLn(' +----+---+-+------++');
TextColor(10);
Write(' Нажмите любую клавишу'); ReadKey;
TextBackground(7);
ClrScr;
Window(32,3,78,21);
TextBackground(0);
ClrScr;
Window(31,2,77,20);
TextBackground(1);
ClrScr;
end;
procedure AddRec; {добавление новой записи в БД}
var tmp: Book;
begin
TextColor(12); GotoXY(4,4);
WriteLn('Введите данные о книге:'); WriteLn;
TextColor(14);
Write(' Название: '); ReadLn(tmp. Name);
Write(' Автор: '); ReadLn(tmp. Author);
Write(' Страниц: '); ReadLn(tmp. Page);
Write(' Стоимость: '); ReadLn(tmp. Price);
NewEl(tmp); {добавление нового элемента в список}
TextColor(10);
WriteLn;
WriteLn(' Новая запись добавлена!');
end;
procedure FindRec; {поиск записи}
var tmp: Book;
S: List; {вспомогательный указатель}
b1,b2,b3,b4: boolean; {для определения успеха поиска по частям}
begin
TextColor(12); GotoXY(4,2);
WriteLn('Введите данные для поиска:');
WriteLn('(если поле не участвует в поиске,');
WriteLn('(введите в него "0")');
WriteLn;
TextColor(14);
Write(' Название: '); ReadLn(tmp. Name);
Write(' Автор: '); ReadLn(tmp. Author);
Write(' Страниц: '); ReadLn(tmp. Page);
Write(' Стоимость: '); ReadLn(tmp. Price);
S:=BD;
while S<>nil do
begin
if tmp. Name='0' then b1:=true else b1:=(tmp. Name=S^.Data. Name);
if tmp. Author='0' then b2:=true else b2:=(tmp. Author=S^.Data. Author);
if tmp. Page=0 then b3:=true else b3:=(tmp. Page=S^.Data. Page);
if tmp. Price=0 then b4:=true else b4:=(tmp. Price=S^.Data. Price);
if b1 and b2 and b3 and b4 then break;
S:=S^.Next;
end;
TextColor(10);
WriteLn;
if S<>nil then
begin
WriteLn(' Найденная запись:');
WriteLn(' Название: ',S^.Data. Name);
WriteLn(' Автор: ',S^.Data. Author);
WriteLn(' Страниц: ',S^.Data. Page);
WriteLn(' Стоимость: ',S^.Data. Price);
end
else
WriteLn(' Запись на найдена!!!');
end;
procedure BDInFile; {сохранение БД в файле}
var FileName: string; {имя файла}
F: file of Book; {файл из структур}
Y: char;
S: List; {вспомогательный указатель}
begin
ClrScr;
TextColor(14); GotoXY(4,2);
Write('Задайте имя файла: '); ReadLn(FileName);
Assign(F, FileName); {связать с файлом на диске}
{$I-} {отключить проверку ошибок}
Reset(F); {попытка открыть файл}
{$I+} {включить проверку ошибок}
if IOResult <> 0 then {если была ошибка при открытии файла}
begin
TextColor(12);
WriteLn(' Создан новый файл');
Rewrite(F); {перезаписать файл}
end
else {если файл был найден}
begin
Close(F);
WriteLn(' Файл уже существует!');
Write(' Перезаписать его (Y/N)?'); Y:=ReadKey;
if (Y='Y') or (Y='y') then
begin
WriteLn(' Файл был перезаписан!');
Rewrite(F);
end
else
begin
WriteLn(' Сохранение отменено!!!');
exit;
end;
end;
S:=BD;
while S<>nil do {пока не конец списка}
begin
Write(F, S^.Data); {записать в файл запись}
S:=S^.Next; {перейти на следующую запись}
end;
TextColor(10); GotoXY(4,7);
WriteLn('БД успешно сохранена!!!');
Close(F); {закрыть файл}
end;
begin {главная программа}
Zastavka; {графическая заставка}
YesBD:=false; {БД пока нет}
TextBackground(7);
ClrScr;
Repeat {цикл для меню}
Window(4,3,30,21);
TextBackground(0);
ClrScr;
Window(3,2,29,20);
TextBackground(1);
ClrScr;
TextColor(12); GotoXY(6,2); WriteLn('МЕНЮ:'); WriteLn;
if YesBD then TextColor(7) else TextColor(14);
WriteLn(' 1. Загрузка БД из файла');
if YesBD then TextColor(14) else TextColor(7);
WriteLn(' 2. Просмотр БД');
WriteLn(' 3. Добавить запись');
WriteLn(' 4. Поиск записи');
WriteLn(' 5. Сохранение БД в файл');
WriteLn(' 6. Удаление БД');
TextColor(14);
WriteLn(' 7. Выход');
WriteLn; TextColor(12);
Write(' Ваш выбор: '); ReadLn(menu);
Window(32,3,78,21);
TextBackground(0);
ClrScr;
Window(31,2,77,20);
TextBackground(1);
ClrScr;
case menu of {организация работы меню}
1: if YesBD then WriteLn('BD uje est!') else LoadBD;
2: if YesBD then ViewBD else WriteLn('Нет БД для работы!');
3: if YesBD then AddRec else WriteLn('Нет БД для работы!');
4: if YesBD then FindRec else WriteLn('Нет БД для работы!');
5: if YesBD then BDInFile else WriteLn('Нет БД для работы!');
6: if YesBD then DelBD else WriteLn('Нет БД для работы!');
7: WriteLn(' Спасибо за работу!');
else WriteLn('Неверный ввод!!! Повторите выбор!!!');
end;
until menu=7;
end.
