Текст программы (с комментариями)
Эта строка обозначает просто название программы. Это название BD_Book. В принципе эту строку можно убрать, она необязательная.
program BD_Book;
uses Crt, Graph; {подключаем модули для работы с текстом и графикой.
В модуле Crt содержатся процедуры для работы с экраном в текстовом режиме (это режим с разрешением 80 на 25). Работа с экраном – это например вывод строк или чисел на экран, установка разных цветов символов.
В модуле Graph содержатся процедуры для работы с экраном графическом режиме (это режим с разрешением чаще всего 640 на 480). Этот режим в программе применяется для рисования красивой заставки. Понятно, что в текстовом режиме 80 на 25 такую заставку нарисовать не получится
}
В программе есть база данных с информацией о книгах. Т. е. это произвольное количество книг, которые нужно каким-то образом разместить в памяти. В принципе, мы могли бы создать массив и хранить в каждом элементе массива информацию об одной книге. А уж перемещаться по массиву паскаль позволяет легко и без проблем. Т. е. в массиве нам не нужно было бы каким-то образом настраивать связи между соседними книгами. Т. е паскаль позволил бы нам легко перемещаться от одной книги к другой, не задумываясь о том как паскаль это делает. Но проблема в том, что в паскале массив может иметь размер не более чем 64000 байт. А если у нас очень много книг, как же мы запишем всю информацию в массив? Никак. К тому же вдруг у нас очень мало книг, зачем мы будем создавать огромный массив, который съест у нас кучу памяти (т. е. память для массива можно выделить только 1 раз в начале выполнения программы и потом ее нельзя уменьшить или увеличить). И еще: мАссивы размещаются в статической памяти, которая как раз и имеет максимальный размер 64000 байт. Выход есть: можно хранить книги в динамической памяти, которая имеет гораздо больший размер. И к тому же мы не будем занимать в динамической памяти место сразу для огромного количества книг, можно выделять память отдельно для каждой книги по мере необходимости. Мы будем хранить книги в списке, который сначала будет пустым, а потом по мере необходимости мы будем выделять в динамической памяти место для одной книги и добавлять эту книгу в список. Т. е. мы будем брать из динамической памяти ровно столько места, сколько нам необходимо. И мы будем читать из файла информацию о книгах по одной, выделять память для нее и привязывать эту книгу в список. И если нам нужно какую-то книгу выбросить из списка, то мы сначала освободим память, которую эта книга занимала, а потом удалим эту книгу из списка.
Проблема в том, что со списком работать будет сложнее, чем с массивом. Паскаль не сможет сам перемещаться от одной книги к другой, как в массиве. Нам нужно самим настраивать связь между соседними книгами. А без связи обойтись нельзя, потому что если допустим мы захотим вывести все книги на экран, то нам нужно вывести информацию о текущей книге и переместиться на следующую книгу. Таким образом подобные списки строятся так: каждый элемент списка будет содержать информацию об одной книге и указатель на следующую книгу. Вот схема:

Type
Информация о книге включает в себя 4 поля: название книги, автор книги, количество страниц в книге, стоимость книги. Если в инфомации не одно поле, а больше, то в паскале создается запись record для хранения всех полей. Все эти 4 поля первой книги будут храниться в нарисованном на схеме прямоугольнике “Информация о первой книге”. Запись для хранения информации о книге называется в этой программе Book.
Book = record {структура для представления записи БД}
Name: string; {название книги. строка}
Author: string; {автор книги. строка}
Page: integer;{количество страниц в книге. Целое число}
Price: real; {стоимость книги. Вещественное число}
end;
Далее идет указатель на элемент списка. На схеме нарисованы такие указатели. Указатель – это просто адрес следующего элемента списка в динамической памяти. А адрес – это какое-то число. Элемент списка называется Rec. Это на схеме 2 сцепленных прямоугольника (один сверху, другой снизу).
List = ^Rec; {структура "Список" для хранения записей}
Rec = record
Data: Book; {информация о книге, т. е. верхний прямоугольник элемента списка}
Next: List; {указатель на следующий элемент, т. е. нижний прямоугольник элемента списка. занимает 2 байта в памяти }
end;
var menu: integer; {номер выбранного пункта меню. В программе есть меню, в котором 7 элементов}
YesBD: boolean; {имеется ли БД для работы. Т. е загрузили ли мы БД(базу данных) из файла. Если загрузили, то эта логическая переменная YesBD равна true, иначе - false}
BD: List; { это указатель на первую книгу. Самый главный указатель. На схеме нарисован}
procedure DelBD; {уничтожение базы данных. Эта процедура должна удалить всю базу данных из памяти, т. е все книги. Но на самом деле в этой процедуре удаляется из памяти только первая книга. и указатель на первую книгу станет пустым, т. е nil. Это конечно не совсем верно сделано. Надо, чтобы программа пробежалась по всему списку и удалила из памяти все его элементы, т. е все книги}
begin
Dispose(BD); {удаляем из памяти первый элемент списка}
YesBD:=false; {теперь знаем, что списка для работы нет. Об этой переменной можно прочитать выше}
Далее в текстовом режиме помещаем курсор в позицию с координатами (4,7) 4 – по горизонтали, 7 – по вертикали.
GotoXY(4,7);
И устанавливаем цвет пера номер 10 (светло-зеленый). Цветов всего 16. От 0 до 15
TextColor(10);
И Выводим на экран сообщение БД удалена!
Write('БД удалена!');
end;
procedure NewBD; {эта процедура вызывает прудыдущую процедуру удаления списка из памяти, если список есть}
begin
if YesBD then DelBD; {если есть база, то ее надо уничтожить}
BD:=nil; {указатель на первую книгу делаем пустым}
end;
procedure NewEl(t: Book); {процедура добавления нового элемента в список. Процедура получает в качестве параметра переменную t, которая, которая содержит информацию о книге, т. е 4 поля. И эту информацию надо теперь прицепить в конец списка}
var x: List; {вспомогательный указатель}
S: List; {вспомогательный указатель}
begin
if BD=nil then {если добавляется первый элемент в список, т. е если список пустой}
begin
new(x); {выделить динамическую память под новый элемент списка. Переменная x имеет тип List, т. е. тип элемента списка. а значит в памяти выделяется место для информации о 4-х полях информации о книге и + место для указателя на следующую книгу}
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); устанавливаем цвет для рисования (разные цвета в цикле for. Т. е. меняем все 16 цветов по очереди)
Rectangle(0+i*2, 0+i*2, GetMaxX-i*2, GetMaxY-i*2); рисуем прямоугольник. Надо просто посмотреть саму заставку на экране и все будет понятно. GetMaxX возвращает максимальный размер экрана по горизонтали. Это обычно число 640. GetMaxY возвращает максимальный размер экрана по вертикали. Это обычно число 480.
end;
SetColor(4); красный цвет рисования {Вывод информации}
Далее Выбираем стиль текста: шрифт по умолчанию, горизонтальный
SetTextStyle(DefaultFont, HorizDir, 3);
Выводим строку 'БД КНИГИ' место с координатами x = 200 ,y = 130
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; {файл из структур, т. е это типизированный файл, в котором записана информация только о книгах, в которой обязательно 4 поля. Если вдруг в файле информация в другом виде, то мы ее прочитать таким способом не сможем. Т. е. кто-то заранее подготовил этот типизированный файл с инфор. О книгах в нужном нам формате путем тоже программного его формирования и мы теперь будем из этого файла информацию читать}
tmp: Book;вспомогательная переменная
begin
ClrScr;очищаем экран
NewBD; {создать новый список для хранения БД. Вызываем процедуру}
Ставим цвет 14 и перемещаемся в позицию с координатами (4,2)
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); {читать из файла запись в переменную tmp, т. е. все 4 поля информации о книге}
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);цвет фона символов 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; {в начало БД, и начинаем выводить всю информацию о каждой книге, т. е все 4 поля}
while S<>nil do {пока не дошли до конца БД}
begin {вывод каждой записи из списка БД}
вот таким способом можно получить доступ к любому из 4-х полей книги. Например чтобы получить название книги надо записать так: S^.Data. Name, где s – это указатель на текущую книгу. Чтобы получить доступ ко всей информации о книге пишем S^.Data. а чтобы потом получить название книги пишем S^.Data. Name. :23 означает, что мы выделяем названию книги на экране 23 позиции.
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;вспомог. Переменная для размещения в ней всех 4-х полей новой книги
begin
TextColor(12); GotoXY(4,4);
WriteLn('Введите данные о книге:');
WriteLn;переход на новую строку на экране
TextColor(14);цвет символов 14 желтый
Далее запрашиваем у пользователя ввод всех 4-х полей информ. О книге.
Write(' Название: '); ReadLn(tmp. Name);вводим название книги
Write(' Автор: '); ReadLn(tmp. Author);вводим автора
Write(' Страниц: '); ReadLn(tmp. Page);вводим колич. страниц
Write(' Стоимость: '); ReadLn(tmp. Price);вводим цену
NewEl(tmp); {добавление нового элемента в список. Для этого Вызываем процедуру NewEl }
TextColor(10);
WriteLn;переходим на новую строку
WriteLn(' Новая запись добавлена!');
end;
procedure FindRec; {поиск конкретной книги в списке}
var tmp: Book;
S: List; {вспомогательный указатель}
b1,b2,b3,b4: boolean; {для определения успеха поиска по частям. По каждому из 4- полей инф. О книге}
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; пробежимся по всему списку в поисках такой книги. Сначала ставим указатель s на первый первый элемент списка
while S<>nil do
begin
если ввели 0 вместо названия книги, то название не ищем, а сразу ставим b1:=true, т. е типа книга с любым названием подойдет
if tmp. Name='0' then b1:=true else
если введенное название равно названию текущей книги в списке, то считаем b1:=true, т. е книга с таким названием найдена
b1:=(tmp. Name=S^.Data. Name);
дальше аналогичные операции с остальными 3-мя полями
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);
если все 4 переменные равны true, то книгу нашли и break означает, что мы выходим из цикла прохода по списку.
if b1 and b2 and b3 and b4 then break;
S:=S^.Next;на следующий элемент списка
end;
TextColor(10);
WriteLn; переходим на следующую строку
Если S<>nil, т. е. если мы нашли подходящую книгу. А если не нашли, то S = nil, т. к. дошли до последнего элемента списка, который ни на кого не указывает
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; {файл из структур. Тоже типизированный файл. Т. е мы будем все элементы списка записывать в файл, в котором будут храниться только с информацией о 4-х полях информации о книгах}
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;запрашиваем ответ пользователя. Пользователь должен ответить ввести букву Y или N
if (Y='Y') or (Y='y') then если пользователь ввел букву Y или y
begin
WriteLn(' Файл был перезаписан!');выдаем вообщение на экран
Rewrite(F);открываем файл для записи в него
end
else
begin
WriteLn(' Сохранение отменено!!!');
exit;выходим из процедуры совсем, если пользователь не хочет этот файл перезаписывать
end;
end;
S:=BD;тот же самый механизм перемещения по всему списку, начиная с начала списка и до конца
while S<>nil do {пока не конец списка}
begin
Write(F, S^.Data); {записать в файл запись. Т. е. Все 4 поля информации о книге сразу одной командой в файл}
S:=S^.Next; {перейти на следующую запись}
end;
TextColor(10); GotoXY(4,7);
WriteLn('БД успешно сохранена!!!');
Close(F); {закрыть файл}
end;
begin {главная программа}
Zastavka; {вызываем процедуру графической заставки}
YesBD:=false; {БД пока нет}
TextBackground(7);цвет фона символов 7
ClrScr;очищаем экран
Repeat {цикл для меню. В котором будем крутиться пока пользователь не введет цифру 7, т. е. пока не выберет выход из программы}
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, и БД уже была загружена, то выводим сообщение 'BD уже есть!', иначе вызываем процедуру LoadBD – загрузка БД.
1: if YesBD then WriteLn('BD уже есть!') else LoadBD;
если выбрали пункт меню 2, то если БД уже была загружена, то вызываем процедуру ViewBD. Иначе выводим сообщение 'Нет БД для работы!'
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(' Спасибо за работу!');
Если полдьзовательь ввел не цифру от 1 до 7 то выводим сообщение об ошибке
else WriteLn('Неверный ввод!!! Повторите выбор!!!');
end;
until menu=7; цикл пока пользователь не выберет выход из программы
end.


