Текст программы (с комментариями)

Эта строка обозначает просто название программы. Это название 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.