Усовершенствование программы

answer: array[1..N_ANSWERS] of TLabel; 
 
// альтернативные ответы selector:
 
array[1..N_ANSWERS+1] of TRadioButton; 
 
// кнопки выбора ответа

answer[1] := TLabel.Create(self) ;
answer[1].Parent := Form1;

unit test2_;
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.