Усовершенствование программы
Очевидно, что приведенный выше текст программы был бы намного проше и изящней, если бы поля вывода альтернативных ответов и переключатели выбора ответов были бы объединены в массивы. Тогда программа могла бы обращаться к полям и переключателям не по имени, а по индексу.
Delphi позволяет объединить компоненты в массив, однако создаваться такие компоненты должны не во время создания формы приложения, а динамически — во время работы программы.
На рис. 15.7 приведен
вид формы усовершенствованного приложения.
Рис. 15.7. Форма
приложения Тест, версия 2
Объявление массива компонентов ничем не отличается от объявления обычного массива — указывается имя массива, диапазон изменения индекса и тип элементов массива. Ниже приведено объявление массивов компонентов формы разрабатываемой программы: answer: array[1..N_ANSWERS] of TLabel; // альтернативные ответы selector: array[1..N_ANSWERS+1] of TRadioButton; // кнопки выбора ответа
Однако, для того чтобы компонент появился в форме, одного объявления недостаточно. Компонент — это объект Delphi, и его объявление — это только указатель на область памяти, который без наличия объекта ни на что не указывает. Создается компонент применением метода Create к указателю на компонент, в нашем случае — к элементу массива.
Например, инструкции
answer[1] := TLabel.Create(self) ;
answer[1].Parent := Form1;
создают компонент Label и помещают его в форму.
После создания компонента программа должна выполнить его настройку, т. е. ту работу, которую во время создания формы приложения выполняет программист при помощи Object Inspector. Под настройкой понимается присваивание начальных значений тем свойствам компонента, предопределенные значения которых не отвечают предъявляемым требованиям.
Если компонент должен реагировать на некоторое событие, то. нужно написать процедуру обработки этого события и поместить объявление созданной процедуры в объявление типа формы. Например, объявление типа формы разрабатываемой программы должно выглядеть так:
type
TForm1 = class(TForm)
Label5: TLabel; // поле вывода вопроса
Image1: TImage; // область вывода иллюстрации
Panel1: TPanel;
Button1: TButton; // кнопка Ok, Дальше, Завершить
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonlClick(Sender: TObject);
procedure SelectorClick(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end;
В отличие от других, сгенерированных Delphi, строк объявления типа, строка procedure SelectorClick(Sender: TObject) вставлена В объявление вручную.
Примечание
В случае создания процедуры обработки события для компонента, который создается динамически, программист должен полностью написать текст процедуры и поместить ее объявление в объявление формы.При создании процедуры обработки события для обычного компонента (компонента, который добавлен в форму во время разработки формы программы) Delphi автоматически генерирует заготовку процедуры обработки события и ее объявление. Программист должен написать только инструкции процедуры.
После того как будет написана процедура обработки события, нужно связать эту процедуру с конкретным компонентом. Делается это путем присвоения имени процедуры обработки свойству, имя которого совпадает с именем обрабатываемого события. Например, инструкция
selector[1].OnClick : = SelectorClick;
задает процедуру обработки события Onclick для компонента selector [i]. В листинге 15.2 приведен полный текст программы Тест, версия 2.
Листинг 15.2.
Программа тестирования, версия 2
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label5: TLabel; // поле вывода вопроса Image1: TImage; // область вывода иллюстрации Panel1: ТPanel; Button1: TButton; // кнопка Ok, Дальше, Завершить
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonlClick(Sender: TObject);
procedure SelectorClick(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end;
var
Form1: TForm1; // форма implementation
const
N_ANSWERS=4; // четыре варианта ответов N_LEVEL=4; // четыре уровня оценки
var
// динамически создаваемые компоненты
answer: array[1..N_ANSWERS] of TLabel; // альтернативные ответы
selector: array[1..N_ANSWERS+1] of TRadioButton; // кнопки выбора ответа
f:TextFile;
fn:string; // имя файла вопросов
level:array[1..N_LEVEL] of integer; // сумма, соответствующая уровню
mes:array[1..N_LEVEL] of string; // сообщение, соответствующее уровню
score:array[1..N_ANSWERS] of integer; // очки за выбор ответа
summa:integer; // набрано очков
vopros:integer; // номер текущего вопроса
n_otv:integer; // число вариантов ответа
otv:integer; // номер выбранного ответа
// установка формы в исходное состояние Procedure ResetForm(frm:TForm1); var
i:integer; begin
for i:=1 to N_ANSWERS do begin
answer[i].width:=frm.ClientWidth-answer[i].left-5; answer[i].Visible:=FALSE; Selector[i].Visible:=FALSE; end;
frm. Label5.width:=frm.ClientWidth-frm.Label5.left-5; frm. Image1.Visible:=False; end;
// определение достигнутого уровня procedure Itog(suirana:integer;frm:TForm1); var
i:integer; buf:string; begin buf: = ";
str(summa:5,buf); buf:='Результаты тестирования'+chr(13)
+'Всего баллов: '+buf; i:=1; while (summa < level[i]) and (i<N_LEVEL) do
i:=i+l;
buf:=buf+chr(13)+mes[i]; frm.Labels.caption:=buf; end;
procedure TForm1.FormCreate(Sender: TObject); var
i: integer; begin
// создадим пять меток для вывода вопроса и альтернативных ответов
for i:=l to N_ANSWERS do
begin
answer[i]:=TLabel.Create(self); answer[i].Parent:=Forml; answer[i].Left:=36; answer[i].Wordwrap:=True; end;
// создадим переключатели для выбора ответа
for i:=l to N_ANSWERS+1 do
begin
selector[i]:=TRadioButton.Create(self);
selector[i].Parent:=self;
selector[i].Caption:='';
selector[i].Width:=17;
selector[i].Left:=16;
selector[i].Visible:=False;
selector[i].Enabled:=True;
selector[i].OnClick:=SelectorClick; end;
ResetForm(Forml); end;
// вывод начальной информации о тесте procedure info(var f:TextFile;l:TLabel); var
s,buf:string; begin
buf:=''; repeat
readln(f,s); if s[l]<>'.'
then buf:=buf+s+' '; until s[l] ='.'; Form1.Labels.caption:=buf; end;
// прочитать информацию об оценках за тест
Procedure GetLevel(var f:TextFile);
var
i:integer; buf:string;
begin // заполняем значения глобальных массивов i:=1; repeat
readln(f,buf); if buf[1] <> '.' then begin mes[i]:=buf; readln(f,level[i]); i:=i+1; end; until buf[1]='.';
end;
// масштабирование иллюстрации
Procedure ScalePicture;
var
w,h:integer; // максимально допустимые размеры картинки
scaleX:real; // коэф. масштабирования по X
scaleY:real; // коэф. масштабирования по Y
scale:real; // общий коэф. масштабирования
i:integer; begin
// вычислить максимально допустимые размеры картинки
w:=Form1.ClientWidth-Form1.Labels.Left;
h:=Form1.ClientHeight
- Form1.Panel1.Height -5
- Form1.Label5.Top
- Forml.Label5.Height - 5; for i:=1 to N_ANSWERS do
if answer[i].Caption <> ''
then h:=h-answer[i].Height-5;
// здесь определена максимально допустимая величина иллюстрации
// определить масштаб if w>Form1.Image1.Picture.Width
then scaleX:=1
else scaleX:=w/Forml.Image1.Picture.Width; if h>Forml.Image1.Picture.Height
then scaleY:=1
else scaleY:=h/Form1.Image1.Picture.Height; if ScaleYOcaleX
then scale:=scaleY
else scale:=scaleX; // здесь масштаб определен
Form1.Image1.Top:= Form1.Label5.Top+Forml.LabelS.Height+5; Form1.Image1.Left:=Form1.Label5.Left;
Form1.Image1.Width:= Round(Form1.Image1.Picture.Width*scale); Form1.Image1.Height:= Round(Form1.Image1.Picture.Height*scale) Form1.Label5.Visible:=TRUE;
end;
// вывод вопроса на экран
Procedure VoprosToScr(var f:TextFile; frm:TForm1;var vopros:integer), var
i:integer; code:integer; s,buf:string;
ifn:string; // файл иллюстрации begin
vopros:=vopros+1 ;
str(vopros:3,s);
frm. caption: ='Вопрос' + s;
// выведем текст вопроса
buf: = ";
repeat
readln(f, s) ;
if (s[l] <> '.') and (s[l] <> '\')
then buf:=buf+s+' '; until (s[l] ='.'} or (s[l] = '\'); frm.Labels.caption:=buf;
if s[l] = '\'
then // к вопросу есть иллюстрация begin
frm.Image1.Tag:=1; ifn:=copy(s,2,length(s)); try
frm.Image1.Picture.LoadFromFile(ifn); except
on E:EFOpenError do
frm.tag:=0; end // try end else frm. Image1.Tag: =0;
// читаем варианты, ответов
for i:=1 to N_ANSWERS do begin
answer[i].caption:='';
answer[i].Width:=frm.ClientWidth-Form1.Label5.Left-5; end; i:=l; repeat
buf: = " ;
repeat // читаем текст варианта ответа readln(f,s); if (s[l]<>'.') and (s[1] <> ',')
then buf:=buf+s+' '; until (s[1]=',')or(s[l]='.');
// прочитан альтернативный ответ
val (s[2],score[i],code);
answer[i].caption:=buf;
i:=i+l;
until s [1] = '.'; // здесь прочитана иллюстрация и альтернативные ответы
if Form1.Image1.Tag =1 // есть иллюстрация к вопросу? then begin ScalePicture;
Forml.Image1.Visible:=TRUE; end;
// вывод альтернативных ответов
i:=1;
while (answer[i].caption <> ") and (i <= N_ANSWERS) do
begin
if i = 1 then
if frm.Image1.Tag =1
then answer[1].top:=frm.Image1.Top+frm.Image1.Height+5 else answer[i].top:=frm.Label5.Top+frm.Label5.Height+5 else
answer [i] . top:=answer [i-1] . top+ answer [i-1] . height+5; selector[i] . top:=answer [i] . top; selectorfi] ,visible:=TRUE; answer [i] . visible : =TRUE; i:=i+l; end; end;
{$R *.DFM}
procedure TForml . FormActivate ( Sender : TOb j ect ) ; begin
ResetForm ( Forml ) ; if ParamCount = 0 then begin
Label3 . font . color : =clRed;
Label5. caption: = 'He задан файл вопросов теста.1; Buttonl . caption : = ' Ok ' ; Buttonl.tag:=2; Buttonl . Enabled : =TRUE end else begin
fn:=ParamStr (1) ; assignf ile ( f , fn) ; {$!-} reset (f) ;
if IOResult=0 then begin
Inf <> (f, Label3) ; GetLevel(f) ; end;
summa:=0; end; end;
procedure TForm1. ButtonlClick (Sender: TObject) begin
case Button1.tag of 0: begin
Button1.caption:='Дальше'; Buttonl.tag:=1;
Selector[N_ANSWERS+1].Checked:=TRUE; // вывод первого вопроса Buttonl.Enabled:=False; ResetForm(Forml); VoprosToScr(f,Forml,vopros) end;
1: begin // вывод остальных вопросов summa:=summa+score[otv]; Selector[N_ANSWERS+1].Checked:=TRUE; Button1.Enabled:=False; ResetForm(Form1); if not eof(f)
then VoprosToScr(f,Forml,vopros) else
begin
closefile(f); Button1.caption:='Ok'; Forml.сарtiоn:='Результат'; Buttonl.tag:=2; Buttonl.Enabled:=TRUE; Itog(summa,Form1); end; end; 2: begin // завершение работы
Form1.Close; end; end; end;
// щелчок на кнопке выбора ответа
procedure TForml.SelectorClick(Sender: TObject);
var
i: integer;
begin
while selector[i].Checked = FALSE do
i:=i+l; otv:=i;
Buttonl.enabled:=TRUE; end;
end.
По сравнению с первым вариантом программа Тест, версия 2 обладает существенным преимуществом. Для ее модернизации, например для увеличения количества альтернативных ответов, достаточно изменить только описание именованной константы N_ANSWERS.