ExpertPsyhologyПсихологические исследования

FULLTIME = 180;

DeadLine= 'У вас осталось ';

var

Form2: TForm2;

BegTime,CurTime: TDateTime;

TimeLeft,Cnt: integer;

QFile:TextFile;

AFile:File of integer;

CorrectA:Array[1 N] of integer;

CorrectNum:integer;

Quest:string;

implementation

uses Unit1;

{$R *.DFM}

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

begin

CloseFile(QFile);

Form1.Close;

end;

procedure TForm2.FormActivate(Sender: TObject);

Var

SS,TT,First:string;

i,w :integer;

begin

ShowMessage('Подберите к нижней паре слов наиболее'+#13+

'подходящую по аналогии отношения'+#13+

'пару сверху и введите ее номер.');

BegTime:=Time;

AssignFile(QFile,'Test1.txt');

reset(QFile);

Readln(QFile,First);

Panel1.Caption:=First;

AssignFile(AFile,'Answers1.dat');

reset(AFile);

for i:=1 to N do

begin

read(AFile,w);

CorrectA[i]:=w;

end;

CloseFile(AFile);

Cnt:=1;

CorrectNum:=0;

CurTime:=Time;

Timeleft:=round(Frac(CurTime-BegTime)*24*3600)+FULLTIME;

Str(TimeLeft,SS);

Str(Cnt,TT);

StatusBar1.SimpleText:='Вопрос № '+TT+'. '+ DeadLine+SS+' секунд';

end;

procedure TForm2.BitBtn1Click(Sender: TObject);

procedure TheEnd;

var

SSS,Mark:String;

RFile: TextFile;

begin

Str(CorrectNum,SSS);

if CorrectNum<5 then Mark:='Результат ниже нормы'

else Mark:='Результат в пределах нормы';

ShowMessage('Тестирование окончено.'+CHR(13)+'Правильных ответов - '+SSS);

AssignFile(RFile,'results1.txt');

if FileExists('results1.txt') then Append(RFile)

else Rewrite(RFile);

writeln(RFile,'Тестирyемый '+CName);

writeln(RFile,'Правильных ответов:'+SSS+' из '+NS);

writeln(RFile,Mark);

writeln(RFile,'--------------------------------');

CloseFile(RFile);

CloseFile(QFile);

Form1.Close;

end;

var

tmpi,code:integer;

tmps,SS,TT:string;

begin

CurTime:=Time;

Timeleft:=round(Frac(BegTime-CurTime)*24*3600)+FULLTIME;

Str(TimeLeft,SS);

Str(Cnt+1,TT);

StatusBar1.SimpleText:='Вопрос № '+TT+'. '+ DeadLine+SS+' секунд';

tmps:=Edit1.Text;

val(Tmps,Tmpi,code);

if Tmpi=CorrectA[Cnt] then CorrectNum:=CorrectNum+1;

Cnt:=Cnt+1;

if (Cnt>N) or (Timeleft<=0) then TheEnd

else begin

Edit1.Text:='';

Readln(QFile,Quest);

Panel1.Caption:=Quest;

Edit1.SetFocus;

end;

end;

end.

Методика “Мейли”

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ComCtrls, ExtCtrls;

type

TForm2 = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Edit1: TEdit;

StatusBar1: TStatusBar;

BitBtn1: TBitBtn;

Memo1: TMemo;

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

procedure FormActivate(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

N = 20;

NS='20';

FULLTIME = 600;

DeadLine= 'У вас осталось ';

var

Form2: TForm2;

BegTime,CurTime: TDateTime;

TimeLeft,Cnt: integer;

QFile:TextFile;

AFile:File of integer;

CorrectA:Array[1 N] of integer;

CorrectNum:integer;

Quest:string;

implementation

uses Unit1;

{$R *.DFM}

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

begin

CloseFile(QFile);

Form1.Close;

end;

procedure TForm2.FormActivate(Sender: TObject);

Var

SS,TT,First:string;

i,w :integer;

begin

BegTime:=Time;

AssignFile(QFile,'Test2.txt');

reset(QFile);

Readln(QFile,First);

Panel1.Caption:=First;

AssignFile(AFile,'Answers2.dat');

reset(AFile);

for i:=1 to N do

begin

read(AFile,w);

CorrectA[i]:=w;

end;

CloseFile(AFile);

Cnt:=1;

CorrectNum:=0;

CurTime:=Time;

Timeleft:=round(Frac(CurTime-BegTime)*24*3600)+FULLTIME;

Str(TimeLeft,SS);

Str(Cnt,TT);

StatusBar1.SimpleText:='Вопрос № '+TT+'. '+ DeadLine+SS+' секунд';

end;

procedure TForm2.BitBtn1Click(Sender: TObject);

procedure TheEnd;

var

SSS,Mark:String;

RFile: TextFile;

begin

Str(CorrectNum,SSS);

Mark:='неудовлетворительно';

if CorrectNum>9 then Mark:='удовлетворительно';

if CorrectNum>14 then Mark:='хорошо';

if CorrectNum>17 then Mark:='отлично';

ShowMessage('Тестирование окончено.'+CHR(13)+'Правильных ответов - '+SSS);

AssignFile(RFile,'results2.txt');

if FileExists('results2.txt') then Append(RFile)

else Rewrite(RFile);

writeln(RFile,'Тестируемый: '+CName);

writeln(RFile,'Правильных ответов:'+SSS+' из '+NS);

writeln(RFile,'Оценка: '+Mark);

Программа психологической коррекции эмоциональной сферы больных алкоголизмом
Для преодоления созависимости применяется программа, включающая в себя: образование по вопросам зависимости и созависимости, семейная система, индивидуальная и групповая психотерапия, семейная психотерапия, супружеская терапия, а также подкрепление в виде посещения групп самопомощи типа Ал-Анон, чтение литературы по соответствующей проб ...

Методы преодоления конфликтов
Исследования показали, что любой конфликт может быть быстро разрешен, если известны соответствующие методы. Но при этом обязательно должны быть рассмотреть характеристики конфликта: цели, мотивы, эмоциональные состояния оппонентов, особенности развития противоборства и др. В психологических исследованиях определены принципы, которыми сл ...

Корыстно-частнособственнические. Мотивация: материальная выгода. Семейный тип.
Общие черты: - обычно трудолюбивы и исполнительны; - высокий уровень мотивации повышения материального благосостояния; - совершение преступления не для себя, а для поддержания необходимого, по мнению близких, материального уровня (отсюда нередко – аскетизм по отношению к себе). ...