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);

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

Межличностные отношения и уверенность в семье
В первую очередь хотелось поднять вопрос о конфликтах и отношениях между поколениями. Ведь большая семья - это и взаимосвязь с родственниками. Как вы строите отношениями с членами вашей прежней семьи? Да и строите ли как-нибудь? Интересно, что современное сейчас сожительство считается разрушительным для крепких межпоколенных отношений. ...

Приложения
Приложение 1. Психокоррекционная программа Цель: Коррекция девиантного агрессивного поведения подростков. Программа рассчитана в среднем на 6 занятий, продолжительность занятий от 1 часа, в зависимости от темпа работы группы. Размер группы - от 5 до 15 человек. Занятия формируются из подобранных упражнений с учетом рекомендаций к ним ...