Приложение б
Образцы экранных форм
Рисунок Б.1 – Главная форма редактора тестов
Рисунок Б.2 – Реакция системы на потенциальную логическую ошибку
Рисунок Б.3 – Главная форма модуля администрирования пользователей
Рисунок Б.4 – Окно аутентификации пользователя модуля тестирования
Рисунок Б.5 – Окно выбора теста модуля тестирования
Приложение в
Текст программных модулей
Модуль редактора тестов
unit uEditorDataModule;
interface
uses
SysUtils, Windows, Dialogs, Messages, Classes, DB, ADODB;
type
TDataModule1 = class(TDataModule)
ADOConnection: TADOConnection;
tabelSections: TADOTable;
tabelTests: TADOTable;
tabelQuestions: TADOTable;
tabelAnswers: TADOTable;
dsSections: TDataSource;
dsTests: TDataSource;
dsQuestions: TDataSource;
dsAnswers: TDataSource;
tabelTestsTest_ID: TAutoIncField;
tabelTestsTest_section_ID: TIntegerField;
tabelTestsTest_name: TStringField;
tabelTestsTest_description: TStringField;
tabelTestsTest_author: TStringField;
tabelTestsTest_type: TIntegerField;
tabelTestsTest_question_count: TIntegerField;
tabelTestsTest_question_limit: TIntegerField;
tabelTestsTest_is_random_answers: TBooleanField;
tabelTestsTest_is_time_limit: TBooleanField;
tabelTestsTest_time_limit: TStringField;
tabelTestsTest_is_back: TBooleanField;
universalQuery: TADOQuery;
userQuery: TADOQuery;
dsUser: TDataSource;
groupQuery: TADOQuery;
dsGroup: TDataSource;
procedure dsSectionsDataChange(Sender: TObject; Field: TField);
procedure dsTestsDataChange(Sender: TObject; Field: TField);
procedure dsQuestionsDataChange(Sender: TObject; Field: TField);
procedure dsQuestionsStateChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DataModule1: TDataModule1;
implementation
uses uEditorMain, StdCtrls, Controls;
{$R *.dfm}
procedure TDataModule1.dsSectionsDataChange(Sender: TObject;
Field: TField);
begin
ZeroMemory(@currentSection, sizeof(TSection));
currentSection.ID := tabelSections.FieldByName('Section_ID').AsInteger;
currentSection.Name := tabelSections.FieldByName('Section_name').AsString;
end;
procedure TDataModule1.dsTestsDataChange(Sender: TObject; Field: TField);
begin
if tabelTests.State = dsBrowse then
begin
teacherForm.testTypeCB.ItemIndex := tabelTests.FieldByName('Test_type').AsInteger;
teacherForm.timeLimitEdit.Text := tabelTests.FieldByName('Test_Time_limit').AsString;
end;
end;
procedure TDataModule1.dsQuestionsDataChange(Sender: TObject;
Field: TField);
begin
if tabelQuestions.State = dsBrowse then
begin
teacherForm.questionTypeCB.ItemIndex := tabelQuestions.FieldByName('Question_type').AsInteger;
teacherForm.questionTimLimitEdit.Text := tabelQuestions.FieldByName('Question_time').AsString;
end;
with teacherForm do
begin
if questionTypeCB.ItemIndex in [0, 1, 4] then
begin
answerNumberLabel.Visible := false;
answerScoreLabel.Visible := false;
answerNumberEdit.Visible := false;
answerScoreEdit.Visible := false;
answerCorrespLabel.Visible := false;
answerCorrespMemo.Visible := false;
//--------------------------------
answerTextLabel.Visible := true;
answerTextLabel.Left := answerPanel.Left + 5;
answerTextMemo.Left :=answerDBCtrlGrid.Left + 5;
answerTextMemo.Width := answerDBCtrlGrid.Width - 80;
answerDBCtrlGrid.Refresh;
end
else if questionTypeCB.ItemIndex = 2 then
begin
answerNumberLabel.Visible := false;
answerScoreLabel.Visible := false;
answerNumberEdit.Visible := false;
answerScoreEdit.Visible := false;
//---------------------------------------
answerTextLabel.Visible := true;
answerTextLabel.Left := answerDBCtrlGrid.Left + 5;
answerTextMemo.Left :=answerDBCtrlGrid.Left + 5;
answerTextMemo.Width := (answerDBCtrlGrid.Width - 80) div 2;
answerCorrespLabel.Visible := true;
answerCorrespLabel.Left := answerDBCtrlGrid.Left + answerTextMemo.Width + 20;
answerCorrespMemo.Visible := true;
answerCorrespMemo.Left := answerCorrespLabel.Left;
answerCorrespMemo.Width := answerTextMemo.Width - 30;
answerDBCtrlGrid.Refresh;
end
else if questionTypeCB.ItemIndex = 3 then
begin
answerScoreLabel.Visible := false;
answerScoreEdit.Visible := false;
answerCorrespLabel.Visible := false;
answerCorrespMemo.Visible := false;
//---------------------------------
answerNumberLabel.Visible := true;
answerNumberEdit.Visible := true;
answerNumberLabel.Left := answerDBCtrlGrid.Left + 5;
answerNumberEdit.Left := answerNumberLabel.Left;
answerTextLabel.Left := answerDBCtrlGrid.Left + 70;
answerTextMemo.Left := answerTextLabel.Left;
answerTextMemo.Width := answerDBCtrlGrid.Width - answerTextMemo.Left - 80;
answerDBCtrlGrid.Refresh;
end
end;
end;
procedure TDataModule1.dsQuestionsStateChange(Sender: TObject);
begin
if tabelQuestions.State = dsEdit then
teacherForm.answerPanel.Enabled := false
else
teacherForm.answerPanel.Enabled := true;
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 uEditorMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ToolWin, ComCtrls, ExtCtrls, StdCtrls, DBCtrls, Grids,
DBGrids, Mask, Buttons, dbcgrids, ActnList, XPStyleActnCtrls, ActnMan,
StdActns, ExtActns, ActnCtrls, XPMan, ImgList, RxCombos, RxRichEd,
DBRichEd, AppEvent, SpeedBar, RxLookup, ToolEdit, RXDBCtrl;
type
TteacherForm = class(TForm)
MainMenu: TMainMenu;
mFile: TMenuItem;
mTest: TMenuItem;
mUsers: TMenuItem;
mOptions: TMenuItem;
mHelp: TMenuItem;
mTQuestion: TMenuItem;
mTAnswer: TMenuItem;
mTQueAdd: TMenuItem;
mTQueDel: TMenuItem;
N5: TMenuItem;
mTQueFirst: TMenuItem;
mTQuePrev: TMenuItem;
mTQueNext: TMenuItem;
mTQueLast: TMenuItem;
mTAnsAdd: TMenuItem;
mTAnsDel: TMenuItem;
StatusBar: TStatusBar;
ToolBar1: TToolBar;
XPManifest1: TXPManifest;
ImageList1: TImageList;
ActionList1: TActionList;
ColorDialog1: TColorDialog;
RichEditBold1: TRichEditBold;
RichEditItalic1: TRichEditItalic;
RichEditUnderline1: TRichEditUnderline;
RichEditStrikeOut1: TRichEditStrikeOut;
RichEditBullets1: TRichEditBullets;
RichEditAlignLeft1: TRichEditAlignLeft;
RichEditAlignRight1: TRichEditAlignRight;
RichEditAlignCenter1: TRichEditAlignCenter;
PageControl: TPageControl;
tabTest: TTabSheet;
Splitter2: TSplitter;
Splitter3: TSplitter;
topPanel: TPanel;
Splitter1: TSplitter;
testOptionsPanel: TPanel;
discriptionLabel: TLabel;
authorLabel: TLabel;
testTypeLabel: TLabel;
discriptionMemo: TDBMemo;
authorEdit: TDBEdit;
optionGB: TGroupBox;
isRandomAnswersCB: TDBCheckBox;
isTimeLimitCB: TDBCheckBox;
isBackCB: TDBCheckBox;
timeLimitEdit: TComboEdit;
testTypeCB: TComboBox;
btnNewTest: TBitBtn;
btnDelTest: TBitBtn;
btnTestAccept: TBitBtn;
btnTestCancel: TBitBtn;
btnNewSection: TBitBtn;
selectTestPanel: TPanel;
testGB: TGroupBox;
testLookupList: TRxDBLookupList;
sectionGB: TGroupBox;
sectionLookupCB: TRxDBLookupCombo;
rightDownPanel: TPanel;
Splitter4: TSplitter;
answerPanel: TPanel;
answerNumberLabel: TLabel;
answerTextLabel: TLabel;
answerIsRightLabel: TLabel;
answerScoreLabel: TLabel;
answerCorrespLabel: TLabel;
answerDBCtrlGrid: TDBCtrlGrid;
answerIsRightCheck: TDBCheckBox;
answerTextMemo: TDBMemo;
answerScoreEdit: TDBEdit;
answerNumberEdit: TDBEdit;
answerCorrespMemo: TDBMemo;
answerNavigator: TDBNavigator;
questionDetailPanel: TPanel;
questionHeaderLabel: TLabel;
questionTypeLabel: TLabel;
questinWeightLabel: TLabel;
questionTimeLimitLabel: TLabel;
questionHeaderEdit: TDBEdit;
questionTypeCB: TComboBox;
questionWeightEdit: TDBEdit;
ToolBar2: TToolBar;
fontsComboBox: TFontComboBox;
ToolButton10: TToolButton;
fontSizeComboBox: TComboBox;
tbBold: TToolButton;
tbItalic: TToolButton;
tbUnderline: TToolButton;
ToolButton4: TToolButton;
tbLeft: TToolButton;
tbCenter: TToolButton;
tbRight: TToolButton;
ToolButton8: TToolButton;
tbBullets: TToolButton;
ToolButton11: TToolButton;
tbInsertObject: TToolButton;
btnQuestAccept: TBitBtn;
btnQuestCancel: TBitBtn;
questionTextEdit: TRxDBRichEdit;
questionTimLimitEdit: TRxDBComboEdit;
leftDownPanel: TPanel;
questionGrid: TDBGrid;
questionNavigator: TDBNavigator;
procedure isTimeLimitCBClick(Sender: TObject);
procedure btnTestAcceptClick(Sender: TObject);
procedure btnNewSectionClick(Sender: TObject);
procedure btnNewTestClick(Sender: TObject);
procedure btnDelTestClick(Sender: TObject);
procedure answerNavigatorClick(Sender: TObject; Button: TNavigateBtn);
procedure fontsComboBoxChange(Sender: TObject);
procedure fontSizeComboBoxChange(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure btnTestCancelClick(Sender: TObject);
procedure btnQuestAcceptClick(Sender: TObject);
procedure btnQuestCancelClick(Sender: TObject);
procedure questionTextEditEnter(Sender: TObject);
procedure tbBoldClick(Sender: TObject);
procedure tbItalicClick(Sender: TObject);
procedure tbUnderlineClick(Sender: TObject);
procedure questionTextEditSelectionChange(Sender: TObject);
procedure tbLeftClick(Sender: TObject);
procedure tbCenterClick(Sender: TObject);
procedure tbInsertObjectClick(Sender: TObject);
procedure questionNavigatorClick(Sender: TObject;
Button: TNavigateBtn);
procedure FormActivate(Sender: TObject);
private
function CurrText: TRxTextAttributes;
{ Private declarations }
public
{ Public declarations }
end;
TSection = record
ID : integer;
Name : string;
end;
TTest = record
ID : integer;
sectionID : integer;
name : string;
discription : string;
author : string;
testType : integer;
questionCount : integer;
quistionLimit : integer;
isRandomAnswer : boolean;
timeIsLimit : boolean;
timeLimit : string;
isBack : boolean;
end;
TQuestion = record
ID : integer;
testID : integer;
number : integer;
time : string;
answerQuantity : integer;
queType : integer;
weight : integer;
text : string;
picture : TMemoryStream;
end;
TAnswer = record
ID : integer;
questionID : integer;
number : integer;
text : string;
score : integer;
isRight : boolean;
corresp : array [1..10,1..10] of integer;
picture : TMemoryStream;
end;
var
teacherForm: TteacherForm;
currentSection, newSection : TSection;
currentTest, newTest : TTest;
currentQuestion, newQuestion : TQuestion;
currentAnswer, newAnswer : TAnswer;
sqlString : string;
implementation
uses uEditorDataModule, DB, ADODB, Math, uEditorAutentification;
{$R *.dfm}
function TteacherForm.CurrText: TRxTextAttributes;
begin
if questionTextEdit.SelLength > 0 then
Result := questionTextEdit.SelAttributes
else
Result := questionTextEdit.DefAttributes;
end;
procedure TteacherForm.isTimeLimitCBClick(Sender: TObject);
begin
if isTimeLimitCB.Checked = true then
timeLimitEdit.Enabled := True
else
timeLimitEdit.Enabled := False;
end;
procedure TteacherForm.btnTestAcceptClick(Sender: TObject);
begin
try
with DataModule1.tabelTests do
begin
Edit;
FieldByName('Test_type').AsInteger := testTypeCB.ItemIndex;
FieldByName('Test_time_limit').AsString := timeLimitEdit.Text;
Post;
Refresh;
end;
except
end;
end;
procedure TteacherForm.btnNewSectionClick(Sender: TObject);
begin
newSection.Name := InputBox('Создание нового раздела','Введите название раздела','');
if newSection.Name <> '' then
begin
sqlString := 'INSERT INTO Sections (Section_name)' +
'VALUES (''' + newSection.Name + ''')';
try
DataModule1.universalQuery.SQL.Clear;
DataModule1.universalQuery.SQL.Text := sqlString;
DataModule1.universalQuery.ExecSQL;
DataModule1.tabelSections.Close;
DataModule1.tabelSections.Open;
except
on exception do
MessageBox(Handle, 'Ошибка создания раздела', 'Ошибка', MB_OK or MB_ICONERROR);
end;
end
end;
procedure TteacherForm.btnNewTestClick(Sender: TObject);
begin
newTest.name := InputBox('Создание нового теста','Введите название теста','');
if newTest.name <> '' then
begin
sqlString := 'INSERT INTO Tests (Test_section_ID,Test_name)' +
'VALUES (' + DataModule1.tabelSections.FieldByName('Section_ID').AsString +
',''' + newTest.name + ''')';
try
with DataModule1.universalQuery do
begin
SQL.Clear;
SQL.Text := sqlString;
ExecSQL;
end;
DataModule1.tabelTests.Close;
DataModule1.tabelTests.Open;
except
on exception do
MessageBox(Handle, 'Ошибка создания теста', 'Ошибка', MB_OK or MB_ICONERROR);
end;
end;
end;
procedure TteacherForm.btnDelTestClick(Sender: TObject);
begin
sqlString := 'DELETE FROM Tests WHERE Test_ID = '+
DataModule1.tabelTests.FieldByName('Test_ID').AsString;
with DataModule1.universalQuery do
begin
SQL.Clear;
SQL.Text := sqlString;
ExecSQL;
end;
DataModule1.tabelTests.Close;
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