Текст опросника

1. Вам предстоит ординарная или деловая встреча. Выбивает ли Вас ее ожидание из колеи?

2. Вызывает ли у Вас смятение и неудовольствие поручение выступить с докладом, сообщением, информацией на каком-либо совещании, собрании или тому подобном мероприятии?

3. Не откладываете ли Вы визит к врачу до последнего момента?

4. Вам предлагают выехать в командировку в город, где Вы никогда не бывали. Приложите ли Вы максимум усилий, чтобы избежать этой командировки?

5. Любите ли Вы делиться своими переживаниями с кем бы то ни было?

6. Раздражаетесь ли Вы, если незнакомый человек на улице обратится к Вам с просьбой (показать дорогу, назвать время, ответить на какой-то вопрос)?

7. Верите ли Вы, что существует проблема "отцов и детей" и что людям разных поколений трудно понимать друг друга?

8. Постесняетесь ли Вы напомнить знакомому, что он забыл Вам вернуть деньги, которые занял несколько месяцев назад?

9. В ресторане либо в столовой Вам подали явно недоброкачественное блюдо. Промолчите ли Вы, лишь рассерженно отодвинув тарелку?

10. Оказавшись один на один с незнакомым человеком. Вы не вступите с ним в беседу и будете тяготиться, если первым заговорит он. Так ли это?

11. Вас приводит в ужас любая длинная очередь, где бы она ни была (в магазине, библиотеке, кассе кинотеатра). Предпочитаете ли Вы отказаться от своего намерения или встанете в хвост и будете томиться в ожидании?

12. Боитесь ли Вы участвовать в какой-либо комиссии по рассмотрению конфликтных ситуаций?

13. У Вас есть собственные сугубо индивидуальные критерии оценки произведений литературы, искусства, культуры и никаких чужих мнений на этот счет Вы не приемлете. Это так?

14. Услышав где-либо в кулуарах высказывание явно ошибочной точки зрения по хорошо известному Вам вопросу, предпочитаете ли Вы промолчать и не вступать в разговор?

15. Вызывает ли у Вас досаду чья-либо просьба помочь разобраться в том или ином служебном вопросе или учебной теме?

16. Охотнее ли Вы излагаете свою точку зрения (мнение, оценку) в письменной форме, чем в устной?

Приложение г Программный код компьютерной системы

unit uMain;

interface

uses // Подключаемые модули

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

Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,

dxSkinsCore, dxSkinBlack, dxSkinsForm, cxPC, dxSkinscxPCPainter,

dxSkinBlue, dxSkinSeven, dxSkinSilver, Menus, ImgList, StdCtrls,

cxButtons, ComCtrls, ToolWin, dxSkinsdxBarPainter, dxBar, cxClasses,

ExtCtrls, dxSkinMcSkin,

dxSkinsDefaultPainters, dxSkinsdxNavBar2Painter, dxNavBarBase, dxNavBarCollns, dxNavBar,

cxContainer, cxEdit, cxTextEdit, cxMemo, cxRichEdit, OleCtrls, SHDocVw,

jpeg, DB, ADODB, DBCtrls, cxLabel, Grids, DBGrids, cxGroupBox,

cxRadioGroup, Math, cxCheckGroup, cxCheckBox;

type

TfMain = class(TForm)

// Компоненты

dxSkinController1: TdxSkinController;

IL: TcxImageList;

pc: TcxPageControl;

tsUMK: TcxTabSheet;

tsLections: TcxTabSheet;

tsControlTests: TcxTabSheet;

tsPracticumTests: TcxTabSheet;

tsPresentations: TcxTabSheet;

dxNavBar1: TdxNavBar;

dxNavBar1Group1: TdxNavBarGroup;

dxNavBar1Item1: TdxNavBarItem;

dxNavBar1Item2: TdxNavBarItem;

dxNavBar1Item3: TdxNavBarItem;

dxNavBar1Item4: TdxNavBarItem;

dxNavBar1Item5: TdxNavBarItem;

dxNavBar1Item6: TdxNavBarItem;

dxNavBar1Item7: TdxNavBarItem;

dxNavBar1Item8: TdxNavBarItem;

dxNavBar1Item9: TdxNavBarItem;

dxNavBar1Item10: TdxNavBarItem;

dxNavBar1Item11: TdxNavBarItem;

dxNavBar1Item12: TdxNavBarItem;

dxNavBar1Item13: TdxNavBarItem;

dxNavBar1Item14: TdxNavBarItem;

dxNavBar1Item15: TdxNavBarItem;

WebBrowser: TWebBrowser;

dxNavBar2: TdxNavBar;

dxNavBarGroup1: TdxNavBarGroup;

dxNavBarItem1: TdxNavBarItem;

dxNavBarItem2: TdxNavBarItem;

dxNavBarItem3: TdxNavBarItem;

imPresentations: TImage;

imPrev: TImage;

imNext: TImage;

imHome: TImage;

imFullScreen: TImage;

imExit: TImage;

Panel1: TPanel;

tPeoples: TADOTable;

tPeoplesID: TAutoIncField;

tPeoplesNAME: TWideStringField;

tPeoplesPASSWD: TWideStringField;

dsPeoples: TDataSource;

lcbPeople: TDBLookupComboBox;

edPassword: TEdit;

ADOConnection: TADOConnection;

pAuth: TPanel;

btRegister: TcxButton;

btLogon: TcxButton;

Panel2: TPanel;

Panel3: TPanel;

pNewUser: TPanel;

edNameNewUser: TEdit;

edPasswordNewUser: TEdit;

qAddUser: TADOQuery;

Panel5: TPanel;

Panel6: TPanel;

btCancelAddUser: TcxButton;

btAddUser: TcxButton;

pUserName: TPanel;

pMain: TPanel;

btStartTest: TcxButton;

btMyResults: TcxButton;

btChoiseUser: TcxButton;

pResults: TPanel;

DBGrid: TDBGrid;

mVivod: TDBMemo;

tResults: TADOQuery;

tResultsID: TAutoIncField;

tResultsdate_test: TDateTimeField;

tResultscaption: TWideStringField;

tResultsballs: TFloatField;

tResultsvivod: TMemoField;

dsResults: TDataSource;

Panel4: TPanel;

Panel7: TPanel;

btBackFromResults: TcxButton;

pTestChoise: TPanel;

Panel8: TPanel;

btBackFromTestChoise: TcxButton;

rgTest: TcxRadioGroup;

btStart: TcxButton;

dsTests: TDataSource;

pTestName: TPanel;

pQuestions: TPanel;

Panel9: TPanel;

Panel10: TPanel;

pQuestCap: TPanel;

mQuestion: TDBMemo;

btNext: TcxButton;

btCloseTest: TcxButton;

rgAnswers: TcxRadioGroup;

Panel12: TPanel;

qAddResult: TADOQuery;

AutoIncField1: TAutoIncField;

SmallintField1: TSmallintField;

MemoField1: TMemoField;

IntegerField1: TIntegerField;

dsQuestions: TDataSource;

qQuestions: TADOQuery;

qQuestionsID: TAutoIncField;

qQuestionsNUMBER: TSmallintField;

qQuestionsQUESTION: TMemoField;

qQuestionsTEST: TIntegerField;

pVivod: TPanel;

pVivodBalls: TPanel;

Panel13: TPanel;

btBackFromVivod: TcxButton;

dsVivod: TDataSource;

qVivod: TADOQuery;

qVivodID: TAutoIncField;

qVivodTEST: TIntegerField;

qVivodBALL_LOW: TFloatField;

qVivodBALL_HIGH: TFloatField;

qVivodVIVOD: TMemoField;

DBMemo1: TDBMemo;

Panel11: TPanel;

Panel14: TPanel;

btBackToHome: TcxButton;

tsMain: TcxTabSheet;

WebBrowserUMK: TWebBrowser;

Panel15: TPanel;

btBackToMain: TcxButton;

tTests: TADOQuery;

tTestsID: TAutoIncField;

tTestsCAPTION: TWideStringField;

tTestsTYPE: TSmallintField;

dxNavBar2Item1: TdxNavBarItem;

dxNavBar2Item2: TdxNavBarItem;

dxNavBar2Item3: TdxNavBarItem;

dxNavBar2Item4: TdxNavBarItem;

dxNavBar2Item5: TdxNavBarItem;

dxNavBar2Item6: TdxNavBarItem;

dxNavBar2Item7: TdxNavBarItem;

dxNavBar2Item8: TdxNavBarItem;

dxNavBar2Item9: TdxNavBarItem;

dxNavBar2Item10: TdxNavBarItem;

dxNavBar2Item11: TdxNavBarItem;

pUserNameKZ: TPanel;

pAuthKZ: TPanel;

edPasswordKZ: TEdit;

lcbPeopleKZ: TDBLookupComboBox;

btRegisterKZ: TcxButton;

btLogonKZ: TcxButton;

Panel18: TPanel;

Panel19: TPanel;

pNewUserKZ: TPanel;

edNameNewUserKZ: TEdit;

edPasswordNewUserKZ: TEdit;

Panel20: TPanel;

Panel21: TPanel;

btCancelAddUserKZ: TcxButton;

btAddUserKZ: TcxButton;

pMainKZ: TPanel;

btStartTestKZ: TcxButton;

btMyResultsKZ: TcxButton;

btChoiseUserKZ: TcxButton;

pResultsKZ: TPanel;

DBGridKZ: TDBGrid;

mVivodKZ: TDBMemo;

Panel22: TPanel;

Panel23: TPanel;

btBackFromResultsKZ: TcxButton;

pQuestionsKZ: TPanel;

Panel24: TPanel;

Panel25: TPanel;

btCloseTestKZ: TcxButton;

btNextKZ: TcxButton;

Panel26: TPanel;

pQuestCapKZ: TPanel;

mQuestionKZ: TDBMemo;

pVivodKZ: TPanel;

Panel27: TPanel;

btBackFromVivodKZ: TcxButton;

pVivodBallsKZ: TPanel;

qAnswers: TADOQuery;

qAnswersID: TAutoIncField;

qAnswersQUESTION: TIntegerField;

qAnswersANSWER: TWideStringField;

qAnswersRIGHT: TWordField;

chbAnswersKZ: TcxCheckGroup;

pVivodBallsCapKZ: TPanel;

iMain: TImage;

cxLabel1: TcxLabel;

imCTBackground: TImage;

inPTBackground: TImage;

pGotoPresentation: TPanel;

btGotoPresentation: TcxButton;

pTestChoiseKZ: TPanel;

Panel17: TPanel;

btBackFromTestChoiseKZ: TcxButton;

btStartKZ: TcxButton;

rgTestKZ: TcxRadioGroup;

pTestNameKZ: TPanel;

procedure OpenLection(Sender: TObject);

procedure tsLectionsShow(Sender: TObject);

procedure OpenPresentation(Sender: TObject);

procedure imNextMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure imNextMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure imPrevClick(Sender: TObject);

procedure imNextClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure imHomeMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure imHomeMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure imHomeClick(Sender: TObject);

procedure imFullScreenClick(Sender: TObject);

procedure imExitClick(Sender: TObject);

procedure tsPracticumTestsShow(Sender: TObject);

procedure btLogonClick(Sender: TObject);

procedure btAddUserClick(Sender: TObject);

procedure btRegisterClick(Sender: TObject);

procedure btCancelAddUserClick(Sender: TObject);

procedure btChoiseUserClick(Sender: TObject);

procedure btMyResultsClick(Sender: TObject);

procedure btBackFromResultsClick(Sender: TObject);

procedure btBackFromTestChoiseClick(Sender: TObject);

procedure btStartTestClick(Sender: TObject);

procedure btStartClick(Sender: TObject);

procedure btCloseTestClick(Sender: TObject);

procedure Calc();

procedure Vivod();

procedure SetResults();

procedure btNextClick(Sender: TObject);

procedure btBackFromVivodClick(Sender: TObject);

procedure tsPresentationsShow(Sender: TObject);

procedure btBackToHomeClick(Sender: TObject);

procedure tsControlTestsShow(Sender: TObject);

procedure btRegisterKZClick(Sender: TObject);

procedure btLogonKZClick(Sender: TObject);

procedure btCancelAddUserKZClick(Sender: TObject);

procedure btAddUserKZClick(Sender: TObject);

procedure btMyResultsKZClick(Sender: TObject);

procedure btBackFromResultsKZClick(Sender: TObject);

procedure btChoiseUserKZClick(Sender: TObject);

procedure btStartTestKZClick(Sender: TObject);

procedure btCloseTestKZClick(Sender: TObject);

procedure btNextKZClick(Sender: TObject);

procedure btBackFromVivodKZClick(Sender: TObject);

procedure btGotoPresentationClick(Sender: TObject);

procedure btStartKZClick(Sender: TObject);

procedure btBackFromTestChoiseKZClick(Sender: TObject);

procedure tsPracticumTestsHide(Sender: TObject);

procedure tsControlTestsHide(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

CurLection: integer; // Текущая лекция

CurPresentation: integer; // Текущая презентация

CurSlide: integer; // Текущий слайд

userID : integer; // Текущий пользователь, для тестирования

pType: integer; // Тип тестирования

pTest: integer; // Текущий тест

pBall: integer; // Количество баллов

pLooseCnt: integer; // Количество неправильных ответов в текущем тесте (в тестах на закладке Контроль знаний)

end;

var

fMain: TfMain;

mas1: array[1..40] of integer; // Массивы для тестов в разделе Практикум

mas2: array[1..16] of integer;

mas3: array[1..36] of integer;

implementation

uses uFullScreen;

{$R *.dfm}

// Процедура сверки правильных ответов и назначения баллов для тестов в разделе Практикум

procedure TfMain.Calc();

begin

case pType of

0: begin

case rgAnswers.ItemIndex of

0: mas1[integer(qQuestions.FieldValues['NUMBER'])] := 1;

1: mas1[integer(qQuestions.FieldValues['NUMBER'])] := 0;

end;

end;

1: begin

case rgAnswers.ItemIndex of

0: mas2[integer(qQuestions.FieldValues['NUMBER'])] := 2;

1: mas2[integer(qQuestions.FieldValues['NUMBER'])] := 1;

2: mas2[integer(qQuestions.FieldValues['NUMBER'])] := 0;

end;

end;

2: begin

case rgAnswers.ItemIndex of

0: mas3[integer(qQuestions.FieldValues['NUMBER'])] := 0;

1: mas3[integer(qQuestions.FieldValues['NUMBER'])] := 1;

2: mas3[integer(qQuestions.FieldValues['NUMBER'])] := 2;

3: mas3[integer(qQuestions.FieldValues['NUMBER'])] := 3;

4: mas3[integer(qQuestions.FieldValues['NUMBER'])] := 4;

5: mas3[integer(qQuestions.FieldValues['NUMBER'])] := 5;

end;

end;

end;

end;

// Процедура для подсчета баллов для тестов в разделе Практикум согласно формулам

procedure TfMain.Vivod();

var

i: integer;

Kx,Ox: integer;

Kk,Ko: double;

nTmp: integer;

begin

case pType of

0: begin

i:=1;

while i<=40 do begin

if mas1[i] = 1 then inc(Kx);

i := i + 4;

end;

i:=3;

while i<=40 do begin

if mas1[i] = 0 then inc(Kx);

i := i + 4;

end;

i:=2;

while i<=40 do begin

if mas1[i] = 1 then inc(Ox);

i := i + 4;

end;

i:=4;

while i<=40 do begin

if mas1[i] = 0 then inc(Ox);

i := i + 4;

end;

Kk := RoundTo((Kx / 20),-2);

Ko := RoundTo((Ox / 20),-2);

pBall := 1;

if (Kk >= 0.1) and (Kk <= 0.45) and (Ko >= 0.2) and (Ko <= 0.55) then pBall := 1;

if (Kk >= 0.46) and (Kk <= 0.55) and (Ko >= 0.56) and (Ko <= 0.65) then pBall := 2;

if (Kk >= 0.56) and (Kk <= 0.65) and (Ko >= 0.66) and (Ko <= 0.70) then pBall := 3;

if (Kk >= 0.66) and (Kk <= 0.75) and (Ko >= 0.71) and (Ko <= 0.80) then pBall := 4;

if (Kk >= 0.76) and (Kk <= 1) and (Ko >= 0.81) and (Ko <= 1) then pBall := 5;

end;

1: begin

pBall := 0;

for i:=1 to 16 do begin

pBall := pBall + mas2[i];

end;

end;

2: begin

nTmp := 0;

pBall := 0;

for i:=1 to 36 do begin

if (i in [3, 9, 11, 13, 28, 36]) and (mas3[i] = 0) then begin

// не знаю

inc(nTmp);

end;

if (i in [11, 13, 15, 27]) and (mas3[i] = 5) then begin

// да, всегда

inc(nTmp);

end;

if i in [2, 5, 8, 9, 10, 12, 13, 15, 16, 19, 21, 22, 24, 25, 26, 27, 29, 32] then

pBall := pBall + mas3[i];

end;

if nTmp = 4 then ShowMessage('Мы сомневаемся в искренности ваших ответов');

if nTmp >= 5 then ShowMessage('Вы отвечали не искренне');

end;

end;

end;

// Процедура для записи результатов тестирования в БД

procedure TfMain.SetResults();

begin

qAddResult.Parameters.ParamByName('pPeople').Value := userID;

qAddResult.Parameters.ParamByName('pTest').Value := pTest;

qAddResult.Parameters.ParamByName('pDate').Value := now;

qAddResult.Parameters.ParamByName('pBalls').Value := pBall;

qAddResult.ExecSQL;

end;

// Процедура открытия лекций

procedure TfMain.OpenLection(Sender: TObject);

var i : integer;

begin

for i := 0 to Self.ComponentCount-1 do begin // проставляем иконки у лекций

if (Self.Components[i].ClassName = 'TdxNavBarItem') then

(Self.Components[i] as TdxNavBarItem).SmallImageIndex := 11;

end;

(Sender as TdxNavBarItem).SmallImageIndex := 3;

WebBrowser.Navigate(ExtractFilePath(Application.ExeName)+'Lections\Lect_'+IntToStr((Sender as TdxNavBarItem).Tag)+'.htm'); // открываем лекцию

CurLection := (Sender as TdxNavBarItem).Tag; // устанавливаем текущую лекцию

pGotoPresentation.Visible := CurLection in [1, 4, 12, 13, 14,15]; //Если у лекции есть связанная с ней презентация, то показываем кнопку

end;

// Процедура для правильного отображения иконок у лекций

procedure TfMain.tsLectionsShow(Sender: TObject);

var

i : integer;

begin

for i := 0 to Self.ComponentCount-1 do begin

if (Self.Components[i].ClassName = 'TdxNavBarItem') then

(Self.Components[i] as TdxNavBarItem).SmallImageIndex := 11;

if (Self.Components[i].ClassName = 'TdxNavBarItem') AND ((Self.Components[i] as TdxNavBarItem).Tag = CurLection) then

(Self.Components[i] as TdxNavBarItem).SmallImageIndex := 3;

end;

end;

// Процедура открытия презентации

procedure TfMain.OpenPresentation(Sender: TObject);

var

i : integer;

begin

for i := 0 to Self.ComponentCount-1 do begin // проставляем иконки у презентаций

if (Self.Components[i].ClassName = 'TdxNavBarItem') then

(Self.Components[i] as TdxNavBarItem).SmallImageIndex := 13;

end;

(Sender as TdxNavBarItem).SmallImageIndex := 15;

imPresentations.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Presentations\'+IntToStr((Sender as TdxNavBarItem).Tag)+'\1.jpg'); // показываем презентацию

CurPresentation := (Sender as TdxNavBarItem).Tag; // устанавливаем текущую презентацию

CurSlide := 1; // устанавливаем текущий слайд

// делаем доступными кнопки управления слайдами

imNext.Enabled := true;

imHome.Enabled := true;

imFullScreen.Enabled := true;

end;

// Делаем анимацию кнопок Следующий и Предыдущий слайд

procedure TfMain.imNextMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

(Sender as TImage).Left := (Sender as TImage).Left + 2;

end;

// Делаем анимацию кнопок Следующий и Предыдущий слайд

procedure TfMain.imNextMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

(Sender as TImage).Left := (Sender as TImage).Left - 2;

end;

// Процедура показа предыдущего слайда

procedure TfMain.imPrevClick(Sender: TObject);

begin

CurSlide := CurSlide - 1; // Устанавливаем текущий слайд

imNext.Enabled := true; // разрешаем кнопку Следующий

if CurSlide <= 1 then begin // Если текущий слайд самый первый

CurSlide := 1;

imPrev.Enabled := false; // запрещаем кнопку Предыдущий

end;

imPresentations.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Presentations\'+IntToStr(CurPresentation)+'\'+IntToStr(CurSlide)+'.jpg'); // Показываем текущий слайд

end;

// Процедура показа следующего слайда

procedure TfMain.imNextClick(Sender: TObject);

begin

CurSlide := CurSlide + 1; // Устанавливаем текущий слайд

imPrev.Enabled := true; // разрешаем кнопку Предыдущий

if not FileExists(ExtractFilePath(Application.ExeName)+'Presentations\'+IntToStr(CurPresentation)+'\'+IntToStr(CurSlide)+'.jpg') then begin

CurSlide := 0; // Если нету следующего слайда, то показываем слайд "Конец"

imNext.Enabled := false; // запрещаем кнопки Следующий и предыдущий

imPrev.Enabled := false;

imPresentations.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Presentations\End.jpg');

end

else imPresentations.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Presentations\'+IntToStr(CurPresentation)+'\'+IntToStr(CurSlide)+'.jpg'); // Показываем текущий слайд

end;

// Самая первая процедура - процедура создания формы программы

procedure TfMain.FormCreate(Sender: TObject);

begin

Self.DoubleBuffered := true; // Чтобы ничего не моргало

pTest := -1; // Обнуляем переменные

userID := -1;

pc.ActivePageIndex := 0; // Показываем главную закладку

if FileExists(ExtractFilePath(Application.ExeName)+'UMK\UMK.htm') then

WebBrowserUMK.Navigate(ExtractFilePath(Application.ExeName)+'UMK\UMK.htm'); // Загружаем УМК

end;

// Делаем анимацию кнопки Домой на презентации

procedure TfMain.imHomeMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

(Sender as TImage).Top := (Sender as TImage).Top + 2;

end;

// Делаем анимацию кнопки Домой на презентации

procedure TfMain.imHomeMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

(Sender as TImage).Top := (Sender as TImage).Top - 2;

end;

// Процедура перехода на первый слайд

procedure TfMain.imHomeClick(Sender: TObject);

begin

imPresentations.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Presentations\'+IntToStr(CurPresentation)+'\1.jpg'); // Загружаем первый слайд

CurSlide := 1; // Устанавливаем текущий слайд - первый слайд

imPrev.Enabled := false;

imNext.Enabled := true;

end;

// Процедура показа презентации на весь экран

procedure TfMain.imFullScreenClick(Sender: TObject);

begin

Application.CreateForm(TfFullScreen, fFullScreen);

fFullScreen.imFullScreen.Picture.Assign(imPresentations.Picture);

fFullScreen.imNext1.Enabled := CurSlide <> 0;

fFullScreen.imPrev1.Enabled := CurSlide > 1;

fFullScreen.ShowModal;

end;

// Процедура завершения работы программы

procedure TfMain.imExitClick(Sender: TObject);

begin

Close;

end;

// Процедура показа закладки Практикум

procedure TfMain.tsPracticumTestsShow(Sender: TObject);

begin

// Проверка - есть ли файл с БД, если нету - то закрываем закладку Практикум

if not FileExists(ExtractFilePath(Application.ExeName) + 'test_db.mdb') then begin

ShowMessage('База данных не найдена!');

tsPracticumTests.Hide;

end

else begin

// Если всё нормально, то подключаемся к БД

ADOConnection.Connected := true;

// И инициализируем переменные и внешний вид

tPeoples.Active := false;

tPeoples.Active := true;

lcbPeople.KeyValue := -1;

edPassword.Text := '';

pNewUser.Top := pAuth.Top;

pNewUser.Left := pAuth.Left;

pMain.Top := pAuth.Top;

pMain.Left := pAuth.Left;

pResults.Align := alClient;

pQuestions.Align := alClient;

pVivod.Top := pAuth.Top;

pVivod.Left := pAuth.Left;

if userID <> -1 then begin

pUserName.Visible := pUserNameKZ.Visible;

pMain.Visible := pMainKZ.Visible;

pResults.Visible := pResultsKZ.Visible;

pTestChoise.Visible := pTestChoiseKZ.Visible;

pNewUser.Visible := false;

pQuestions.Visible := false;

pTestName.Visible := false;

pVivod.Visible := false;

pAuth.Visible := false;

end

else begin

pAuth.Visible := true;

pMain.Visible := false;

pNewUser.Visible := false;

pQuestions.Visible := false;

pResults.Visible := false;

pTestChoise.Visible := false;

pTestName.Visible := false;

pUserName.Visible := false;

pVivod.Visible := false;

end;

end;

end;

// Процедура обработки нажатия кнопки Войти на закладке Практикум

procedure TfMain.btLogonClick(Sender: TObject);

begin

if lcbPeople.Text = '' then begin

ShowMessage('Вы не выбрали пользователя');

lcbPeople.SetFocus;

exit;

end;

if edPassword.Text = '' then begin

ShowMessage('Пароль не должен быть пустым');

edPassword.SetFocus;

exit;

end;

// Проверка правильности введенного пароля

if edPassword.Text <> tPeoples.FieldByName('passwd').Value then begin

ShowMessage('Вы ввели неверный пароль');

edPassword.SetFocus;

exit;

end

else begin

// Если всё верно, то запоминаем пользователя, выводим его ФИО и показывает главную панель тестирования

fMain.userID := lcbPeople.KeyValue;

edPassword.Text := '';

pUserName.Caption := lcbPeople.Text;

pUserNameKZ.Caption := lcbPeople.Text;

pUserName.Visible := true;

pMain.Top := pAuth.Top;

pMain.Left := pAuth.Left;

pAuth.Visible := false;

pMain.Visible := true;

end;

end;

// Процедура обработки нажатия кнопки Добавить на панели регистрации нового пользователя

procedure TfMain.btAddUserClick(Sender: TObject);

begin

if edNameNewUser.Text = '' then begin

ShowMessage('Вы должны ввести своё имя');

edNameNewUser.SetFocus;

exit;

end;

if edPasswordNewUser.Text = '' then begin

ShowMessage('Вы должны ввести пароль');

edPasswordNewUser.SetFocus;

exit;

end;

// Запрос, который добавляет нового пользователя в БД

qAddUser.SQL.Text := 'insert into PEOPLES(name,passwd) values('''+edNameNewUser.Text+''','''+edPasswordNewUser.Text+''');';

qAddUser.ExecSQL;

ShowMessage('Пользователь успешно добавлен');

tPeoples.Active := false;

tPeoples.Active := true;

pAuth.Visible := true;

pNewUser.Visible := false;

end;

// Процедура показа панели регистрации нового пользователя

procedure TfMain.btRegisterClick(Sender: TObject);

begin

pNewUser.Top := pAuth.Top;

pNewUser.Left := pAuth.Left;

pAuth.Visible := false;

pNewUser.Visible := true;

end;

// Процедура отмены регистрации нового пользователя

procedure TfMain.btCancelAddUserClick(Sender: TObject);

begin

pAuth.Visible := true;

pNewUser.Visible := false;

end;

// Процедура смены пользователя

procedure TfMain.btChoiseUserClick(Sender: TObject);

begin

fMain.userID := -1;

pUserName.Caption := '';

pUserName.Visible := false;

pAuth.Visible := true;

pMain.Visible := false;

end;

// Процедура показа результатов тестирований пользователя

procedure TfMain.btMyResultsClick(Sender: TObject);

begin

pResults.Align := alClient;

pResults.Visible := true;

pMain.Visible := false;

// Передаем в запрос парметр с ID текущего пользователя

tResults.Parameters.ParamByName('pPeople').Value := Self.userID;

// Получаем его результаты

tResults.Active := false;

tResults.Active := true;

end;

// Процедура закрытия окна регистрации

procedure TfMain.btBackFromResultsClick(Sender: TObject);

begin

pMain.Visible := true;

pResults.Visible := false;

end;

// Процедура возврата к выбору теста

procedure TfMain.btBackFromTestChoiseClick(Sender: TObject);

begin

pTestName.Caption := '';

pTestName.Visible := false;

pTest := -1;

pMain.Visible := true;

pTestChoise.Visible := false;

end;

// Процедура запуска выбора теста на закладке Практикум

procedure TfMain.btStartTestClick(Sender: TObject);

var

i: integer;

begin

// Формируем список доступных тестов

rgTest.Properties.Items.Clear;

tTests.Active := false;

tTests.Active := true;

tTests.First;

for i := 0 to tTests.RecordCount-1 do begin

if tTests.FieldValues['TYPE'] <> 3 then

rgTest.Properties.Items.Add.Caption := tTests.FieldValues['CAPTION'];

tTests.Next;

end;

rgTest.ItemIndex := 0;

pTestChoise.Visible := true;

pMain.Visible := false;

end;

// Процедура запуска теста на закладке Практикум

procedure TfMain.btStartClick(Sender: TObject);

begin

// Показываем название теста сверху

pTestName.Caption := 'Тест: ' + rgTest.Properties.Items.Items[rgTest.ItemIndex].Caption;

pTestName.Visible := true;

btNext.Caption := 'Следующий вопрос';

// Запоминаем ID теста и его тип

tTests.Locate('ID',rgTest.ItemIndex+1,[loCaseInsensitive]);

pType := tTests.FieldValues['Type'];

pTest := tTests.FieldValues['ID'];

// Формируем список правильных ответов согласно типу теста

rgAnswers.Properties.Items.Clear;

case pType of

0: begin

rgAnswers.Properties.Items.Add.Caption := 'Да';

rgAnswers.Properties.Items.Add.Caption := 'Нет';

end;

1: begin

rgAnswers.Properties.Items.Add.Caption := 'Да';

rgAnswers.Properties.Items.Add.Caption := 'Иногда';

rgAnswers.Properties.Items.Add.Caption := 'Нет';

end;

2: begin

rgAnswers.Properties.Items.Add.Caption := 'Не знаю';

rgAnswers.Properties.Items.Add.Caption := 'Нет, никогда';

rgAnswers.Properties.Items.Add.Caption := 'Иногда';

rgAnswers.Properties.Items.Add.Caption := 'Часто';

rgAnswers.Properties.Items.Add.Caption := 'Почти всегда';

rgAnswers.Properties.Items.Add.Caption := 'Да, всегда';

end;

end;

rgAnswers.ItemIndex := -1;

// Показываем первый вопрос

qQuestions.Parameters.ParamByName('pTest').Value := Self.pTest;

qQuestions.Active := false;

qQuestions.Active := true;

qQuestions.First;

pQuestCap.Caption := 'Вопрос №'+IntToStr(qQuestions.FieldValues['NUMBER'])+' из '+IntToStr(qQuestions.RecordCount);

pQuestions.Align := alClient;

pQuestions.Visible := true;

pTestChoise.Visible := false;

end;

// Процедура прерывания тестирования

procedure TfMain.btCloseTestClick(Sender: TObject);

begin

pTestName.Caption := '';

pTestName.Visible := false;

pTest := -1;

pTestChoise.Visible := true;

pQuestions.Visible := false;

end;

// Процедура обработки нажатия кнопки Следующий вопрос

procedure TfMain.btNextClick(Sender: TObject);

begin

// Если не выбран ни один вариант ответа, то говорим об этом и прерываем процедуру

if rgAnswers.ItemIndex < 0 then begin

ShowMessage('Выберите какой-нибудь вариант ответа');

rgAnswers.SetFocus;

exit;

end;

Calc();// Фиксируем выбранный вариант ответа

// Если не последний вопрос, то выводим следующий

if btNext.Caption = 'Следующий вопрос' then begin

qQuestions.Next;

rgAnswers.ItemIndex := -1;

pQuestCap.Caption := 'Вопрос №'+IntToStr(qQuestions.FieldValues['NUMBER'])+' из '+IntToStr(qQuestions.RecordCount);

// Если последний вопрос, то кнопка Следующий вопрос становится кнопкой Завершить тестирование

if qQuestions.RecNo = qQuestions.RecordCount then begin

btNext.Caption := 'Завершить тестирование';

end;

end

else begin

Vivod();// Считаем баллы

SetResults();// Записываем баллы в таблицу с результатами

// Показываем баллы и вывод согласно этим баллам и этому тесту

qVivod.Parameters.ParamByName('pTest').Value := Self.pTest;

qVivod.Parameters.ParamByName('pBall').Value := Self.pBall;

qVivod.Active := false;

qVivod.Active := true;

pVivodBalls.Caption := 'Вы набрали '+IntToStr(Self.pBall)+' баллов';

pVivod.Top := pAuth.Top + 15;

pVivod.Left := pAuth.Left - 73;

pVivod.Visible := true;

pQuestions.Visible := false;

end;

end;

// Процедура закрытия панели с выводами

procedure TfMain.btBackFromVivodClick(Sender: TObject);

begin

pTestName.Caption := '';

pTestName.Visible := false;

pTest := -1;

pMain.Visible := true;

pVivod.Visible := false;

end;

// Процедура показа закладки с презентациями

procedure TfMain.tsPresentationsShow(Sender: TObject);

var

i : integer;

begin

// Делаем красивые иконки возле презентаций

for i := 0 to Self.ComponentCount-1 do begin

if (Self.Components[i].ClassName = 'TdxNavBarItem') then

(Self.Components[i] as TdxNavBarItem).SmallImageIndex := 13;

if (Self.Components[i].ClassName = 'TdxNavBarItem') AND ((Self.Components[i] as TdxNavBarItem).Tag = CurPresentation) then

(Self.Components[i] as TdxNavBarItem).SmallImageIndex := 15;

end;

end;

// Процедура обработки нажатия кнопки На главную

procedure TfMain.btBackToHomeClick(Sender: TObject);

begin

tsMain.Show;

end;

// Процедура показа закладки Контроль знаний

procedure TfMain.tsControlTestsShow(Sender: TObject);

begin

// Проверяем есть ли файл с БД

if not FileExists(ExtractFilePath(Application.ExeName) + 'test_db.mdb') then begin

ShowMessage('База данных не найдена!');

tsControlTests.Hide;

end

else begin

// Пытаемся подключиться к БД

ADOConnection.Connected := true;

// Инициалицируем переменные и внешний вид

tPeoples.Active := false;

tPeoples.Active := true;

lcbPeopleKZ.KeyValue := -1;

edPasswordKZ.Text := '';

pNewUserKZ.Top := pAuthKZ.Top;

pNewUserKZ.Left := pAuthKZ.Left;

pMainKZ.Top := pAuthKZ.Top;

pMainKZ.Left := pAuthKZ.Left;

pResultsKZ.Align := alClient;

pQuestionsKZ.Align := alClient;

pVivodKZ.Top := pAuthKZ.Top;

pVivodKZ.Left := pAuthKZ.Left;

if userID <> -1 then begin

pUserNameKZ.Visible := pUserName.Visible;

pMainKZ.Visible := pMain.Visible;

pResultsKZ.Visible := pResults.Visible;

pTestChoiseKZ.Visible := pTestChoise.Visible;

pNewUserKZ.Visible := false;

pQuestionsKZ.Visible := false;

pTestNameKZ.Visible := false;

pVivodKZ.Visible := false;

pAuthKZ.Visible := false;

end

else begin

pAuthKZ.Visible := true;

pMainKZ.Visible := false;

pNewUserKZ.Visible := false;

pQuestionsKZ.Visible := false;

pResultsKZ.Visible := false;

pTestChoiseKZ.Visible := false;

pTestNameKZ.Visible := false;

pUserNameKZ.Visible := false;

pVivodKZ.Visible := false;

end;

end;

end;

// Процедура показа панели регистрации нового пользователя

procedure TfMain.btRegisterKZClick(Sender: TObject);

begin

pNewUserKZ.Top := pAuthKZ.Top;

pNewUserKZ.Left := pAuthKZ.Left;

pAuthKZ.Visible := false;

pNewUserKZ.Visible := true;

end;

// Процедура обработки нажатия кнопки Войти на закладке Контроль знаний

procedure TfMain.btLogonKZClick(Sender: TObject);

begin

if lcbPeopleKZ.Text = '' then begin

ShowMessage('Вы не выбрали пользователя');

lcbPeopleKZ.SetFocus;

exit;

end;

if edPasswordKZ.Text = '' then begin

ShowMessage('Пароль не должен быть пустым');

edPasswordKZ.SetFocus;

exit;

end;

// Проверка правильности введенного пароля

if edPasswordKZ.Text <> tPeoples.FieldByName('passwd').Value then begin

ShowMessage('Вы ввели неверный пароль');

edPasswordKZ.SetFocus;

exit;

end

else begin

// Если всё верно, то запоминаем пользователя, выводим его ФИО и показывает главную панель тестирования

fMain.userID := lcbPeopleKZ.KeyValue;

edPasswordKZ.Text := '';

pUserNameKZ.Caption := lcbPeopleKZ.Text;

pUserName.Caption := lcbPeopleKZ.Text;

pUserNameKZ.Visible := true;

pMainKZ.Top := pAuthKZ.Top;

pMainKZ.Left := pAuthKZ.Left;

pAuthKZ.Visible := false;

pMainKZ.Visible := true;

end;

end;

// Процедура отмены регистрации нового пользователя

procedure TfMain.btCancelAddUserKZClick(Sender: TObject);

begin

pAuthKZ.Visible := true;

pNewUserKZ.Visible := false;

end;

// Процедура обработки нажатия кнопки Добавить на панели регистрации нового пользователя

procedure TfMain.btAddUserKZClick(Sender: TObject);

begin

if edNameNewUserKZ.Text = '' then begin

ShowMessage('Вы должны ввести своё имя');

edNameNewUserKZ.SetFocus;

exit;

end;

if edPasswordNewUserKZ.Text = '' then begin

ShowMessage('Вы должны ввести пароль');

edPasswordNewUserKZ.SetFocus;

exit;

end;

// Запрос, который добавляет нового пользователя в БД

qAddUser.SQL.Text := 'insert into PEOPLES(name,passwd) values('''+edNameNewUserKZ.Text+''','''+edPasswordNewUserKZ.Text+''');';

qAddUser.ExecSQL;

ShowMessage('Пользователь успешно добавлен');

tPeoples.Active := false;

tPeoples.Active := true;

pAuthKZ.Visible := true;

pNewUserKZ.Visible := false;

end;

// Процедура показа результатов тестирований пользователя

procedure TfMain.btMyResultsKZClick(Sender: TObject);

begin

pResultsKZ.Align := alClient;

pResultsKZ.Visible := true;

pMainKZ.Visible := false;

// Передаем в запрос парметр с ID текущего пользователя

tResults.Parameters.ParamByName('pPeople').Value := Self.userID;

// Получаем его результаты

tResults.Active := false;

tResults.Active := true;

end;

// Процедура возврата с окна результатов

procedure TfMain.btBackFromResultsKZClick(Sender: TObject);

begin

pMainKZ.Visible := true;

pResultsKZ.Visible := false;

end;

// Процедура смены пользователя

procedure TfMain.btChoiseUserKZClick(Sender: TObject);

begin

fMain.userID := -1;

pUserNameKZ.Caption := '';

pUserNameKZ.Visible := false;

pAuthKZ.Visible := true;

pMainKZ.Visible := false;

end;

// Процедура запуска выбора теста на закладке Контроль знаний

procedure TfMain.btStartTestKZClick(Sender: TObject);

var

i: integer;

begin

// Формируем список доступных тестов

rgTestKZ.Properties.Items.Clear;

tTests.Active := false;

tTests.Active := true;

tTests.First;

for i := 0 to tTests.RecordCount-1 do begin

if tTests.FieldValues['TYPE'] = 3 then

rgTestKZ.Properties.Items.Add.Caption := tTests.FieldValues['CAPTION'];

tTests.Next;

end;

rgTest.ItemIndex := 0;

pTestChoiseKZ.Visible := true;

pMainKZ.Visible := false;

end;

// Процедура отмены выбора тестирования

procedure TfMain.btCloseTestKZClick(Sender: TObject);

begin

pTestNameKZ.Caption := '';

pTestNameKZ.Visible := false;

pTest := -1;

pTestChoiseKZ.Visible := true;

pQuestionsKZ.Visible := false;

end;

// Процедура обработки нажатия кнопки Следующий вопрос

procedure TfMain.btNextKZClick(Sender: TObject);

var

i : integer;

cntCheck : integer;

nLoose : boolean;

nBalls : integer;

begin

cntCheck := 0;

nLoose := false; // Все ответы правильные сначала

for i := 0 to chbAnswersKZ.Properties.Items.Count - 1 do begin

if chbAnswersKZ.States[i] = cbsChecked then cntCheck := cntCheck +1;

// Проверка правильности выбранных вариантов ответа

if (((chbAnswersKZ.Properties.Items.Items[i].Tag = 1) AND (chbAnswersKZ.States[i] = cbsUnChecked))

OR ((chbAnswersKZ.Properties.Items.Items[i].Tag = 0) AND (chbAnswersKZ.States[i] = cbsChecked))) then

nLoose := true; // Фиксируем неправильный вариант ответа

end;

// Должен быть выбран хотя бы один вариант ответа

if cntCheck = 0 then begin

ShowMessage('Выберите один или несколько вариантов ответа');

chbAnswersKZ.SetFocus;

exit;

end;

// Если есть хотя бы одно несовпадение, то ответ неправильный

if nLoose then pLooseCnt := pLooseCnt + 1;

//Если вопрос не последний, то показываем следующий

if btNextKZ.Caption = 'Следующий вопрос' then begin

qQuestions.Next;

pQuestCapKZ.Caption := 'Вопрос №'+IntToStr(qQuestions.RecNo)+' из '+IntToStr(qQuestions.RecordCount);

chbAnswersKZ.Properties.Items.Clear;

// Загружаем варианты ответов

qAnswers.Parameters.ParamByName('pQuestion').Value := qQuestions.FieldValues['ID'];

qAnswers.Active := false;

qAnswers.Active := true;

qAnswers.First;

// Показываем варианты ответов

for i := 0 to qAnswers.RecordCount-1 do begin

chbAnswersKZ.Properties.Items.Add.Caption := qAnswers.FieldValues['ANSWER'];

chbAnswersKZ.Properties.Items.Items[i].Tag := qAnswers.FieldValues['RIGHT'];

qAnswers.Next;

end;

// Если последний вопрос, то меняем кнопку Следующий вопрос на Завершить тестирование

if qQuestions.RecNo = qQuestions.RecordCount then begin

btNextKZ.Caption := 'Завершить тестирование';

end;

end

else begin

// Если ответили на последний вопрос

// Подсчитываем баллы по академической системе

pBall := round(( (qQuestions.RecordCount - pLooseCnt) / qQuestions.RecordCount)*100);

if pBall >= 85 then nBalls := 5

else if ((pBall >= 70) and (pBall < 85)) then nBalls := 4

else if ((pBall >= 55) and (pBall < 70)) then nBalls := 3

else nBalls := 2;

// Сохраняем быллы в таблицу результатов

SetResults();

// Показываем результаты пользователю

pVivodBallsCapKZ.Caption := 'Вы ответили правильно на ' + IntToStr(qQuestions.RecordCount - pLooseCnt) + ' из ' + IntToStr(qQuestions.RecordCount) + ' вопросов';

pVivodBallsKZ.Caption := 'Вы набрали ' + IntToStr(pBall) + ' балл(ов). Ваша оценка - '+IntToStr(nBalls);

pVivodKZ.Top := pAuthKZ.Top;

pVivodKZ.Left := pAuthKZ.Left;

pVivodKZ.Visible := true;

pQuestionsKZ.Visible := false;

end;

end;

// Процедура закрытия окна вывода результата тестирования

procedure TfMain.btBackFromVivodKZClick(Sender: TObject);

begin

pTestNameKZ.Caption := '';

pTestNameKZ.Visible := false;

pTest := -1;

pMainKZ.Visible := true;

pVivodKZ.Visible := false;

end;

// Процедура перехода на презентацию, связанную с лекцией

procedure TfMain.btGotoPresentationClick(Sender: TObject);

begin

case CurLection of

1: CurPresentation := 4;

4: CurPresentation := CurPresentation;

12: CurPresentation := 5;

13: CurPresentation := 8;

14: CurPresentation := 7;

15: CurPresentation := 6;

end;

// Показываем закладку презентаций

tsPresentations.Show;

// Показываем первый слайд

imPresentations.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'Presentations\'+IntToStr(CurPresentation)+'\1.jpg');

CurSlide := 1;

imNext.Enabled := true;

imHome.Enabled := true;

imFullScreen.Enabled := true;

end;

// Процедура запуска тестирования на закладке Контроль знаний

procedure TfMain.btStartKZClick(Sender: TObject);

var

i : integer;

begin

// Показываем название теста

pTestNameKZ.Caption := 'Тест: ' + rgTestKZ.Properties.Items.Items[rgTestKZ.ItemIndex].Caption;

pTestNameKZ.Visible := true;

pLooseCnt := 0;

btNextKZ.Caption := 'Следующий вопрос';

// Сохраняем ID теста

tTests.Locate('ID',rgTestKZ.ItemIndex+4,[loCaseInsensitive]);

pTest := tTests.FieldValues['ID'];

// Загружаем первый вопрос

qQuestions.Parameters.ParamByName('pTest').Value := Self.pTest;

qQuestions.Active := false;

qQuestions.Active := true;

qQuestions.First;

pQuestCapKZ.Caption := 'Вопрос №'+IntToStr(qQuestions.RecNo)+' из '+IntToStr(qQuestions.RecordCount);

chbAnswersKZ.Properties.Items.Clear;

// Загружаем варианты ответов

qAnswers.Parameters.ParamByName('pQuestion').Value := qQuestions.FieldValues['ID'];

qAnswers.Active := false;

qAnswers.Active := true;

qAnswers.First;

// Показываем варианты ответов

for i := 0 to qAnswers.RecordCount-1 do begin

chbAnswersKZ.Properties.Items.Add.Caption := qAnswers.FieldValues['ANSWER'];

// В Tag помещается 1 если ответ правильный и 0 – если неправильный

chbAnswersKZ.Properties.Items.Items[i].Tag := qAnswers.FieldValues['RIGHT'];

qAnswers.Next;

end;

pQuestionsKZ.Align := alClient;

pQuestionsKZ.Visible := true;

pTestChoiseKZ.Visible := false;

end;

// Процедура отмены выбора теста

procedure TfMain.btBackFromTestChoiseKZClick(Sender: TObject);

begin

pTestNameKZ.Caption := '';

pTestNameKZ.Visible := false;

pTest := -1;

pMainKZ.Visible := true;

pTestChoiseKZ.Visible := false;

end;

// Процедура перехода с закладки Практикум

procedure TfMain.tsPracticumTestsHide(Sender: TObject);

begin

// Предупреждаем, что тестирование будет прервано

if pTest <> -1 then Application.MessageBox('Тестирование будет прервано','Внимание',MB_ICONSTOP + MB_OK);

end;

// Процедура перехода с закладки Контроль знаний

procedure TfMain.tsControlTestsHide(Sender: TObject);

begin

// Предупреждаем, что тестирование будет прервано

if pTest <> -1 then Application.MessageBox('Тестирование будет прервано','Внимание',MB_ICONSTOP + MB_OK);

pTest := -1;

end;

end.