Текст программы
После создания формы в окно редактора кода, в секцию implementation следует поместить описание глобальных констант (раздел const) и переменных (раздел var). Затем можно приступить к созданию процедур обработки событий.
Их в программе три: обработка события onActivate для стартовой формы, обработка события Onclick для командной кнопки Buttoni и процедура обработки события onclick — одна, общая для переключателей выбора ответа.
В листинге 15.1 приведен полный текст программы.
Листинг 15.1. Программа тестирования
unit test1_;
interface
uses
SysUtils, WinTypes, WinProcs, Messages,
Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm) // вопрос
Label3: TLabel; // альтернативные ответы
Label1: TLabel; Label2: TLabel;
Label3: TLabel; Label4: TLabel;
// переключатели выбора ответа
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
Image1: TImage; // область вывода иллюстрации
Button1: TButton; // кнопка Ok, Дальше
RadioButtonS: TRadioButton; // "служебная" кнопка
Panel1: ТPanel;
procedure FormActivate(Sender: TObject);
procedure ButtonlClick(Sender: TObject};
procedure RadioButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; // форма
implementation
const
N_LEV=4; // четыре уровня оценки
N_ANS=4; // четыре варианта ответов
var
f:TextFile;
fn:string; // имя файла вопросов
1evel:array[1..N_LEV] of integer;
// сумма, соответствующая уровню
mes:array[1.,N_LEV] of string;
// сообщение, соответствующее уровню
score:array[1..N_ANS] of integer;
// балл за выбор ответа
summa:integer; // набрано очков
vopros:integer; // номер текущего вопроса
n_otv:integer; // число вариантов ответа
otv:integer; // номер выбранного ответа
// вывод начальной информации о тесте
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] ='.'; l.caption:=buf;
end;
// прочитать информацию об оценках за тест
Procedure GetLevel(var f:TextFile);
var
i:integer; buf:string;
begin // заполняем значения глобальных массивов
i:=l;
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 ScaleImage(Imagel:TImage);
var
w,h:integer; // максимально допустимые размеры картинки
scaleX:real; // коэф. масштабирования по X
scaleY:real; // коэф. масштабирования по Y
scale:real; // общий коэф. масштабирования
begin
// вычислить максимально допустимые размеры картинки
w:=Form1.ClientWidth-10;
h:=Form1.ClientHeight
- Form1.Panel1.Height -5
- Form1.Label5.Top
- Form1.Label5.Height - 5;
if Form1.Label1.Caption <> ''
then h:=h-Form1.Label1.Height-5;
if Form1.Label2.Caption <> ''
then h:=h-Form1.Label2.Height-5;
if Forml.Label3.Caption <> ''
then h:=h-Form1.Label3.Height-5;
if Forml.Label4.Caption <> "
then h:=h-Form1.Label4.Height-5; // определить масштаб
if w>Imagel.Picture.Bitmap.Width
then scaleX:=l
else scaleX:=w/Imagel.Picture.Bitmap.Width;
if h>Imagel.Picture.Bitmap.Height
then scaleY:=l
else scaleY:=h/Image1.Picture.Bitmap.Height;
if ScaleY<ScaleX
then scale:=scaleY
else scale:=scaleX; // здесь масштаб определен
Image1.Top:=Form1.Label5.Top+Form1.Labels.Height+5 ;
Image1.Width:=Round(Image1.Picture.Bitmap.Width* scale);
Image1.Height:=Round(Image1.Picture.Bitmap.Height* scale);
end;
// вывод вопроса на экран
Procedure VoprosToScr(var f:TextFile;frm:TForm1;var vopros:integer)
var
i:integer;
code:integer;
s,buf:string;
ifn:string; // файл иллюстрации
begin
vopros:=vopros+l ;
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[1] <> '\'
then Form1.Image1.Tag:=0 else
// к вопросу есть иллюстрация
begin
Form1.Image1.Tag:=1;
if n:=copy(s,2,length(s));
try
Form1.Image1.Picture.LoadFromFile(ifn)
except
on E:EFOpenError do
frm.tag:=0; end; // try end;
// читаем варианты ответов
i:=l;
repeat
buf: = ";
repeat // читаем текст варианта ответа
readln(f,s);
if (s[1]<>'. ') and (s[l] о ', ')
then buf:=buf+s+' ';
until (s[l]=',')or(s[1]='.'); // прочитан альтернативный ответ
val(s[2],score[i],code);
case i of
1: frm.Label1.caption:=buf;
2: frm.Label2.caption:=buf;
3: frm.Label3.caption:=buf;
4: frm.Label4.caption:=buf;
end;
until s[l]='.';
// здесь прочитана иллюстрация и альтернативные ответы
// текст вопроса уже выведен
if Forml.Image1.Tag =1 // есть иллюстрация к вопросу then
begin
Scalelmage(Form1.Image1); Form1.Image1.Visible:=TRUE;
end;
// вывод альтернативных ответов
if Form1.Label1.Caption <> " then begin
if Forml.Image1.Tag =1
then
frm.Label1.top:=frm.Imagel.Top+frm.Image1.Height+5
else
frm.Label1.top:=frm.Label5.Top+frm.Labels.Height+5 ;
frm.RadioButton1.top:=frm.Label1.top;
frm.Labell.visible:=TRUE;
frm.RadioButton1.visible:=TRUE;
end;
if Forml.Label2.Caption <> " then begin
frm.Label2.top:=frm.Label1.top+ frm.Label1.height+5;
frm.RadioButton2.top:=frm.Label2.top;
frm.Label2.visible:=TRUE;
frm.RadioButton2.visible:=TRUE;
end;
if Forml.Label3.Caption <> '' then begin
frm.Label3.top:=frm.Label2.top+ frm.Label2.height+5;
frm.RadioButtonS.top:=frm.Label3.top;
frm.Label3.visible:=TRUE;
frm.RadioButtonS.visible:=TRUE;
end;
if Forml.Label4.Caption <> '' then begin
frm.Label4.top:=frm.Label3.top+ frm.Label3.height+5;
frm.RadioButton4. top:=frm.Label4.top;
frm.Label4.visible:=TRUE;
fm.Rad±o8utton4.vis:tble:=TRUE]
end;
end;
Procedure ResetForm(frm:TForml);
begin
// сделать невидимыми все метки и переключатели
frm.Label1.Visible:=FALSE;
f rm.Label1.caption: ='';
frm.Label1.width:=frm.ClientWidth-frm.Label1.left-5;
frm.RadioButtonl.Visible:=FALSE;
frm.Label2.Visible:=FALSE;
frm.Label2.caption:='';
frm.Label2.width:=frm.ClientWidth-frm.Label2.left-5;
frm.RadioButton2.Visible:=FALSE;
frm.Label3.Visible:=FALSE;
frm.Label3.caption:='';
frm.Label3.width:=frm.ClientWidth-frm.Label3.left-5;
frm.RadioButton3.Visible:=FALSE;
frm.Label4.Visible:=FALSE;
frm.Label4.caption:='';
frm.Label4.width:=frm.ClientWidth-frm.Label4.left-5;
f rm.RadioButton4.Visible:=FALSE;
frm.Label5.width:=frm.ClientWidth-frm.Labels.left-5;
frm. Image1.Visible:=FALSE;
end;
// определение достигнутого уровня
procedure Itog(summa:integer;frmrTForml);
var
i:integer; buf:string;
begin
buf: = ";
str(summa:5,buf);
buf:='Результаты тестирования'+chr(13)
+'Всего баллов: '+buf; i:=1;
while (summa < level[i]) and (i<N_LEV) do
i:=i+l;
buf:=buf+chr(13)+mes[ i ] ; frm.Labels.caption:=buf;
end;
{$R *.DFM}
procedure TForm1.FormActivate(Sender: TObject);
begin
ResetForm(Form1);
if ParamCount = 0 then
begin
Labels.caption:= 'He задан файл вопросов теста.';
Button1.caption: ='Ok' ;
Button1.tag:=2; Button1.Enabled:=TRUE
end
else begin
fn := ParamStr(1); assignfile(f,fn); {$I-} reset(f);
{I+}
if IOResult=0 then begin
Info(f,Label5);
// прочитать и вывести информацию о тесте
GetLevel(f); // прочитать информацию об уровнях оценок
end;
end;
end;
procedure TForml.ButtonlClick(Sender: TObject); begin
case Button1.tag of 0: begin
Buttonl.caption:='Дальше';
Buttonl.tag:=1;
RadioButtonS.Checked:=TRUE; // вывод первого вопроса
Buttonl.Enabled:=False; ResetForm(Form1);
VoprosToScr(f,Forml,vopros}
end;
1: begin // вывод остальных вопросов
summa:=summa+score[otv];
RadioButtonS.Checked:=TRUE;
Button1.Enabled:=False;
ResetForm(Form1);
if not eof(f)
then VoprosToScr(f,Forml,vopros) else
begin
suima: =summa+score [otv] ;
closefile(f);
Buttonl.caption:='Ok';
Form1.caption: ='Результат';
Button1.tag:=2;
Button1.Enabled:=TRUE;
Itog(summa,Forml);
end;
end;
2: begin // завершение работы
Forml.Close;
end;
end;
end;
procedure TForm1.RadioButtonClick(Sender: TObject);
begin
if sender = RadioButtonl
then otv:=l
else if sender = RadioButtonl
then otv:=2
else if sender = RadioButton3
then otv:=3 else otv:=4;
Buttonl.enabled:=TRUE;
end;
end.
|