Скачиваний:
42
Добавлен:
03.02.2019
Размер:
70.66 Кб
Скачать

УИТС.161ХХХ.020

Лист

Изм.

Лист

№ докум.

Подп.

Дата

Копировал Формат А4

ПРИЛОЖЕНИЕ А

ЛИСТИНГ ТЕСТИРУЮЩЕЙ ПРОГРАММЫ

unit in_test;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,

Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

const

N_LEV=4; {4 уровня оценки}

N_ANS=4; {4 варианта ответов}

type

TForm1 = class(TForm)

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

RadioButton3: TRadioButton;

RadioButton4: TRadioButton;

// альтернативные ответы

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

// вопрос

Label5: TLabel;

Panel1: TPanel;

Button1: TButton;

RadioButton5: TRadioButton;

procedure FormActivate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure RadioButton1Click(Sender: TObject);

procedure RadioButton2Click(Sender: TObject);

procedure RadioButton3Click(Sender: TObject);

procedure RadioButton4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1; // форма

f:TextFile;

fi:TextFile; // файл отчета

fn:string;{имя файла вопросов}

level: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; {номер выбранного ответа}

implementation

{вывод начальной информации о тесте}

procedure info(var f:TextFile;l:TLabel);

var

s,buf: string;

begin

buf:='';

repeat

readln(f,s);

if s[1] <> '.'

then buf:=buf+s+'';

until s[1] ='.';

l.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='.';

end;

// вывод вопроса на экран

procedure VoprosToScr (var f:TextFile;frm:TForm1; var vopros:integer);

var

i:integer;

code:integer;

s,buf:string;

begin

vopros:=vopros+1;

str(vopros:3,s);

frm.caption:='Вопрос'+ s;

{выведем текст вопроса}

buf:='';

repeat

readln(f,s);

if (s[1] <> '.')

then buf:=buf+s+' ';

until (s[1] ='.')

frm.Label5.caption:=buf;

// читаем варианты ответов

i:=1;

repeat

buf:='';

repeat // читаем текст варианта ответа

readln(f,s);

if (s[1]<>'.') and (s[1] <> ',')

then buf:=buf+s+' ';

until (s[1]=',') 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;

i:=i+1;

until s[1]='.';

// вывод альтернативеых ответов

if Form1.Label1.Caption <> ''

then begin

frm.Label1.top:=frm.Label5.Top+frm.Label5.Height+5;

frm.RadioButton1.top:=frm.Label1.Top;

frm.Label1.visible:=TRUE;

frm.RadioButton1.visible:=TRUE;

end;

if Form1.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 Form1.Label3.Caption <> ''

then begin

frm.Label3.top:=frm.Label2.Top+ frm.Label2.Height+5;

frm.RadioButton3.top:=frm.Label3.Top;

frm.Label3.visible:=TRUE;

frm.RadioButton3.visible:=TRUE;

end;

if Form1.Label4.Caption <> ''

then begin

frm.Label4.top:=frm.Label3.Top+ frm.Label3.Height+5;

frm.RadioButton4.top:=frm.Label4.Top;

frm.Label4.visible:=TRUE;

frm.RadioButton4.visible:=TRUE;

end;

end;

procedure ResetForm(frm:TForm1);

begin // сделать невидимыми все метки и радиокнопкт

frm.Label1.visible:=FALSE;

frm.Label1.caption:='';

frm.Label1.Width:=frm.ClientWidth-frm.Label1.Left-5;

frm.RadioButton1.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;

frm.RadioButton4.Visible:=FALSE;

frm.Label5.Width:=frm.ClientWidth-frm.Label5.Left-5;

end;

// определение достигнутого уровня

procedure Itog(summa: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_LEV) do

i:=i+1;

buf:=buf+chr(13)+mes[i];

frm.Label5.caption:=buf;

begin

AssignFile(fi,'log.dll');

{$I-}

Append(fi);

if IOResult <> 0

then

begin

Rewrite(fi);

if IOResult <> 0

then ShowMessage('Ошибка создания файла статистистики');

end;

end;

begin

writeln(fi,'Входной контроль ', summa, ' баллов');

CloseFile(fi);

end;

end;

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);

var

ParamS:string;

r: integer;

begin

ResetForm(Form1);

ParamS:=ParamStr(1);

randomize;

r:= Random(10);

If ParamCount = 0 then

if r=1 then ParamS:='in1.dll'

else

if r=2 then ParamS:='in2.dll'

else

if r=3 then ParamS:='in3.dll'

else

if r=4 then ParamS:='in4.dll'

else

if r=5 then ParamS:='in5.dll'

else

if r=6 then ParamS:='in6.dll'

else

if r=7 then ParamS:='in7.dll'

else

if r=8 then ParamS:='in8.dll'

else

if r=9 then ParamS:='in9.dll'

else

if r=10 then ParamS:='in10.dll'

else ParamS:='in0.dll';

begin

fn:=ParamS;

AssignFile(f,fn);

{$I-}

reset(f);

{I+}

if IOResult=0 then

begin

Info(f,Label5); // прочитать и вывести информацию о тесте

GetLevel(f); // прочитать информацию об уровнях оценок

end

else

begin

Label5.font.color:=clRed;

Label5.caption:='НЕТ ФАЙЛА ВОПРОСОВ ТЕСТА.';

Button1.caption:='OK';

Button1.tag:=2;

Button1.Enabled:=TRUE

end

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

case Button1.tag of

0: begin

Button1.caption:='Дальше';

Button1.tag:=1;

RadioButton5.Checked:=TRUE;

{Вывод первого ворпоса}

Button1.Enabled:=False;

ResetForm(Form1);

VoprosToScr(f,Form1,vopros)

end;

1: begin {Вывод остальных вопросов}

summa:=summa+score[otv];

score[otv]:=0;

RadioButton5.Checked:=True;

Button1.Enabled:=False;

ResetForm(Form1);

if not eof(f)

then VoprosToScr(f,Form1,vopros)

else

begin

summa:=summa+score[otv];

closefile(f);

Button1.caption:='OK';

Form1.caption:='Результат';

Button1.tag:=2;

Button1.enabled:=True;

Itog(summa,Form1);

end;

end;

2: begin {Завершение работы}

Form1.close;

end;

end; {case}

end;

procedure TForm1.RadioButton1Click(Sender: TObject);

begin

Button1.Enabled:=true;

otv:=1;

end;

procedure TForm1.RadioButton2Click(Sender: TObject);

begin

Button1.Enabled:=true;

otv:=2;

end;

procedure TForm1.RadioButton3Click(Sender: TObject);

begin

Button1.Enabled:=true;

otv:=3;

end;

procedure TForm1.RadioButton4Click(Sender: TObject);

begin

Button1.Enabled:=true;

otv:=4;

end;

end.

Соседние файлы в папке Специальные электрические машины с внедрением в учебный процесс