Приложение 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.ItemIndex0 then if ComboSex.ItemIndex1 then begin messagedlg('Введите пол',mterror,[mbok],0); error:=true; end else error:=false; if ComboAge.ItemIndex0 then if ComboAge.ItemIndex1 then if ComboAge.ItemIndex2 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