После создания формы в окно редактора кода, в секцию 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);