Текст программы. После создания формы в окно редактора кода, в секцию implementation следует поместить описание глобальных констант (раздел const) и переменных (раздел var)

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