unit
umain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons;
type
TFmain =
class
(TForm)
Panel1: TPanel;
STFIO: TStaticText;
STWelkome: TStaticText;
STDATE: TStaticText;
STTIME: TStaticText;
TSmain: TPageControl;
TabSheet1: TTabSheet;
TSTEst: TTabSheet;
TSResult: TTabSheet;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
StaticText1: TStaticText;
StaticText2: TStaticText;
BitBtn1: TBitBtn;
Memo1: TMemo;
Panel2: TPanel;
TrackBar1: TTrackBar;
StaticText3: TStaticText;
Panel3: TPanel;
StaticText4: TStaticText;
STQutest: TStaticText;
STtimetest: TStaticText;
Label3: TLabel;
Label4: TLabel;
BBStarttest: TBitBtn;
Panel4: TPanel;
Memo2: TMemo;
BByes: TBitBtn;
BBno: TBitBtn;
Leotv: TLabeledEdit;
timer2: TTimer;
BBnext: TBitBtn;
Stdatetest: TStaticText;
Sttimetest2: TStaticText;
stStud: TStaticText;
eresexTR: TEdit;
Edit2: TEdit;
eresneIR: TEdit;
eRES: TEdit;
eTEMP: TEdit;
BBres: TBitBtn;
vl: TEdit;
procedure
formShow(Sender: TObject);
procedure
ontimer(Sender: TObject);
procedure
BitBtn1Click(Sender: TObject);
procedure
BBStarttestClick(Sender: TObject);
procedure
timer2Timer(Sender: TObject);
procedure
BBnextClick(Sender: TObject);
procedure
BByesClick(Sender: TObject);
procedure
BBnoClick(Sender: TObject);
procedure
BBresClick(Sender: TObject);
private
public
end
;
procedure
sumbal1(num1:
word
);
procedure
sumbal0(num0:
word
);
var
Fmain: TFmain;
Vtime:
string
;
Votv:
word
;
arotv:
array
[
0..59
]
of
integer
;
i:
real
;
f,txt:textfile;
fPath:
string
;
vres:
integer
;
Vnevrotizm,Vextr,Vextravert,Vneir,vl,Vtemperament:
string
;
implementation
uses
Ulogin;
{$R *.dfm}
<font color="Black"><b>
procedure
sumbal1(num1:
word
);</b></font>
begin
if
arotv[num1] =
1
then
vres:=vres+
1
;
end
;
procedure
sumbal0(num0:
word
);
begin
if
arotv[num0] =
0
then
vres:=vres+
1
;
end
;
<b><font color="Black">
procedure
sumbal1(num1:
word
);</font></b>
begin
if
arotv [num1] =
1
then
vres:=vres+
1
;
end
;
procedure
TFmain
.
BBnextClick(Sender: TObject);
begin
if
leotv=
'да'
then
arotv[i]:=
0
;
I:=i+
1
;
end
;
procedure
TFmain
.
BBnoClick(Sender: TObject);
begin
Leotv
.
Text:=
'нет'
;
votv:=
1
;
end
;
procedure
TFmain
.
BBresClick(Sender: TObject);
begin
Vres:=
0
;
sumbal1(
1
);
sumbal1(
3
);
sumbal1(
9
);
sumbal1(
11
);
sumbal1(
14
);
sumbal1(
17
);
sumbal1(
19
);
sumbal1(
22
);
sumbal1(
23
);
sumbal1(
25
);
sumbal1(
27
);
sumbal1(
30
);
sumbal1(
35
);
sumbal1(
38
);
sumbal1(
41
);
sumbal1(
43
);
sumbal1(
46
);
sumbal1(
49
);
sumbal1(
53
);
sumbal1(
57
);
sumbal1(
6
);
sumbal1(
33
);
sumbal1(
51
);
sumbal1(
55
);
sumbal1(
59
);
Vextr:=vres;
Vres:=
0
;
sumbal1(
2
);
sumbal1(
5
);
sumbal1(
7
);
sumbal1(
10
);
sumbal1(
13
);
sumbal1(
15
);
sumbal1(
18
);
sumbal1(
21
);
sumbal1(
23
);
sumbal1(
26
);
sumbal1(
29
);
sumbal1(
31
);
sumbal1(
34
);
sumbal1(
37
);
sumbal1(
39
);
sumbal1(
42
);
sumbal1(
45
);
sumbal1(
50
);
sumbal1(
54
);
sumbal1(
58
);
sumbal1(
60
);
vneir:=vres;
Vres:=
0
;
sumbal1(
8
);
sumbal1(
16
);
sumbal1(
24
);
sumbal1(
28
);
sumbal1(
36
);
sumbal1(
44
);
sumbal1(
4
);
sumbal1(
12
);
sumbal1(
20
);
sumbal1(
32
);
sumbal1(
40
);
sumbal1(
48
);
sumbal1(
35
);
Vres:=
0
;
sumbal1(
8
);
sumbal1(
16
);
sumbal1(
24
);
sumbal1(
28
);
sumbal1(
36
);
sumbal1(
44
);
sumbal1(
4
);
sumbal1(
12
);
sumbal1(
20
);
sumbal1(
32
);
sumbal1(
40
);
sumbal1(
48
);
vres:=vl;
if
(Vneir<=
10
)
and
(Vneir>=
0
)
then
Vnevrotizm:=
'эмоциональная устуйчивость'
;
if
(Vneir<=
20
)
and
(Vneir>=
11
)
then
Vnevrotizm:=
'Эмоциональная впечатлительность'
;
if
vneir>
20
then
Vnevrotizm:=
'невротизм'
;
if
(Vneir<=
10
)
and
(Vextr>=
0
)
then
Vextravert:=
'интроверт'
;
if
vextr>
10
then
Vextravert:=
'невротизм'
;
if
(Vextr<=
10
)
and
(Vneir>=
10
)
then
Vtemperament:=
'Меланхолик'
;
if
(Vextr<=
10
)
and
(Vneir>=
10
)
then
Vtemperament:=
'Флегматик'
;
if
(Vextr<=
10
)
and
(Vneir>=
10
)
then
Vtemperament:=
'Холерик'
;
if
(Vextr<=
10
)
and
(Vneir>=
10
)
then
Vtemperament:=
'Сангвиник'
;
ststud
.
caption:=
'студент'
+ flogin
.
Leuser
.
text;
stdatetest
.
caption:=
'дата тестирования'
+sttimetest
.
caption;
eresextr
.
Text:=inttostr(vextr);
eresneir
.
Text:=inttostr (vneir);
vl
.
Text:=inttostr(vl);
etemp
.
Text:=inttostr(etemp);
tsMain
.
ActivePage:=TSResult;
end
;
procedure
TFmain
.
BBStarttestClick(Sender: TObject);
begin
Vtime:=timetostr(time);
timer2
.
Enabled:=
true
;
fpath:=flogin
.
lefile
.
text;
assignfile(f,fpath);
reset(f);
Readln(f,txt);
memo1
.
Text:=txt;
BBstarttest
.
Enabled:=
true
;
end
;
procedure
TFmain
.
formShow(Sender: TObject);
begin
stdate
.
Caption:=datetostr(date);
end
;
procedure
TFmain
.
ontimer(Sender: TObject);
begin
sttime
.
Caption:=timetostr(time);
end
;
procedure
TFmain
.
timer2Timer(Sender: TObject);
begin
Sttimetest
.
caption:=timetostr (time-strtotime(vtime));
end
;
procedure
TFmain
.
BByesClick(Sender: TObject);
begin
Leotv
.
Text:=
'да'
;
votv:=
1
;
end
;
end
.