При создании главной формы fmMain заполняются фиксированные столбцы таблицы, являющиеся названиями полей записи о книге. Очевидно, что при запуске приложения число записей массива равно нулю, поэтому переменной Num присваивается значение 0, а создание формы не может привести к изменению массива, поэтому переменной DateChange присваивается значение False. Необходимо учесть, что элементы главного меню имеют свойство Hint, но автоматическая выдача кратких справок для них не реализована. Реализуется возможность выводить справку по элементу меню через свойство Hint объекта Application. В это свойство помещается значение свойства Hint компонента, для которого генерируется событие OnHint (когда компонент окажется под курсором мыши). В секции private описания класса формы fmMain помещается заголовок обработчика события OnHint: Procedure MenuHint (Sender: TObject). Обработчик события OnHint будет работать всякий раз, когда появится событие OnHint. Далее событию OnHint приложения Application присваивается указатель на созданный ранее обработчик MenuHint, что делается в обработчике события OnCreate создания формы fmMain приложения:

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. FormCreate

Обработчик события, помещающий текст справки из свойства Hint приложения Application в свойство Text нулевой панели (нумерация начинается с 0) строки состояния StatusBar имеет вид:

procedure TfmMain. MenuHint (Sender: TObject);

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

begin

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

end; // procedure TfmMain. MenuHint

Для вывода даты и времени используется обработчик события onTimer - процедура TFmMain. TimerTimer. Текущая дата выводится в первую панель статуса, а текущее время - во вторую панель статуса.

procedure TFmMain. TimerTimer (Sender: TObject);

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

begin

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

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

end; // procedure TfmMain. TimerTimer

В случае нажатии кнопки "Загрузить" на главной форме, выполняется процедура TfmMain. bbtLoadClick, которая загружает данные из текстового файла. Далее полученная информация записывается в массив записей, а оттуда с помощью процедуры TfmMain. Output выводится в таблицу sgBooks. В случае если файл не подходит для загрузки (происходит ошибка конвертирования), то возникает исключительная ситуация EConvertError, и пользователь видит соответствующее сообщение об ошибке. При загрузке файла SpecialBooks. txt осуществляется работа с конфиденциальными данными - будет запрашиваться пароль.

Внешний вид процедуры таков

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 fmKey. edKey. Text

end; // if ExtractFileName

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;

Output;

end // if Acess

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

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

end; // if ListOfStr. Count-1 mod 4 <>0

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

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

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

end; // try

end; // procedure TfmMain. bbtLoadClick

При нажатии кнопки "Сохранить" выполняется процедура TfmMain. bbtSaveClick, позволяющая сохранять информацию о книгах в текстовый файл. Сохраняются только те элменты массива, поля записей Remote и Visible которых равны соответственно False и True. В последующем данный файл можно загрузить, нажав кнопку "Загрузить".

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, которая создает новую запись о книге в файле записей и с помощью процедуры TfmMain. Output выводит её в таблицу sgBooks.

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);

Output; // вывод элементов массива записей в таблицу

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

end; // if

end; // with

end; // procedure

При нажатии кнопки "Изменить" выполняется процедура TfmMain. bbtChangeClick, которая с помощью процедуры TfmMain. CodeOfBook определяет номер выбранной записи, а затем пользователь имеет возможность изменить данную запись.

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;

Output; // вывод элементов массива записей в таблицу

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

end; // if

end; // with

end; // procedure

Нажатие кнопки "Удалить" запускает процедуру TfmMain. bbtDelClick, которая с помощью процедуры TfmMain. CodeOfBook определяет номер выбранной записи, а затем пользователь имеет возможность удалить данную запись. Причём перед удалением появляется окно с подтверждением удалить. После удаление удалённой записи в поле Remote присваивается значение true. Далее процедура TfmMain. Output выводит элементы массива записей в таблицу sgBooks, но уже без удалённой записи.

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;

Output;

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

end;

end; // procedure

Нажатие кнопки "Выбрать" запускает процедуру TfmMain. bbtChoiceClick.

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

В зависимости от условий выборки данным обработчиком изменяются свойства Caption и Visible метки lbSorting и элементов массива записей.

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

Output;

end; // if

end; // procedure

Нажатие кнопки "Сортировать" запускает процедуру TfmMain. bbtSortingClick, которая предлагает пользователю три способа сортировки. В зависимости от выбранного способа после нажатия кнопки Сортировать выполняется одна из трёх процедур сортировки (TfmMain. SortingOfName, TfmMain. SortingOfAuthor, TfmMain. SortingOfYear). Далее с помощью процедуры TfmMain. Output отсортированные элементы выводятся на экран.

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;

Output; // вывод результатов в таблицу

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

end; // if

end; // procedure

Нажатие кнопки "Сохранить отчёт" запускает процедуру 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 ShowModal=mrOK

end; // with

end; // procedure TfmMain. bbtSaveReportClick

При попытке закрыть главную форму возникает событие OnCloseQuery. Основное действие, которое выполняется перед закрытием формы - проверка наличия изменений в таблице. Для этого ранее была введена переменная DataChange, отвечающая за хранение информации об изменениях. Если действия привели к изменению и сохранение возможно, то выводится запрос о сохранении сводки. В зависимости от результата диалога - нажатой при закрытии окна запроса кнопки выполняется одна из следующих операций: данные сохраняются в файле, выбранном пользователем, и форма закрывается, форма закрывается, не сохраняя данные, форма не закрывается.

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; // procedure TfmMain. FormCloseQuery

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

procedure TfmMain. bbtCloseClick (Sender: TObject);

// Закрыти формы

begin

Close;

end;

Практически все кнопки главного меню копируют действия соответствующих кнопок на главной форме за исключением кнопки miAbout. При нажатии кнопки miAbout происходит вызов справки о программе.

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;

3.10 Описание и реализация событий дополнительных форм и их компонентов

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

В разделе var интерфейса модуля Edit объявляется логическая переменная Result, хранящая информацию о том, какая кнопка нажата пользователем: совершить действие или отказаться.

Процедуры TFmMain. bbtChangeClick и TfmMain. bbtAddClick вызывают появление формы fmEdit. В появившемся окне курсор по умолчанию установлен в окне однострочного редактора для ввода наименования книги. Это действие реализуется обработчиком TfmEdit. FormShow.

procedure TfmEdit. FormShow (Sender: TObject);

// отображение формы

begin

edNameOfBook. SetFocus;

end;

Для добавления (изменения) информации необходимо нажать кнопку OK. Обработчик события - нажатие на данную кнопку TfmEdit. bbtEditOKClick предусматривает обработку всевозможных исключительных ситуаций.

Если все данные введены соответствующим образом, переменной Result присваивается значение true, определяющее последовательность действий в дальнейшем.

procedure TfmEdit. bbtEditOKClick (Sender: TObject);

// обработчик нажатия на кнопку OK

begin

try

Result: =false;

if edNameOfBook. Text=''

then raise Exception. Create ('Отсутствует наименование книги! ');

if edAuthor. Text=''

then raise Exception. Create ('Отсутствует имя автора! ');

if edIssue. Text=''

then raise Exception. Create ('Год введён с ошибкой! ');

if (StrToInt (fmEdit. edYear. Text) <1900) or (StrToInt (fmEdit. edYear. Text) >2009)

then raise Exception. Create ('Год введён с ошибкой! ');

Result: =true;

except // обработка исключительных ситуаций

on E: EConvertError do begin

ShowMessage ('Год не введён! ');

fmEdit. edYear. SetFocus;

fmEdit. Close;

end;

on E: Exception do begin ShowMessage (E. Message);

edNameOfBook. SetFocus;

end; // try

end;

end; // procedure TfmEdit. bbtEditOKClick

3.10.2 Реализация событий формы пароля

При попытке работы с конфиденциальными данными программа запрашивает пароль. Процедура TFmParol. FormShow отображает форму для ввода пароля с очищенным окном редактирования и установленным фокусом ввода на это окно.

procedure TfmKey. FormShow (Sender: TObject);

// Отображение формы

begin

edKey. Text: ='';

edKey. SetFocus;

end; // procedure TfmKey. FormShow;

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

В разделе interface модуля Choice объявлена логическая переменная ChoiceResult, хранящая информацию о выбранном действии (добавить или отказаться). При нажатии на кнопку "Выбрать" управление передается обработчику TfmChoice. bbtChoiceOKClick. При работе данной процедуры возможно появление двух исключительных ситуаций: ошибки преобразования в функции StrToInt иjib,rb rjydthnbhjdfybz. Каждое из данных исключений имеет собственный обработчик. Если параметры выборки заданы корректно и исключительные ситуации не возникли, переменной ChoiceResult присваивается значение true.

procedure TfmChoice. bbtChoiceOKClick (Sender: TObject);

// Обработчик нажатия на кнопку OK

begin

try

ChoiceResult: =False;

if (StrToInt (fmChoice. edChoice. Text) <1900) or (StrToInt (fmChoice. edChoice. Text) >2009)

then raise Exception. Create ('Год введён с ошибкой! ');

ChoiceResult: =true;

except // обработка исключительных ситуаций

on E: EConvertError do begin

ShowMessage ('Год не введён! ');

fmChoice. edChoice. SetFocus;

fmChoice. Close;

end;

on E: Exception do begin

ShowMessage (E. Message);

fmChoice. edChoice. SetFocus;

end;

end; // try

end; // procedure

Нажатие на кнопку "Отказаться" обрабатывает процедура TfmChoice. bbtChoiceCancelClick. Форма закрывается, а переменной ChoiceResult присваивается значение false.

procedure TfmChoice. bbtChoiceCancelClick (Sender: TObject);

// Обработчик нажатия на кнопку Cancel

begin

ChoiceResult: =false;

fmChoice. Close;

end;

4. Текст программы