Листинг 15.2. Программа тестирования, версия 2
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.
По сравнению с первым вариантом программа Тест, версия 2 обладает существенным преимуществом. Для ее модернизации, например для увеличения количества альтернативных ответов, достаточно изменить только описание именованной константы N_ANSWERS.
|