Создание теста в Delphi

Приложение

unit fmain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,

Forms,

Dialogs, StdCtrls;

type

TFormmain = class(TForm)

Edit1: TEdit;

StaticText1: TStaticText;

Edit2: TEdit;

StaticText2: TStaticText;

ComboSex: TComboBox;

StaticText3: TStaticText;

StaticText4: TStaticText;

ComboAge: TComboBox;

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Formmain: TFormmain;

implementation

uses ftest;

{$R *.dfm}

procedure TFormmain.Button1Click(Sender: TObject);

var error:Boolean;

begin

nomer:=0;

if edit1.Text='' then

begin messagedlg('Введите фамилию',mterror,[mbok],0);

error:=true; end else error:=false;

if edit2.Text='' then

begin messagedlg('Введите имя',mterror,[mbok],0);

error:=true; end else error:=false;

if ComboSex.ItemIndex<>0 then

if ComboSex.ItemIndex<>1 then

begin messagedlg('Введите

пол',mterror,[mbok],0);

error:=true; end else

error:=false;

if ComboAge.ItemIndex<>0 then

if ComboAge.ItemIndex<>1 then

if ComboAge.ItemIndex<>2 then

begin messagedlg('Введите

возраст',mterror,[mbok],0);

error:=true; end else

error:=false;

if error=false then begin

Formmain.hide;

formtest.Show;

end;

end;

procedure TFormmain.Button2Click(Sender: TObject);

begin

close;

end;

procedure TFormmain.FormCloseQuery(Sender: TObject; var CanClose:

Boolean);

begin

if messagedlg('Вы действительно хотите

выйти?',mtcustom,[mbyes,mbno],0)=mrno then

canclose:=false;

end;

end.

unit ftest;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,

Forms,

Dialogs, ExtCtrls, StdCtrls, Spin, ComCtrls;

type

TFormTest = class(TForm)

buttonnext: TButton;

Memo1: TMemo;

RadioGroup1: TRadioGroup;

Label1: TLabel;

Label3: TLabel;

BFinish: TButton;

procedure buttonnextClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure buttonPreviosClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure BFinishClick(Sender: TObject);

procedure FormHide(Sender: TObject);

procedure FormDblClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FormTest: TFormTest;

nomer:Byte; {номер вопроса}

a,b,c,d,e,f,g,h,i,l,m,n,o,q1,q2,q3,q4:byte;{Факторы}

aa,bb,cc,dd,ee,ff,gg,hh,ii,ll,mm,nn,oo,qq1,qq2,qq34:byte;{Стены}

implementation

uses fmain;

{$R *.dfm}

{Очистка формы}

procedure clear;

begin

FormTest.Memo1.Lines.Clear;

FormTest.RadioGroup1.Items.Clear;

end;

procedure pballov;

begin

if nomer=3 then

begin

case FormTest.RadioGroup1.ItemIndex of

0:begin Aa:=aa+2;bb:=bb+2;end;

1:begin aa:=aa+1;bb:=bb+1;end;

2:begin aa:=aa+2;bb:=bb+2;end;

end;

end;

case nomer of

{AA} 27,52,76,101,126,151,176:begin

case FormTest.RadioGroup1.ItemIndex of

0:Aa:=aa+2;

1:aa:=aa+1;

2:aa:=aa+2;

end;

end;

{BB} 28,54,78,103,128,153,178:begin

case FormTest.RadioGroup1.ItemIndex of

0:bb:=bb+2;

1:bb:=bb+1;

2:bb:=bb+2;

end;

end;

...

{QQ3 и QQ4} 24,48,73,98,123,148,173:begin

case FormTest.RadioGroup1.ItemIndex of

0:qq34:=qq34+2;

1:qq34:=qq34+1;

2:qq34:=qq34+2;

end;

end;

end;

FormTest.RadioGroup1.ItemIndex:=-1;

end;

{Подсчёт вывод и сохранение результата }

procedure whoru;

begin

clear;

{подсчёт всех факторов}

case formmain.ComboAge.ItemIndex of{от 16 до 18 лет}

0:begin

if formmain.ComboSex.ItemIndex=0 then {Ж.}

begin

case aa of

0..6:a:=1;

7..8:a:=3;

9..10:a:=4;

11:a:=5;

12..13:a:=6;

14..15:a:=7;

16:a:=8;

17..18:a:=9;

19..20:a:=10;

end;

case bb of

0..1:b:=1;

8,9:b:=8;

11,12:b:=10;

else b:=bb;

end;

…

end;

end;

end;

end;

{Отображение результата}

case a of {Фактор А}

1..5:begin

FormTest.Memo1.Lines.Add('"Шизотермия"');

…

end;

end;

end;

{добавление вопросов в Memo}

procedure addtest;

begin

if nomer=1 then

begin

nomer:=nomer+1;

clear;

FormTest.memo1.Lines.Add('1. Я хорошо понял инструкцию,

которую только что прочитал:');

FormTest.RadioGroup1.Items.Add('а) Да;');

FormTest.RadioGroup1.Items.Add('в) не уверен;');

FormTest.RadioGroup1.Items.Add('с) нет.');

end

else

begin

if nomer<188 then

if FormTest.RadioGroup1.ItemIndex=-1 then

messagedlg('Не пропускайте ничего, обязательно

отвечайте на все вопросы подряд',mtinformation,[mbok],0)

else

begin

case nomer-1

of

3..186:pballov;

end;

clear;

{Вопросы}

case nomer of

1:begin

FormTest.memo1.Lines.Add('1. Я хорошо понял инструкцию,

которую только что прочитал:');

FormTest.RadioGroup1.Items.Add('а) Да;');

FormTest.RadioGroup1.Items.Add('в) не уверен;');

FormTest.RadioGroup1.Items.Add('с) нет.');

end;

2:begin

…

188:begin

whoru;

end;

end;

if nomer<189 then nomer:=nomer+1;

end;

end;

end;

procedure TFormTest.buttonnextClick(Sender: TObject);

begin

if nomer=0 then

begin

nomer:=nomer+1;

memo1.ScrollBars:=ssNone;

end;

if nomer=1 then

begin

RadioGroup1.Visible:=true;

label1.Visible:=false;

label3.Visible:=true;

end

else

if nomer=188 then

begin

radiogroup1.Visible:=false;

memo1.ScrollBars:=ssVertical;

buttonnext.Caption:='Завершить';

buttonnext.Visible:=false;

BFinish.Visible:=true;

Label1.Visible:=false;

Label3.Visible:=false;

end;

addtest;

{if n>0 then

begin

case n of

3:pballov;

end;

end;}

end;

procedure TFormTest.FormCreate(Sender: TObject);

begin

nomer:=0;

end;

procedure TFormTest.buttonPreviosClick(Sender: TObject);

begin

nomer:=nomer-1;

addtest;

end;

procedure TFormTest.FormClose(Sender: TObject; var Action:

TCloseAction);

begin

Formmain.Edit1.Clear;

Formmain.Edit2.Clear;

Formmain.ComboSex.ItemIndex:=-1;

Formmain.ComboAge.ItemIndex:=-1;

formmain.Show;

end;

procedure TFormTest.FormCloseQuery(Sender: TObject; var CanClose:

Boolean);

begin

if nomer<188 then

if messagedlg('Прекратить тестирование?',mtcustom,[mbyes,mbno],0)=mrno

then

canclose:=false;

end;

procedure TFormTest.BFinishClick(Sender: TObject);

begin

close;

end;

procedure TFormTest.FormHide(Sender: TObject);

begin

memo1.Lines.LoadFromFile('memo\main.txt');

RadioGroup1.Visible:=false;

end;

end.