procedure TfmMain. FormCreate (Sender: TObject);

// создание главной формы

begin

// закрываем доступы к кнопкам Изменить Удалить Сохранить

// Выбрать Сортировать

bbtChange. Enabled:=False; miChange. Enabled:=False;

bbtDel. Enabled:=False; miDel. Enabled:=False;

bbtSave. Enabled:=False; miSave. Enabled:=False;

bbtSaveReport. Enabled:=False; miSaveReport. Enabled:=False;

bbtSorting. Enabled:=False; miSorting. Enabled:=False;

bbtChoice. Enabled:=False; miChoice. Enabled:=False;

Application. Title:='Библиотека';

Application. OnHint:=MenuHint;

// заполнение нулевой строки таблицы sgBooks

with sgBooks do begin

cells [0,0]:='Номер';

cells [1,0]:=' Наименование';

cells [2,0]:=' Автор';

cells [3,0]:=' Издание';

cells [4,0]:='Год издания';

end; // окончание оператора with

Num:=0; // число записей равно 0

DataChange:=false; // изменений нет

end; // окончание процедуры.

procedure TfmMain. MenuHint (Sender: TObject);

// Обработчик события вывода краткой справки

begin

StatusBar. Panels [0]. Text:=Application. Hint;

end; // окончание процедуры.

procedure TFmMain. TimerTimer (Sender: TObject);

// Обработчик события вывода даты и времени

begin

StatusBar. Panels [1]. Text:=DateToStr (Date);

StatusBar. Panels [2]. Text:=TimeToStr (Time);

end; // окончание процедуры.

procedure TfmMain. bbtLoadClick (Sender: TObject);

// загрузка данных из текстового файла

var

i,Number: Integer;

Acess: Boolean; // доступ к файлу

begin

try

Acess:=True; // доступ к файлу открыт

// выбираем текстовый файл для загрузки

OpenDialog. Filter:='Все файлы (*. *) |*. * |Текстовые файлы (*.txt) |*.txt';

OpenDialog. Title:='Открытие файла;

OpenDialog. FilterIndex:=2;

if OpenDialog. Execute then

// если выбранный файл 'Special Books.txt'

if ExtractFileName (OpenDialog. FileName) ='Special Books.txt'

then begin

Acess:=False; // закрываем доступ к файлу

fmKey. ShowModal; // форма fmKey становится модальной

if fmKey. ModalResult=mrOk // если нажата кнопка OK

then begin

// пароль верный, открываем доступ

if fmKey. edKey. Text='778'

then Acess:=True

else ShowMessage ('Пароль не верный! ');

end; // окончание оператора if с условием, проверяющим правильность пароля

end; // окончание оператора if с условием, что имя вызываемого файла = `Special Books.txt'

if Acess // если доступ открыт

then begin

ListOfStr:=TStringList. Create;

ListOfStr. LoadFromFile (OpenDialog. FileName);

Number:=0;

i:=0;

while i<ListOfStr. Count-1 do begin

with Book [Number] do begin

Code:=Number+1;

Name:=ListOfStr [i];

Author:=ListOfStr. Strings [i+1];

Issue:=ListOfStr. Strings [i+2];

Year:=StrToInt (ListOfStr. Strings [i+3]);

Inc (i,4);

Visible:=true;

Remote:=false;

end; // окончание оператора with

Number:=Number+1;

end; // окончание оператора while

ListOfStr. Clear; ListOfStr. Destroy;

Num:=Number+1;

fmMain.Activate; // имитация события, вызывающего процедуру, выводящую элементы из массива в таблицу

end // if Acess

else if ListOfStr. Count-1 mod 4 <>0 then begin

raise Exception. Create ('Недопустимая структура файла);

end; // окончание оператора if

except // исключительная ситуация

on EConvertError do ShowMessage (' Данный файл#10#13'не может быть открыт! ');

on E: Exception do ShowMessage ('Недопустимая структура файла);

end; // окончание оператора try

end; // окончание процедуры.

procedure TfmMain. bbtSaveClick (Sender: TObject);

// Сохранение существующих данных

var

f: Textfile;

i: Integer;

begin

// выбираем текстовый файл для загрузки

SaveDialog. Filter:='Все файлы (*. *) |*. * |Текстовые файлы (*.txt) |*.txt';

SaveDialog. Title:='Сохранение файла';

SaveDialog. FilterIndex:=2;

if SaveDialog. Execute=true // если нажата кнопка Сохранить, тогда

then begin

i:=Pos ('.txt',SaveDialog. FileName);

// если у файла есть расширение.txt

if i>0

then AssignFile (f,SaveDialog. FileName)

else AssignFile (f,SaveDialog. FileName+'.txt');

Rewrite (f); // открываем файл для записи

for i:=0 to Num-1 do begin

// если данная запись не удалена и видима

if (Book [i]. Remote=false) and (Book [i]. Visible=true)

then begin

// записываем данную запись в текстовый файл

Writeln (f,Book [i]. Name);

Writeln (f,Book [i]. Author);

Writeln (f,Book [i]. Issue);

Writeln (f, IntToStr (Book [i]. Year));

end; // окончание оператора if, проверяющего видимость записи

end; // окончание цикла for

CloseFile (f); // закрываем файл

end; // окончание оператора if, проверяющего расширение файла

DataChange:=false; // все изменения сохранены

end; // окончание процедуры.

procedure TfmMain. bbtAddClick (Sender: TObject);

// Добавление новой записи

begin

with fmEdit do begin

Caption:='Добавление новой записи;

bbtEditOK. Caption:='Добавить';

bbtEditOK. Hint:='Добавить новую запись;

edNameOfBook. Text:='';

edAuthor. Text:='';

edIssue. Text:='';

edYear. Text:='';

ShowModal;

if Result then begin // если нажата кнопка «Добавить»

Num:=Num+1; // число записей возрастает

// добавление в массив записей нового элемента

Book [Num-1]. Code:=Num;

Book [Num-1]. Name:=edNameOfBook. Text;

Book [Num-1]. Author:=edAuthor. Text;

Book [Num-1]. Issue:=edIssue. Text;

Book [Num-1]. Year:=StrToInt (edYear. Text);

Book [Num-1]. Remote:=false;

Book [Num-1]. Visible:=true;

// количество книг увеличивается

lbNum. Caption:='Количество книг: '+IntToStr (Num);

fmMain.Activate; // имитация события, вызывающего процедуру, выводящую элементы из массива в таблицу

DataChange:=true; // произошло изменение

end; // окончание процедуры if, проверяющей нажатие кнопки «Добавить»

end; // окончание оператора with

end; // окончание процедуры.

procedure TfmMain. bbtChangeClick (Sender: TObject);

// Изменение существующей записи

var

Number: Integer;

begin

with fmEdit do begin

Caption:='Изменение существующей записи;

bbtEditOK. Caption:='Изменить';

bbtEditOK. Hint:='Изменить существующую запись;

Number:=CodeOfBook (StrToInt (sgBooks. Cells [5,sgBooks. Row]));

with Book [Number] do begin

edNameOfBook. Text:=Name;

edAuthor. Text:=Author;

edIssue. Text:=Issue;

edYear. Text:=IntToStr (Year);

end; // окончание оператора with

ShowModal; // форма становится модальной

if Result then begin // если нажата кнопка Изменить

// изменяем запись в массиве записей

Book [Number]. Name:=edNameOfBook. Text;

Book [Number]. Author:=edAuthor. Text;

Book [Number]. Issue:=edIssue. Text;

Book [Number]. Year:=StrToInt (edYear. Text);

Book [Number]. Remote:=false;

Book [Number]. Visible:=true;

fmMain.Activate; // имитация события, вызывающего процедуру, выводящую элементы из массива в таблицу

DataChange:=true; // произошло изменение

end; // окончание оператора if, проверяющего нажатие кнопки Изменить

end; // окончание оператора with

end; // окончание процедуры.

procedure TfmMain. bbtDelClick (Sender: TObject);

// Удаление выбранной записи

var

Number: Integer;

begin

if MessageDlg ('Удалить данную запись? ',mtWarning, mbYesNoCancel,0) =mrYes

then begin

Number:=CodeOfBook (StrToInt (sgBooks. Cells [5,sgBooks. Row]));

Book [Number]. Remote:=true;

Book [Number]. Visible:=true;

fmMain.Activate; // имитация события, вызывающего процедуру, выводящую элементы из массива в таблицу

DataChange:=true; // произошло изменение

end;

end; // окончание процедуры.

procedure TfmMain. bbtChoiceClick (Sender: TObject);

// выборка данных

var

Exist: Boolean;

begin

with fmChoice do begin

edChoice. Text:='1900';

ShowModal; // форма становится модальной

// если нажата кнопка OK

if ChoiceResult=true then begin

// обращаемся к процедуре Choice

Choice (StrToInt (edChoice. Text),Exist);

if Exist=false // если книг с данным параметром нет

then begin

ShowMessage ('Таких книг нет! ');

Choice (1900,Exist); // выбираем все книги

end // then

else begin

lbSorting. Visible:=True;

// метка lbSorting видима

lbSorting. Caption:='Книги, изданные после '+ fmChoice. edChoice. Text+ ' года'; end; // else

end; // окончание оператора with

fmMain.Activate; // имитация события, вызывающего процедуру, выводящую элементы из массива в таблицу

end; // окончание оператора if, проверяющего наличие книг с заданным параметром поиска

end; // окончание процедуры.

procedure TfmMain. bbtSortingClick (Sender: TObject);

// Сортировка по выбранному параметру

begin

// если нажата кнопка OK

if fmSorting. ShowModal=mrOK then begin

// если выбрана кнопка Сортировать по названию книги

if fmSorting. rbNameOfBook. Checked

then SortingOfName;

// если выбрана кнопка Сортировать по названию автора

if fmSorting. rbAuthor. Checked

then SortingOfAuthor;

if fmSorting.rbYear.Checked // если выбрано сортирование по году издания

then SortingOfYear;

fmMain.Activate; // имитация события, вызывающего процедуру, выводящую элементы из массива в таблицу

DataChange:=true; // произошло изменение

end; // окончание оператора if, проверяющего сортировку по году издания

end; // окончание процедуры.

Нажатие кнопки "Сохранить отчёт" запускает процедуру TfmMain. bbtSaveReportClick, которая позволяет сохранить отчёт в текстовый файл в виде таблицы.

procedure TfmMain. bbtSaveReportClick (Sender: TObject);

// Сохранение отчёта

var

i,j,Number: Integer;

s: String; // строка для выдачи отчёта

begin

with fmReporting do begin

mmReporting. Clear; // очистка поля mmReporting

// добавляем новую строку с заголовком

mmReporting. Lines. Add (' Библиотека');

if lbSorting. Visible=true then mmReporting. Lines. Add (lbSorting. Caption);

// выводим в поле многострочного редактора mmReporting заголовки таблицы

mmReporting. Lines. Add (Lin1);

mmReporting. Lines. Add (Lin2);

mmReporting. Lines. Add (Lin3);

// для всех элементов массива

Number:=0;

s:='';

for i:=0 to Num-1 do begin

// если запись не удалена и видима

if (Book [i]. Remote=false) and (Book [i]. Visible=true) then begin

Number:=Number+1;

// формируем таблицу

s:='|'+IntToStr (Number);

for j:=1 to w1-Length (IntToStr (Number)) do s:=s+' ';

s:=s+'|';

with Book [i] do begin

s:=s+Name;

for j:=1 to w2-Length (Name) do s:=s+' ';

s:=s+'|'+Author;

for j:=1 to w3-Length (Author) do s:=s+' ';

s:=s+'|'+Issue;

for j:=1 to w4-Length (Issue) do s:=s+' ';

s:=s+'|'+IntToStr (Year);

for j:=1 to w5-Length (IntToStr (Year)) do s:=s+' ';

s:=s+'|';

end; // окончание оператора with Book

mmReporting. Lines. Add (s);

end; // окончание оператора if, проверяющего видимость записи в таблице

end; // окончание цикла for

mmReporting. Lines. Add (Lin3);

mmReporting. Lines. Add (' '+lbNum. Caption); // выводим строку с числом книг

ShowModal;

if ModalResult=mrOK then begin

SaveDialog. Filter:='Все файлы (*. *) |*. * |Текстовые файлы (*.txt) |*.txt';

SaveDialog. Title:='Сохранение файла'; // заголовок окна SaveDialog

SaveDialog. FilterIndex:=2;

If SaveDialog. Execute then begin // если нажата кнопка OK

i:=Pos ('.txt',SaveDialog. FileName); // проверяем, есть ли в имени файла '.txt'

if i>0 then mmReporting. Lines. SaveToFile (SaveDialog. FileName)

// иначе - связываем файловую переменную с файлом + расширение

else mmReporting. Lines. SaveToFile (SaveDialog. FileName+'.txt');

ShowMessage ('Отчёт сохранён! ');

end; // окончание оператора if, проверка расширения файла

end; // окончание оператора if, проверяющего нажатие кнопки ОК

end; // окончание оператора with

end; // окончание процедуры.

procedure TfmMain. FormCloseQuery (Sender: TObject; var CanClose: Boolean);

var

res: Integer; // переменная для результата диалога

begin

if DataChange=true then begin

res:=MessageDlg ('Сохранит изменения? ',mtWarning, mbYesNoCancel,0);

case res of

mrYes: fmMain. bbtSaveClick (fmMain);

mrCancel: begin CanClose:=False; end;

end; // case

end; // окончание оператора if, проверяющего изменение данных

end; // окончание процедуры. TfmMain. FormCloseQuery

Непосредственное закрытие формы осуществляется процедурой TFmMain. bbtCloseClick.

procedure TfmMain. bbtCloseClick (Sender: TObject); // Закрытие формы

begin

Close;

end;

procedure TfmMain. miAboutClick (Sender: TObject);

begin // вывод справки

AboutBoxHelp.ShowModal; // форма становится модальной

end;

procedure TfmMain.miloadClick (Sender: TObject);

begin // кнопка загрузки файла

bbtLoadClick (Sender);

end;

procedure TfmMain. miSaveClick (Sender: TObject);

begin // кнопка сохранения файла

bbtSaveClick (Sender);

end;

procedure TfmMain. miAddClick (Sender: TObject);

begin // кнопка добавления записи

bbtAddClick (Sender);

end;

procedure TfmMain. miChangeClick (Sender: TObject);

begin // кнопка изменения записи

bbtChangeClick (Sender);

end;

procedure TfmMain. miDelClick (Sender: TObject);

begin //кнопка удаления записи

bbtDelClick (Sender);

end;

procedure TfmMain. miSaveReportClick (Sender: TObject);

begin // кнопка сохранения отчёта

bbtSaveReportClick (Sender);

end;

procedure TfmMain. miSortingClick (Sender: TObject);

begin // кнопка сортировки

bbtSortingClick (Sender);

end;

procedure TfmMain. miChoiceClick (Sender: TObject);

begin // кнопка выборки

bbtChoiceClick (Sender);

end;

procedure TfmMain. miCloseClick (Sender: TObject);

// кнопка закрытия

begin

Close;

end;

Реализация событий формы редактирования