DataModule1.tabelTests.Open;

end;

procedure TteacherForm.answerNavigatorClick(Sender: TObject;

Button: TNavigateBtn);

begin

if Button = nbInsert then

begin

if ((teacherForm.questionTypeCB.ItemIndex = 4) and (DataModule1.tabelAnswers.RecordCount = 1)) then

begin

MessageBox(teacherForm.Handle,'На вопрос типа "Свободный ввод" разрешен только один ответ','Добавление ответа невозможно',MB_OK or MB_ICONASTERISK);

DataModule1.tabelAnswers.First;

answerDBCtrlGrid.Refresh;

exit;

end;

DataModule1.tabelAnswers.Append;

if questionTypeCB.ItemIndex in [2, 3, 4] then

begin

answerIsRightCheck.DataSource.DataSet.FieldByName('Answer_is_right').AsBoolean := true;

answerDBCtrlGrid.Refresh;

end;

end;

end;

procedure TteacherForm.fontsComboBoxChange(Sender: TObject);

begin

CurrText.Name := fontsComboBox.FontName;

end;

procedure TteacherForm.fontSizeComboBoxChange(Sender: TObject);

begin

CurrText.Size := StrToInt(fontSizeComboBox.Text);

end;

procedure TteacherForm.ToolButton11Click(Sender: TObject);

begin

if ColorDialog1.Execute then

CurrText.Color := ColorDialog1.Color;

end;

procedure TteacherForm.btnTestCancelClick(Sender: TObject);

begin

DataModule1.tabelTests.Cancel;

end;

procedure TteacherForm.btnQuestAcceptClick(Sender: TObject);

begin

try

with DataModule1.tabelQuestions do

begin

Edit;

FieldByName('Question_Type').AsInteger := questionTypeCB.ItemIndex;

FieldByName('Question_time').AsString := questionTimLimitEdit.Text;

Post;

Refresh;

end;

except

end;

end;

procedure TteacherForm.btnQuestCancelClick(Sender: TObject);

begin

DataModule1.tabelQuestions.Cancel;

end;

procedure TteacherForm.questionTextEditEnter(Sender: TObject);

begin

DataModule1.tabelQuestions.Edit

end;

procedure TteacherForm.tbBoldClick(Sender: TObject);

begin

if fsBold in CurrText.Style then

begin

tbBold.Down := false;

CurrText.Style := CurrText.Style - [fsBold]

end

else

begin

tbBold.Down := true;

CurrText.Style := CurrText.Style + [fsBold];

end;

end;

procedure TteacherForm.tbItalicClick(Sender: TObject);

begin

if fsItalic in CurrText.Style then

begin

tbItalic.Down := false;

CurrText.Style := CurrText.Style - [fsItalic]

end

else

begin

tbItalic.Down := true;

CurrText.Style := CurrText.Style + [fsItalic];

end;

end;

procedure TteacherForm.tbUnderlineClick(Sender: TObject);

begin

if fsUnderline in CurrText.Style then

begin

tbUnderline.Down := false;

CurrText.Style := CurrText.Style - [fsUnderline]

end

else

begin

tbUnderline.Down := true;

CurrText.Style := CurrText.Style + [fsUnderline];

end;

end;

procedure TteacherForm.questionTextEditSelectionChange(Sender: TObject);

begin

if fsBold in CurrText.Style then

tbBold.Down := true

else

tbBold.Down := false;

if fsItalic in CurrText.Style then

tbItalic.Down := true

else

tbItalic.Down := false;

if fsUnderline in CurrText.Style then

tbUnderline.Down := true

else

tbUnderline.Down := false;

end;

procedure TteacherForm.tbLeftClick(Sender: TObject);

begin

// questionTextEdit.Alignment;

end;

procedure TteacherForm.tbCenterClick(Sender: TObject);

begin

questionTextEdit.Alignment := taCenter;

end;

procedure TteacherForm.tbInsertObjectClick(Sender: TObject);

begin

if questionTextEdit.InsertObjectDialog = true then

DataModule1.tabelQuestions.Edit;

end;

procedure TteacherForm.questionNavigatorClick(Sender: TObject;

Button: TNavigateBtn);

begin

if Button = nbInsert then

DataModule1.tabelQuestions.Append;

end;

procedure TteacherForm.FormActivate(Sender: TObject);

begin

DataModule1.ADOConnection.Close;

DataModule1.tabelSections.Close;

DataModule1.tabelTests.Close;

DataModule1.tabelQuestions.Close;

DataModule1.tabelAnswers.Close;

autentificationForm.ShowModal;

end;

end.

Модуль администрирования

unit uEditorAutentification;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TautentificationForm = class(TForm)

loginEdit: TEdit;

passwordEdit: TEdit;

loginLabel: TLabel;

passwordLabel: TLabel;

btnOK: TBitBtn;

btnCancel: TBitBtn;

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

autentificationForm: TautentificationForm;

implementation

uses uEditorDataModule, uEditorMain;

{$R *.dfm}

procedure TautentificationForm.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

var

sqlStr : string;

begin

if (Sender as TautentificationForm).ModalResult = mrOk then

begin

if ((loginEdit.Text = '') and (passwordEdit.Text = '')) then

begin

MessageBox(Handle,'Введите имя учетной записи и пароль','Ошибка!!!',MB_OK or MB_ICONERROR);

CanClose := false;

end

else

begin

DataModule1.ADOConnection.Open;

sqlStr := 'SELECT * from Users Where (User_group_id=1 or User_group_id=2)' +

' and (User_name=''' + loginEdit.Text + ''' and User_password=''' +

passwordEdit.Text + ''')';

//ShowMessage(sqlStr);

try

DataModule1.ADOConnection.Open;

DataModule1.groupQuery.Open;

DataModule1.userQuery.Close;

DataModule1.userQuery.SQL.Text := sqlStr;

DataModule1.userQuery.Open;

except

end;

if DataModule1.userQuery.RecordCount = 1 then

begin

DataModule1.tabelSections.Open;

DataModule1.tabelTests.Open;

DataModule1.tabelQuestions.Open;

DataModule1.tabelAnswers.Open;

end

else

begin

MessageBox(Handle,'Доступ запрещен!!!','Ошибка!!!',MB_OK or MB_ICONERROR);

teacherForm.Close;

end;

end;

end

else

begin

teacherForm.Close;

end;

end;

end.

unit uDataModule;

interface

uses

SysUtils, Classes, DB, ADODB;

type

TDataModule1 = class(TDataModule)

ADOConnection: TADOConnection;

usersTable: TADOTable;

groupsTable: TADOTable;

groupSectionTable: TADOTable;

groupsDS: TDataSource;

usersDS: TDataSource;

groupSectionDS: TDataSource;

sectionsTable: TADOTable;

sectionsDS: TDataSource;

sectionsQuery: TADOQuery;

procedure groupsDSDataChange(Sender: TObject; Field: TField);

private

{ Private declarations }

public

{ Public declarations }

end;

var

DataModule1: TDataModule1;

implementation

{$R *.dfm}

procedure TDataModule1.groupsDSDataChange(Sender: TObject; Field: TField);

var

sqlStr : string;

begin

sqlStr := 'Select * from Sections,Group_sections where Group_sections.Gs_group_id=' +

groupsTable.FieldByName('Group_id').AsString +

' AND Group_sections.Gs_section_id = Sections.Section_ID';

sectionsQuery.Close;

sectionsQuery.SQL.Text := sqlStr;

sectionsQuery.Open;

end;

end.

Модуль тестирования

unit uClinetLogin;

interface

uses

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

Dialogs, StdCtrls, DBCtrls, ExtCtrls, Buttons, Mask, RxLookup;

type

TautentificationForm = class(TForm)

serverConnectionPanel: TPanel;

userAutentificationPanel: TPanel;

Splitter1: TSplitter;

btnOK: TBitBtn;

btnCancel: TBitBtn;

groupLabel: TLabel;

userNameLabel: TLabel;

passwordLabel: TLabel;

btnNew: TBitBtn;

userNameEdit: TEdit;

userPasswordEdit: TMaskEdit;

groupNameDBLoocupCB: TRxDBLookupCombo;

Edit1: TEdit;

Label1: TLabel;

procedure btnNewClick(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure groupNameDBLoocupCBChange(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

type TUser = record

ID : integer;

grope_ID : integer;

name : string;

code : string;

password : string;

grants : integer;

info : string;

email : string;

end;

var

autentificationForm: TautentificationForm;

currentUser : TUser;

implementation

uses uClientNewUser, uClientDataModule, DB, uClientMain;

{$R *.dfm}

procedure TautentificationForm.btnNewClick(Sender: TObject);

begin

newUserForm.ShowModal;

end;

procedure TautentificationForm.FormShow(Sender: TObject);

begin

ZeroMemory(@currentUser,sizeof(TUser));

userNameEdit.Text := '';

userPasswordEdit.Text := '';

testingForm.StatusBar.Panels[0].Text := '';

end;

procedure TautentificationForm.groupNameDBLoocupCBChange(Sender: TObject);

var

sqlStr : string;

begin

with DataModule1 do

begin

groupQuery.Open;

groupSectionQuery.Open;

sqlStr := 'SELECT Section_ID, Section_name FROM Sections, Group_sections' +

' WHERE Group_sections.Gs_group_id = ' + groupQuery.FieldByName('Group_id').AsString +

' AND Group_sections.Gs_section_id = Sections.Section_ID';

sectionQuery.Close;

sectionQuery.SQL.Text := sqlStr;

sectionQuery.Open;

end;

end;

procedure TautentificationForm.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

var

sqlStr : WideString;

begin

if (Sender as TautentificationForm).ModalResult = mrOk then

begin

if ((userNameEdit.Text = '') or (userPasswordEdit.Text = '')) then

begin

MessageBox(Handle,'Не введен логин или пароль!','Ошибка входа',MB_OK or MB_ICONERROR);

CanClose := false;

end

else

begin

sqlStr := 'SELECT * FROM Users' +

' WHERE User_group_id = ' + DataModule1.groupQuery.FieldByName('Group_ID').AsString +

'AND User_name =' + '''' + userNameEdit.Text +

''' AND User_password = ' + '''' + userPasswordEdit.Text + ''';';

try

DataModule1.userQuery.Close;

DataModule1.userQuery.SQL.Text := sqlStr;

DataModule1.userQuery.Open;

except

on Exception do

begin

ShowMessage('Ошибка выполнения запроса к базе');

exit;

end;

end;

if DataModule1.userQuery.RecordCount = 1 then

begin

with DataModule1.userQuery do

begin

currentUser.ID := FieldByName('User_ID').AsInteger;

currentUser.grope_ID := FieldByName('User_group_ID').AsInteger;

currentUser.name := FieldByName('User_name').AsString;

currentUser.code := FieldByName('User_code').AsString;

currentUser.password := FieldByName('User_password').AsString;

currentUser.grants := FieldByName('User_grants').AsInteger;

currentUser.info := FieldByName('User_info').AsString;

currentUser.email := FieldByName('User_mail').AsString;

userResult.userID := currentUser.ID;

//выводим информацию для пользователя

testingForm.StatusBar.Panels[0].Text := 'Вы вошли как ' + currentUser.name +

' (Группа : ' + DataModule1.groupQuery.FieldByName('Group_name').AsString + ')';

end;

end

else

begin

MessageDlg('Ошибка аутентификации! Пользователь не найден',mtError,mbOKCancel,-1);

CanClose := false;

end;

end;

end;

end;

end.

unit uClientSelectTest;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls, DBCtrls, Buttons, RxLookup, Grids, DBGrids;

type

TtestSelectForm = class(TForm)

testSelectPanel: TPanel;

Splitter1: TSplitter;

testDiscriptionPanel: TPanel;

buttonPanel: TPanel;

Splitter2: TSplitter;

testSectionGroupBox: TGroupBox;

testListGroupBox: TGroupBox;

Splitter3: TSplitter;

testDescriptionGroupBox: TGroupBox;

testAutorGroupBox: TGroupBox;

Splitter4: TSplitter;

btnOk: TBitBtn;

btnCancel: TBitBtn;

testAutorDBMemo: TDBMemo;

testDescriptionDBMemo: TDBMemo;

testSectionDBLB: TRxDBLookupCombo;

RxDBLookupList1: TRxDBLookupList;

procedure testSectionDBLBChange(Sender: TObject);

procedure RxDBLookupList1Click(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

testSelectForm: TtestSelectForm;

implementation

uses uClientDataModule, uClinetLogin, uClientMain;

{$R *.dfm}

procedure TtestSelectForm.FormShow(Sender: TObject);

var

errorMessage : string;

begin

randomize;

if currentUser.ID = 0 then

begin

errorMessage := 'Сначала необходимо пройти процедурц аутентификации' + #10#13 +

'Зарегистрироваться сейчас?';

if MessageBox(Handle,PChar(errorMessage),'Ошибка!!!',MB_YESNO or MB_ICONWARNING) = mrYes then

autentificationForm.ShowModal;

testSelectForm.Close;

end;

end;

procedure TtestSelectForm.testSectionDBLBChange(Sender: TObject);

var

sqlStr : string;

begin

sqlStr := 'SELECT * FROM Tests WHERE Test_section_ID = ' +

DataModule1.sectionQuery.FieldByName('Section_id').AsString;

DataModule1.testQuery.Close;

DataModule1.testQuery.SQL.Text := sqlStr;

DataModule1.testQuery.Open;

// ShowMessage(sqlStr);

end;

procedure TtestSelectForm.RxDBLookupList1Click(Sender: TObject);

var

sqlStr : string;

begin

sqlStr := 'SELECT * FROM Questions WHERE Question_test_id = ' +

DataModule1.testQuery.FieldByName('Test_ID').AsString;

DataModule1.questionQuery.Close;

DataModule1.questionQuery.SQL.Text := sqlStr;

//набор данных откроем после того как пользователь подтвердит выбор

// ShowMessage(sqlStr);

end;

procedure TtestSelectForm.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

var

sqlStr, sqlInsert : string;

begin

if (Sender as TtestSelectForm).ModalResult = mrOk then

begin

with DataModule1.testQuery do

begin

selectedTest.ID := FieldByName('Test_ID').AsInteger;

selectedTest.name := FieldByName('Test_Name').AsString;

selectedTest.testType := FieldByName('Test_type').AsInteger;

selectedTest.quistionLimit := FieldByName('Test_question_limit').AsInteger;

selectedTest.isRandomAnswer := FieldByName('Test_is_random_answers').AsBoolean;

selectedTest.isTimeLimit := FieldByName('Test_is_time_limit').AsBoolean;

selectedTest.timeLimit := FieldByName('Test_time_limit').AsString;

selectedTest.isBack := FieldByName('Test_is_back').AsBoolean

end;

testingForm.StatusBar.Panels[1].Text := 'Выбран тест: ' + selectedTest.name;

if selectedTest.ID <> 0 then

begin

sqlStr := 'SELECT Count(*) FROM Questions WHERE Question_test_id = ' +

IntToStr(selectedTest.ID);

DataModule1.universalQuery.Close;

DataModule1.universalQuery.SQL.Text := sqlStr;

DataModule1.universalQuery.Open;

selectedTest.questionCount := DataModule1.universalQuery.Fields[0].AsInteger;

userResult.testID := selectedTest.ID;

userResult.complited := 0;

userResult.userComplitedQuestion := 1;

userResult.userRightAnswerQuestion := 0;

if selectedTest.questionCount = 0 then

begin

MessageBox(Handle,'В выбранном тесте отсутствуют вопросы','Тестирование невозможно',MB_OK or MB_ICONWARNING);

CanClose := false;

end

else

begin

//формируем массим случайной последовательности вопросов

SetLength(GquestionOrderArray, selectedTest.questionCount); //тут получим размерность массива

testingForm.FillArray(GquestionOrderArray);

//открываем набор данных с вопросами

DataModule1.questionQuery.Open;

userResult.totalQuestion := selectedTest.questionCount;

userResult.timeBegin := now;

sqlInsert := 'INSERT INTO User_results (User_result_User_id,User_result_test_id,' +

'User_result_test_title,User_result_time_begin,User_result_comleted,' +

'User_result_total_questions) VALUES(' + IntToStr(userResult.userID) +

',' + IntToStr(userResult.testID) + ',''' + selectedTest.name + ''',''' +

testingForm.toSQLDateTime(userResult.timeBegin) +

''',0,' + IntToStr(userResult.totalQuestion) +');';

DataModule1.userResultQuery.Close;

DataModule1.userResultQuery.SQL.Text := sqlInsert;

DataModule1.userResultQuery.ExecSQL;

DataModule1.universalQuery.Close;

DataModule1.universalQuery.SQL.Text := 'Select max(user_result_id) from user_results' +

' where user_result_user_id=' + intToStr(currentUser.ID);

DataModule1.universalQuery.Open;

userResult.id := DataModule1.universalQuery.Fields[0].AsInteger;

//ShowMessage(sqlInsert);

end;

end;

end;

end;

end.

unit uClientDataModule;

interface

uses

SysUtils, StdCtrls, Dialogs, Classes, Controls, DB, ADODB, DBClient, MConnect,

SConnect;

type

TDataModule1 = class(TDataModule)

userResultDS: TDataSource;

userAnswerDS: TDataSource;

userDS: TDataSource;

groupDS: TDataSource;

groupSectionDS: TDataSource;

sectionDS: TDataSource;

answerDS: TDataSource;

questionDS: TDataSource;

testDS: TDataSource;

ADOConnection1: TADOConnection;

answerQuery: TADOQuery;

questionQuery: TADOQuery;

testQuery: TADOQuery;

sectionQuery: TADOQuery;

groupSectionQuery: TADOQuery;

groupQuery: TADOQuery;

userQuery: TADOQuery;

userResultQuery: TADOQuery;

userAnswerQuery: TADOQuery;

universalQuery: TADOQuery;

procedure questionQueryAfterScroll(DataSet: TDataSet);

procedure questionQueryBeforeScroll(DataSet: TDataSet);

procedure questionQueryAfterOpen(DataSet: TDataSet);

private

{ Private declarations }

public

procedure setSingleChoicePanelActive;

procedure setMultiChoicePanelActive;

procedure setRandomChoicePanelActive;

procedure setConformPanelActive;

procedure setOrderPanelActive;

function isUserAnswerRight(var answerText : string; questionType : integer) : boolean;

end;

var

DataModule1: TDataModule1;

implementation

uses uClientMain, Forms, CheckLst, ExtCtrls, Grids;

{$R *.dfm}

procedure TDataModule1.setSingleChoicePanelActive;

begin

with testingForm do

begin

SingleChoicePanel.Visible := true;

SingleChoicePanel.Align := alClient;

MultiChoicePanel.Visible := False;

RandomChoicePanel.Visible := false;

ConformPanel.Visible := false;

OrderPanel.Visible := false;

end;

end;

procedure TDataModule1.setMultiChoicePanelActive;

begin

with testingForm do

begin

MultiChoicePanel.Visible := true;

MultiChoicePanel.Align := alClient;

SingleChoicePanel.Visible := False;

RandomChoicePanel.Visible := false;

ConformPanel.Visible := false;

OrderPanel.Visible := false;

end;

end;

procedure TDataModule1.setRandomChoicePanelActive;

begin

with testingForm do

begin

RandomChoicePanel.Visible := true;

RandomChoicePanel.Align := alClient;

MultiChoicePanel.Visible := False;

SingleChoicePanel.Visible := false;

ConformPanel.Visible := false;

OrderPanel.Visible := false;

end;

end;

procedure TDataModule1.setConformPanelActive;

begin

with testingForm do

begin

ConformPanel.Visible := true;

ConformPanel.Align := alClient;

MultiChoicePanel.Visible := False;

RandomChoicePanel.Visible := false;

SingleChoicePanel.Visible := false;

OrderPanel.Visible := false;

end;

end;

procedure TDataModule1.setOrderPanelActive;

begin

with testingForm do

begin

OrderPanel.Visible := true;

OrderPanel.Align := alClient;

MultiChoicePanel.Visible := False;

RandomChoicePanel.Visible := false;

ConformPanel.Visible := false;

SingleChoicePanel.Visible := false;

end;

end;

//--Процедура форимрования понели для ответа пользователя--------

procedure setAnswer(questionType : integer);

var

lineIndex, index : integer;

answerArray : array of integer;

begin

//перемешиваем ответы если необходимо

if selectedTest.isRandomAnswer = true then

begin

SetLength(answerArray,DataModule1.answerQuery.RecordCount);

testingForm.FillArray(answerArray);

end

else

for index := 0 to DataModule1.answerQuery.RecordCount - 1 do

answerArray[index] := index;

if DataModule1.answerQuery.RecordCount > 0 then

begin

//одиночный выбор--------------------------------------------------

if questionType = 0 then

begin

testingForm.SingleChoiceRG.Items.Clear;

for index := 0 to DataModule1.answerQuery.RecordCount - 1 do

begin

DataModule1.answerQuery.RecNo := answerArray[index];

testingForm.SingleChoiceRG.Items.Add(DataModule1.answerQuery.FieldByName('Answer_text').AsString);

end;

DataModule1.setSingleChoicePanelActive;

end

//множественный выбор----------------------------------------------

else if questionType = 1 then

begin

testingForm.MultiChoiceCLB.Items.Clear;

for index := 0 to DataModule1.answerQuery.RecordCount - 1 do

begin

DataModule1.answerQuery.RecNo := answerArray[index];

testingForm.MultiChoiceCLB.Items.Add(DataModule1.answerQuery.FieldByName('Answer_text').AsString);

end;

DataModule1.setMultiChoicePanelActive;

end

//соответствие --------------------------------------------------

else if questionType = 2 then

begin

for lineIndex := 0 to testingForm.conformStringGrid.RowCount - 1 do

testingForm.conformStringGrid.Rows[lineIndex].Clear;

testingForm.conformStringGrid.RowCount := 1;

testingForm.conformStringGrid.ColWidths[0] := 40;

testingForm.conformStringGrid.ColWidths[2] := 40;

testingForm.conformStringGrid.ColWidths[1] := (testingForm.PanelAnswer.Width - 100) div 2;

testingForm.conformStringGrid.ColWidths[3] := (testingForm.PanelAnswer.Width - 100) div 2;

for index := 0 to DataModule1.answerQuery.RecordCount - 1 do

begin

DataModule1.answerQuery.RecNo := answerArray[index];

testingForm.conformStringGrid.Cells[1, index] := DataModule1.answerQuery.FieldByName('Answer_text').AsString;

testingForm.conformStringGrid.RowCount := (index + 1);

end;

DataModule1.answerQuery.First;

index := 0;

while not DataModule1.answerQuery.Eof do

begin

testingForm.conformStringGrid.Cells[2, index] := IntToStr(index + 1);

testingForm.conformStringGrid.Cells[3, index] := DataModule1.answerQuery.FieldByName('Answer_corresp').AsString;

DataModule1.answerQuery.Next;

inc(index);

end;

DataModule1.setConformPanelActive

end

//упорядоченный список-------------------------------------------

else if questionType = 3 then

begin

for lineIndex := 0 to testingForm.orderStringGrid.RowCount - 1 do

testingForm.orderStringGrid.Rows[lineIndex].Clear;

testingForm.orderStringGrid.RowCount := 1;

testingForm.orderStringGrid.ColWidths[0] := 40;

testingForm.orderStringGrid.ColWidths[1] := testingForm.PanelAnswer.Width - 50;

for index := 0 to DataModule1.answerQuery.RecordCount - 1 do

begin

DataModule1.answerQuery.RecNo := answerArray[index];

testingForm.orderStringGrid.Cells[1,index] := DataModule1.answerQuery.FieldByName('Answer_text').AsString;

testingForm.orderStringGrid.RowCount := (index + 1);

end;

DataModule1.setOrderPanelActive;

end

//свободный ввод--------------------------------------------------

else if questionType = 4 then

begin

testingForm.RandomChoiceEdit.Text := '';

DataModule1.setRandomChoicePanelActive;

end

end;

end;

//---------------------------------------------------------------

//--Получаем и анализируем ответ пользователя

function TDataModule1.isUserAnswerRight(var answerText : string; questionType : integer) : boolean;

var

lineIndex,primaryIndex : integer;

lineIsRight,correspIsRignt : boolean;

sqlStr : string;

begin

//выборка правильных ответов для текущего вопроса

sqlStr := 'SELECT Answer_number, Answer_text, Answer_corresp From Answers Where Answer_question_id = ' +

DataModule1.questionQuery.FieldByName('Question_id').AsString + ' AND Answer_is_right = 1';

DataModule1.universalQuery.Close;

DataModule1.universalQuery.SQL.Text := sqlStr;

DataModule1.universalQuery.Open;

Result := false;

//одиночный выбор--------------------------------------------------

if questionType = 0 then

begin

answerText := '';

Result := false;

with testingForm.SingleChoiceRG do

begin

if ItemIndex <> -1 then

answerText := Items.Strings[ItemIndex];

if ((ItemIndex <> -1) and (Items.Strings[ItemIndex] = DataModule1.universalQuery.Fields[1].AsString)) then

Result := True;

end;

end

//множественный выбор----------------------------------------------

else if questionType = 1 then

begin

answerText := '';

for lineIndex := 0 to testingForm.MultiChoiceCLB.Items.Count - 1 do

if testingForm.MultiChoiceCLB.Checked[lineIndex] then

answerText := answerText + #10#13 + testingForm.MultiChoiceCLB.Items.Strings[lineIndex];

Result := false;

DataModule1.universalQuery.First;

while not DataModule1.universalQuery.Eof do

begin

with testingForm.MultiChoiceCLB do

begin

if Checked[Items.IndexOf(DataModule1.universalQuery.FieldByName('Answer_text').AsString)] = true then

Result := true

else

Result := false;

end;

DataModule1.universalQuery.Next;

end;

end

//соответствие --------------------------------------------------

else if questionType = 2 then

begin

answerText := '';

with testingForm.conformStringGrid do

begin

for lineIndex := 0 to RowCount - 1 do

begin

if Cells[0,lineIndex] = '' then

begin

answerText := '';

exit;

end

else

answerText := answerText + #10#13 + Cells[1, lineIndex] + '-' + Cells[3, StrToInt(Cells[0,lineIndex])];

end;

end;

Result := true;

DataModule1.answerQuery.First;

primaryIndex := 0;

while not answerQuery.Eof do

begin

with testingForm.conformStringGrid do

begin

for lineIndex := 0 to RowCount - 1 do

begin

correspIsRignt := false;

if ((Cells[0, lineIndex] = Cells[2,primaryIndex])

and (Cells[1, lineIndex] = DataModule1.answerQuery.FieldByName('Answer_text').AsString)) then

begin

correspIsRignt := true;

break;

end;

end;

end;

Result := Result and correspIsRignt;

DataModule1.answerQuery.Next;

inc(primaryIndex);

end;

end

//упорядоченный список-------------------------------------------

else if questionType = 3 then

begin

answerText := '';

with testingForm.orderStringGrid do

begin

for lineIndex := 0 to RowCount - 1 do

begin

if Cells[0,lineIndex] = '' then

begin

answerText := '';

exit;

end

else

answerText := answerText + #10#13 + Cells[0,lineIndex] + '-' + Cells[1, lineIndex];

end;

end;

Result := true;

for lineIndex := 0 to testingForm.orderStringGrid.RowCount - 1 do

begin

DataModule1.answerQuery.First;

with testingForm.orderStringGrid do

begin

while not DataModule1.answerQuery.Eof do

begin

if ((Cells[0,lineIndex] = DataModule1.answerQuery.FieldByName('Answer_number').AsString)

and

(Cells[1,lineIndex] = DataModule1.answerQuery.FieldByName('Answer_text').AsString)) then

begin

lineIsRight := true;

break;

end

else

lineIsRight := false;

DataModule1.answerQuery.Next;

end;

end;

Result := Result and lineIsRight;

end;

end

//свободный ввод--------------------------------------------------

else if questionType = 4 then

begin

answerText := testingForm.RandomChoiceEdit.Text;

Result := false;

if AnsiLowerCase(testingForm.RandomChoiceEdit.Text) =

AnsiLowerCase(DataModule1.answerQuery.FieldByName('Answer_text').AsString) then

Result := true;

end

end;

//---------------------------------------------------------------

procedure TDataModule1.questionQueryAfterScroll(DataSet: TDataSet);

var

sqlStr : string;

begin

sqlStr := 'SELECT * FROM Answers WHERE Answer_question_id = ' +

questionQuery.FieldByName('Question_id').AsString;

with answerQuery do

begin

Close;

SQL.Text := sqlStr;

Open;

end;

setAnswer(questionQuery.FieldByName('Question_type').AsInteger);

end;

procedure TDataModule1.questionQueryBeforeScroll(DataSet: TDataSet);

{var

insertSql : string;

answerText : string;

answerIsRight, isAnswered : integer;}

begin

{ answerIsRight := 0;

isAnswered := 0;

if DataModule1.isUserAnswerRight(answerText,questionQuery.FieldByName('Question_type').AsInteger) = true then

begin

inc(userResult.userRightAnswerQuestion);

answerIsRight := 1;

end;

if ((answerText <> '') or (answerText <> ' ')) then

isAnswered := 1;

insertSql := 'INSERT INTO User_answers (User_answer_user_result_id, User_answer_qnumber,' +

'User_answer_question, User_answer_answer, User_answer_time, User_answer_is_right, '+

'User_answer_score, User_answer_answered) VALUES (' + intToStr(userResult.id) +

',' + IntToStr(GquestionNumber) + ',' + DataModule1.questionQuery.FieldByName('Question_text').AsString +

',' + answerText + ',00:00,'+ IntToStr(answerIsRight) + ',0,' + IntToStr(isAnswered) + ')';

ShowMessage(insertSql);}

end;

procedure TDataModule1.questionQueryAfterOpen(DataSet: TDataSet);

begin

GquestionNumber := 0;

DataModule1.questionQuery.RecNo := GquestionOrderArray[GquestionNumber];

end;

end.

unit uClientMain;

interface

uses

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

Dialogs, Menus, ComCtrls, ExtCtrls, ToolWin, StdCtrls, ImgList, CheckLst,

Buttons, RxRichEd, DBRichEd, DBCtrls, RXCtrls, Grids, RXGrids;

type

TtestingForm = class(TForm)

StatusBar: TStatusBar;

MainMenu: TMainMenu;

Mtest: TMenuItem;

Mquestion: TMenuItem;

Mhelp: TMenuItem;

MtestLogin: TMenuItem;

MtestBegin: TMenuItem;

MtestStop: TMenuItem;

MquestionPrev: TMenuItem;

MquestionNext: TMenuItem;

MhelpAbout: TMenuItem;

PanelQuestion: TPanel;

PanelAnswer: TPanel;

ToolBar1: TToolBar;

Splitter: TSplitter;

SingleChoicePanel: TPanel;

MultiChoicePanel: TPanel;

RandomChoicePanel: TPanel;

ConformPanel: TPanel;

OrderPanel: TPanel;

SingleChoiceRG: TRadioGroup;

RandomChoiceEdit: TLabeledEdit;

ImageList1: TImageList;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

ToolButton5: TToolButton;

ToolButton6: TToolButton;

ToolButton7: TToolButton;

N1: TMenuItem;

ToolButton8: TToolButton;

ToolButton9: TToolButton;

MultiChoiceCLB: TCheckListBox;

MultiChoiceLabel: TLabel;

questionTextRichEdit: TRxDBRichEdit;

Timer: TTimer;

orderStringGrid: TStringGrid;

orderLabel: TLabel;

conformStringGrid: TStringGrid;

conformLabel: TLabel;

procedure MtestLoginClick(Sender: TObject);

procedure MtestStopClick(Sender: TObject);

procedure MtestBeginClick(Sender: TObject);

procedure MquestionNextClick(Sender: TObject);

procedure PanelAnswerDblClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure RandomChoicePanelResize(Sender: TObject);

procedure MquestionPrevClick(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

{ Private declarations }

public

procedure FillArray(var A: array of Integer);

function toSQLDateTime(dateTime : TDateTime) : string;

{ Public declarations }

end;

TTest = record

ID : integer;

sectionID : integer;

name : string;

discription : string;

author : string;

testType : integer;

questionCount : integer;

quistionLimit : integer;

isRandomAnswer : boolean;

isTimeLimit : boolean;

timeLimit : string;

isBack : boolean;

end;

TUserResult = record

id : integer;

userID : integer;

testID : integer;

timeBegin : TDateTime;

timeEnd : TDateTime;

complited : integer;

userComplitedQuestion : integer;

userRightAnswerQuestion : integer;

score : integer;

totalQuestion : integer;

percentRight : real;

end;

TQuestion = record

ID : integer;

testID : integer;

number : integer;

time : string;

answerQuantity : integer;

queType : integer;

weight : integer;

text : string;

end;

TAnswer = record

questionID : integer;

DBnumber : integer;

localNumber : integer;

text : string;

score : integer;

isRight : boolean;

corresp : array [1..10,1..10] of integer;

end;

var

testingForm: TtestingForm;

selectedTest : TTest;

userResult : TUserResult;

// currentAnswer : TAnswer;

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

GquestionOrderArray : array of integer;

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

GquestionNumber : integer;

implementation

uses uClinetLogin, uClientSelectTest, uClientDataModule;

{$R *.dfm}

//----функция для заполнения массива номеров вопросов--------------

procedure TtestingForm.FillArray(var A: array of Integer);

var

I, S, R: Integer;

begin

for I := 0 to High(A) do

A[I] := I + 1;

for i := High(A) downto 0 do

begin

R := Random(I);

S := A[R];

A[R] := A[I];

A[I] := S;

end;

end;

//-----------------------------------------------------------------

//Преобразуем дату и время в формат SQL Server

function TtestingForm.toSQLDateTime(dateTime : TDateTime) : string;

var

formatSetting : TFormatSettings;

begin

GetLocaleFormatSettings(0,formatSetting);

formatSetting.ShortDateFormat:='mm/dd/yyyy';

formatSetting.DateSeparator := '/';

Result := DateTimeToStr(dateTime,formatSetting);

end;

function toSQLFloat(realDigit : real) : string;

var

formatSetting : TFormatSettings;

begin

GetLocaleFormatSettings(0,formatSetting);

formatSetting.DecimalSeparator := '.';

Result := FormatFloat('0.00',realDigit,formatSetting);

end;

procedure TtestingForm.MtestLoginClick(Sender: TObject);

begin

autentificationForm.ShowModal;

end;

procedure TtestingForm.MtestStopClick(Sender: TObject);

begin

testingForm.Close;

end;

procedure TtestingForm.MtestBeginClick(Sender: TObject);

begin

testSelectForm.ShowModal;

end;

procedure TtestingForm.MquestionNextClick(Sender: TObject);

var

updateSql : string;

// answerText : string;

insertSql : string;

answerText : string;

answerIsRight, isAnswered : integer;

begin

//получение ответа пользователя и занесение его в БД--

answerIsRight := 0;

isAnswered := 0;

if DataModule1.isUserAnswerRight(answerText,DataModule1.questionQuery.FieldByName('Question_type').AsInteger) = true then

begin

inc(userResult.userRightAnswerQuestion);

answerIsRight := 1;

end;

if (answerText <> '') then

isAnswered := 1;

insertSql := 'INSERT INTO User_answers (User_answer_user_result_id, User_answer_qnumber,' +

'User_answer_question, User_answer_answer, User_answer_time, User_answer_is_right, '+

'User_answer_score, User_answer_answered) VALUES (' + intToStr(userResult.id) +

',' + IntToStr(GquestionNumber) + ',''' + DataModule1.questionQuery.FieldByName('Question_header').AsString +

''',''' + answerText + ''',''00:00'','+ IntToStr(answerIsRight) + ',0,' + IntToStr(isAnswered) + ')';

DataModule1.userAnswerQuery.Close;

DataModule1.userAnswerQuery.SQL.Text := insertSql;

DataModule1.userAnswerQuery.ExecSQL;

//ShowMessage(insertSql);

//---------------------------------------------

if GquestionNumber < selectedTest.questionCount - 1 then

begin

inc(GquestionNumber);

inc(userResult.userComplitedQuestion);

StatusBar.Panels[2].Text := 'Вопрос: ' + IntToStr(GquestionNumber + 1) +

' из ' + IntToStr(selectedTest.questionCount);

DataModule1.questionQuery.RecNo := GquestionOrderArray[GquestionNumber];

userResult.complited := 0;

end

else

begin

if DataModule1.isUserAnswerRight(answerText, DataModule1.questionQuery.FieldByName('Question_type').AsInteger) = true then

begin

//ShowMessage('pravilno');

//inc(userResult.userComplitedQuestion);

inc(userResult.userRightAnswerQuestion);

end;

userResult.complited := 1;

userResult.timeEnd := now;

ShowMessage('Тест окончен');

end;

userResult.percentRight := (userResult.userRightAnswerQuestion/userResult.totalQuestion)*100;

//Заносим обновления в базу

updateSql := 'Update User_results Set User_result_completed_questions=' + IntToStr(userResult.userComplitedQuestion) +

',User_result_right_questions=' + IntToStr(userResult.userRightAnswerQuestion) +

',User_result_percent_right=' + toSQLFloat(userResult.percentRight)+

',User_result_comleted=' + IntToStr(userResult.complited) +

' where User_result_id=' + IntToStr(userResult.id);

DataModule1.userResultQuery.Close;

DataModule1.userResultQuery.SQL.Text := updateSql;

DataModule1.userResultQuery.ExecSQL;

if userResult.complited = 1 then

begin

updateSql := 'Update User_results Set User_result_time_end=''' +

testingForm.toSQLDateTime(userResult.timeEnd) +

''' where User_result_id=' + IntToStr(userResult.id);

DataModule1.userResultQuery.Close;

DataModule1.userResultQuery.SQL.Text := updateSql;

DataModule1.userResultQuery.ExecSQL;

end;

end;

procedure TtestingForm.MquestionPrevClick(Sender: TObject);

begin

if ((selectedTest.isBack = true) and (GquestionNumber > 0)) then

begin

dec(GquestionNumber);

dec(userResult.userComplitedQuestion);

StatusBar.Panels[2].Text := 'Вопрос: ' + IntToStr(GquestionNumber + 1) +

' из ' + IntToStr(selectedTest.questionCount);

DataModule1.questionQuery.RecNo := GquestionOrderArray[GquestionNumber];

end

else

MessageBox(Handle,'Возврат невозможен','Ошибка!',MB_OK or MB_ICONWARNING);

end;

procedure TtestingForm.PanelAnswerDblClick(Sender: TObject);

begin

PanelAnswer.Align := alClient;

end;

procedure TtestingForm.FormCreate(Sender: TObject);

begin

SingleChoicePanel.Visible := false;

MultiChoicePanel.Visible := false;

OrderPanel.Visible := false;

ConformPanel.Visible := false;

RandomChoicePanel.Visible := false;

end;

procedure TtestingForm.RandomChoicePanelResize(Sender: TObject);

begin

RandomChoiceEdit.Left := RandomChoicePanel.Left + 5;

RandomChoiceEdit.Top := RandomChoicePanel.Top + 20;

RandomChoiceEdit.Width := RandomChoicePanel.Width - 13;

end;

procedure TtestingForm.FormCloseQuery(Sender: TObject;

var CanClose: Boolean);

begin

if userResult.userComplitedQuestion < userResult.totalQuestion then

begin

if MessageBox(handle,'Вы ответили не на все вопросы. Закрыть приложение?','Внимание!!!',MB_YESNO or MB_ICONWARNING) = mrYes then

CanClose := true

else

CanClose := false;

end;

end;

end.

Размещено на Allbest.ru