Отладка программы в Delphi


              

Программа тестирования версия 2



Листинг 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.



Содержание  Назад  Вперед