Разработка распределенного программного обеспечения для контроля знаний студентов

begin

QFirst;

QSFirst;

LoadQuestion();

LoadAnswer;

LoadIllustration();

ReLoadIllustration();

end;

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

begin

form_private.Show;

form_inquirer.Hide;

end;

procedure TForm_Inquirer.FormCreate(Sender: TObject);

begin

CreateList();

AnswerTop := 15;

end;

procedure TForm_Inquirer.FormDestroy(Sender: TObject);

begin

DestroyObject();

end;

procedure TForm_Inquirer.FormShow(Sender: TObject);

begin

dm.Load_Question();

QFirst();

dm.Last_Selected.id_question := dm.Query_Question.FieldByName('id_question').AsInteger;

dm.Load_S_Question;

QSFirst;

dm.Last_Selected.id_answer := dm.Query_Answer.FieldByName('id_answer').AsInteger;

dm.Load_S_Answer;

ASFirst;

LoadQuestion();

LoadAnswer();

AFirst();

dm.Load_Illustration;

dm.Query_Illustration.First;

ReLoadIllustration();

PanelAnswer.Width := Round(Form_Inquirer.Width * 0.4);

DBIllustrationText.Width := Round(BoxIllustration.Width / 2);

end;

procedure TForm_Inquirer.FreeListAnswer;

var

index: integer;

begin

// Уничтожаем текст

index := 0;

try

while true do

begin

TRichEdit(TextList.Items[index]).Free;

inc(index);

end;

except

;

end;

// Уничтожаем картинки

index := 0;

try

while true do

begin

TImage(ImageList.Items[index]).Free;

inc(index);

end;

except

;

end;

// Уничтожаем сплиты

index := 0;

try

while true do

begin

TSplitter(SplitList.Items[index]).Free;

inc(index);

end;

except

;

end;

// Уничтожаем радиобт

index := 0;

try

while true do

begin

TRadioButton(RadioList.Items[index]).Free;

inc(index);

end;

except

;

end;

// Уничтожаем чекеты

index := 0;

try

while true do

begin

TCheckBox(CheckList.Items[index]).Free;

inc(index);

end;

except

;

end;

// Уничтожаем чекеты stretch / proportional

index := 0;

try

while true do

begin

TCheckBox(CheckStretchList.Items[index]).Free;

inc(index);

end;

except

;

end;

// Уничтожаем панели ответов

index := 0;

try

while true do

begin

TPanel(PanelList.Items[index]).Free;

inc(index);

end;

except

;

end;

// чистим листы ..

try

TextList.Clear;

PanelList.Clear;

SplitList.Clear;

ImageList.Clear;

CheckList.Clear;

CheckStretchList.Clear;

RadioList.Clear;

TextList.Free;

PanelList.Free;

SplitList.Free;

ImageList.Free;

CheckList.Free;

CheckStretchList.Free;

RadioList.Free;

except

;

end;

end;

procedure TForm_Inquirer.dbQGoToNClick(Sender: TObject);

//переход на первый вопрос

begin

dm.Query_Question.RecNo := StrToInt(N_Question.Text);

dm.Query_S_Question.RecNo := StrToInt(N_Question.Text);

LoadQuestion();

LoadAnswer;

LoadIllustration();

ReLoadIllustration();

end;

procedure TForm_Inquirer.InsertAnswer;

// вырисовка...

var

AnswerText: TRichEdit;

AnswerPanel: TsPanel;

AnswerCheck: TsCheckBox;

AnswerCheckStretch: TsCheckBox;

AnswerRadio: TsRadioButton;

AnswerImage: TImage;

AnswerSplitTop,

AnswerSplitBottom,

AnswerSplitRight,

AnswerSplitLeft: TsSplitter;

AnswerSplitBottomPole,

AnswerSplitLeftPole: TsSplitter;

PictureStream: TStream;

begin

//Создаю панель ответа

AnswerPanel := TsPanel.Create(BoxAnswer);

AnswerPanel.Top := AnswerTop;

AnswerPanel.Height := Round((BoxAnswer.Height * 40)/100);

AnswerPanel.Width := BoxAnswer.Width - 25;

AnswerPanel.Left := 5;

AnswerPanel.BorderStyle := bsSingle;

AnswerPanel.BorderWidth := 5;

AnswerPanel.Color := clSilver;

AnswerPanel.Tag := PanelList.Add(AnswerPanel);

BoxAnswer.InsertControl(AnswerPanel);

//Создаю поле под картинку

if dm.Query_Answer.FieldByName('illustration').AsVariant <> '' then

begin

AnswerImage := TImage.Create(AnswerPanel);

AnswerImage.Align := alBottom;

AnswerImage.Height := Round(AnswerPanel.Height / 2 - 6);

AnswerImage.Picture.Assign(dm.Query_Answer.FieldByName('illustration'));

if dm.Query_Answer.FieldByName('propstr').AsInteger = 1 then

begin

AnswerImage.Proportional := true;

AnswerImage.Stretch := true;

end

else

begin

AnswerImage.Proportional := false;

AnswerImage.Stretch := true;

end;

AnswerImage.OnClick := ClickIllustrationAnswer;

AnswerImage.Tag := ImageList.Add(AnswerImage);

IllustrationIndex[AnswerImage.Tag] := dm.Query_Answer.FieldByName('id_answer').AsInteger;

AnswerPanel.InsertControl(AnswerImage);

end;

//Создаю нижний сплит поля

AnswerSplitBottomPole := TsSplitter.Create(AnswerPanel);

AnswerSplitBottomPole.Height := 5;

AnswerSplitBottomPole.Width := 5;

AnswerSplitBottomPole.Align := alBottom;

AnswerSplitBottomPole.Tag := SplitList.Add(AnswerSplitBottomPole);

AnswerPanel.InsertControl(AnswerSplitBottomPole);

if only_one.Checked then

begin

//Создаю зависемый переключатель

AnswerRadio := TsRAdioButton.Create(AnswerPanel);

AnswerRadio.Width := 13 ;

AnswerRadio.Align := alLeft ;

AnswerRadio.Tag := RadioList.Add(AnswerRadio);

if dm.Query_S_Answer.FieldByName('correct').AsInteger = 1 then

begin

AnswerRadio.Checked := true;

end

else

begin

AnswerRadio.Checked := false;

end;

AnswerRadio.OnClick := ClickRadioAnswer;

RadioIndex[AnswerRadio.Tag] := dm.Query_S_Answer.FieldByName('id_s_answer').AsInteger;

AnswerPanel.InsertControl(AnswerRadio);

end

else

begin

//Создаю независемый переключатель

AnswerCheck := TsCheckBox.Create(AnswerPanel);

AnswerCheck.Width := 13 ;

AnswerCheck.Align := alLeft ;

if dm.Query_S_Answer.FieldByName('correct').AsInteger = 1 then

begin

AnswerCheck.Checked := true;

end

else

begin

AnswerCheck.Checked := false;

end;

AnswerCheck.OnClick := ClikCheckAnswer;

AnswerCheck.Tag := CheckList.Add(AnswerCheck);

CheckIndex[AnswerCheck.Tag] := dm.Query_S_Answer.FieldByName('id_s_answer').AsInteger;

AnswerPanel.InsertControl(AnswerCheck);

end;

//Создаю левый сплит

AnswerSplitLeft := TsSplitter.Create(AnswerPanel);

AnswerSplitLeft.Height := 5;

AnswerSplitLeft.Width := 5;

AnswerSplitLeft.Align := alLeft;

AnswerSplitLeft.Visible := false;

AnswerSplitLeft.Tag := SplitList.Add(AnswerSplitLeft);

AnswerPanel.InsertControl(AnswerSplitLeft);

//Создаю поле ответа

AnswerText := TRichEdit.Create(AnswerPanel);

AnswerText.Align := alClient;

AnswerText.BorderStyle := bsSingle;

AnswerText.BorderWidth := 5;

AnswerText.PopupMenu := MenuAnswer;

AnswerText.OnClick := ClikTextAnswer;

AnswerText.OnMouseDown := MouseDownAnswerText;

AnswerText.Tag := TextList.Add(AnswerText);

TextIndex[AnswerText.Tag] := dm.Query_Answer.FieldByName('id_answer').AsInteger;

AnswerPanel.InsertControl(AnswerText);

AnswerText.PlainText := false;

AnswerText.ReadOnly := true;

AnswerText.Lines.Assign(dm.Query_Answer.FieldByName('answer'));

AnswerTop := AnswerTop + Answerpanel.Height + 10;

end;

procedure TForm_Inquirer.dbQLasstClick(Sender: TObject);

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

begin

QLast;

QSLast;

LoadQuestion();

LoadAnswer;

LoadIllustration();

ReLoadIllustration();

end;

procedure TForm_Inquirer.LoadAnswer;

//прорисовываем ответы на форме

var

IndexA: integer;

begin

try

dm.Load_Answer();

dm.Load_S_Answer();

FreeListAnswer();

CreateList();

AnswerTop := 10;

AFirst();

ASFirst();

for IndexA := 1 to dm.Navigator.NavigatorQuestion[IndexQuestion].IndexAmax do

begin

InsertAnswer();

ANext();

ASNext();

end;

except

;

end;

end;

procedure TForm_Inquirer.Loadillustration;

begin

try

dm.Last_Selected.id_question := dm.Query_Question.FieldByName('id_question').AsInteger;

dm.Load_Illustration;

dm.Query_Illustration.First;

except

;

end;

end;

procedure TForm_Inquirer.LoadQuestion;

//загрузка данных вопроса

begin

dm.Last_Selected.id_s_question := dm.Query_S_Question.FieldByName('id_s_question').AsInteger;

dm.Load_Answer();

dm.Load_S_Answer();

QuestionIllustration.Picture := nil;

end;

procedure TForm_Inquirer.MouseDownAnswerText(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

//Нажатие клавиши мыши в поле ответа

begin

SenderRich := Sender;

end;

procedure TForm_Inquirer.QFirst;

begin

IndexQuestion := 1;

dm.Query_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QLast;

begin

IndexQuestion := dm.Navigator.IndexQmax;

dm.Query_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QNext;

begin

if IndexQuestion <> dm.Navigator.IndexQmax then

Inc(IndexQuestion);

dm.Query_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QPrior;

begin

if IndexQuestion <> 1 then

Dec(IndexQuestion);

dm.Query_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QRecNo;

begin

IndexQuestion := StrToInt(N_Question.Text);

dm.Query_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QSFirst;

begin

dm.Query_S_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QSLast;

begin

dm.Query_S_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QSNext;

begin

dm.Query_S_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QSPrior;

begin

dm.Query_S_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.QSRecNo;

begin

dm.Query_S_Question.RecNo := dm.Navigator.NavigatorQuestion[IndexQuestion].No_question;

end;

procedure TForm_Inquirer.dbIFirstClick(Sender: TObject);

begin

dm.Query_Illustration.First;

ReLoadIllustration();

end;

procedure TForm_Inquirer.dbIGoToNClick(Sender: TObject);

begin

dm.Query_Illustration.RecNo := StrToInt(N_illustration.Text);

ReLoadIllustration();

end;

procedure TForm_Inquirer.dbILastClick(Sender: TObject);

begin

dm.Query_Illustration.Last;

ReLoadIllustration();

end;

procedure TForm_Inquirer.ReLoadIllustration;

begin

QuestionIllustration.Picture := nil;

QuestionIllustration.Picture.Assign(dm.Query_Illustration.FieldByName('illustration'));

QuestionIllustration.Stretch := true;

QuestionIllustration.Proportional := propstr.Checked;

end;

procedure TForm_Inquirer.Rendering;

begin

end;

procedure TForm_Inquirer.SaveAnswer;

begin

;

end;

procedure TForm_Inquirer.SaveillustrationQuestion;

begin

end;

procedure TForm_Inquirer.BtnRenderingClick(Sender: TObject);

begin

dm.Rendering();

dm.SetMark();

form_result.Show;

form_result.Result();

form_inquirer.Hide;

end;

procedure TForm_Inquirer.SetSQuestion;

begin

dm.Query_Question.First;

dm.Last_Selected.id_question := dm.Query_Question.FieldByName('id_question').AsInteger;

while not dm.Query_Question.Eof do

begin

dm.Create_S_Question();

dm.Query_Question.Next;

dm.Last_Selected.id_question := dm.Query_Question.FieldByName('id_question').AsInteger;

end;

end;

procedure TForm_Inquirer.dbQNextClick(Sender: TObject);

//переход на следующий вопрос

begin

QNext;

QSNext;

LoadQuestion();

LoadAnswer();

LoadIllustration();

ReLoadIllustration();

end;

procedure TForm_Inquirer.dbQPostClick(Sender: TObject);

begin

try

dm.Query_Question.Post;

except

;

end;

SaveAnswer();

LoadQuestion();

end;

procedure TForm_Inquirer.dbQPriorClick(Sender: TObject);

//переход на предидущий вопрос

begin

QPrior;

QSPrior;

LoadQuestion();

LoadAnswer;

LoadIllustration();

ReLoadIllustration();

end;

procedure TForm_Inquirer.deleteClick(Sender: TObject);

var

ID: integer;

begin

try

ID := TextIndex[TsRichEdit(SenderRich).Tag];

With dm.Query_Delete do

begin

Active := false;

SQL.Clear;

SQL.Add('DELETE FROM answer ') ;

SQL.Add('WHERE id_answer =' + IntToStr(ID));

Active := true;

end;

except

LoadQuestion();

end;

end;

end.

unit unit_private;

interface

uses

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

Dialogs, StdCtrls, Buttons, sBitBtn, ComCtrls, sRichEdit, sLabel, sComboBox,

sGroupBox, sPageControl, DB;

type

Tform_private = class(TForm)

PrivatePage: TsPageControl;

test: TsTabSheet;

sGroupBox1: TsGroupBox;

BoxSubject: TsComboBox;

BoxTheme: TsComboBox;

sLabel1: TsLabel;

sLabel2: TsLabel;

RichSubject: TsRichEdit;

RichTheme: TsRichEdit;

testing: TsBitBtn;

procedure testingClick(Sender: TObject);

procedure BoxThemeChange(Sender: TObject);

procedure BoxSubjectChange(Sender: TObject);

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

procedure FormShow(Sender: TObject);

procedure LoadSubjectBox();

procedure LoadThemeBox();

private

{ Private declarations }

public

{ Public declarations }

end;

var

form_private: Tform_private;

ID_Subject: array[0..1000] of integer;

ID_Theme: array[0..1000] of integer;

implementation

uses

unit_dm, unit_authentication, unit_inquirer;

{$R *.dfm}

procedure Tform_private.BoxSubjectChange(Sender: TObject);

begin

LoadThemeBox();

dm.Query_Subject_Box.Locate('subject', BoxSubject.Text, [loPartialKey]);

RichSubject.Lines.Clear;

RichSubject.Lines.Assign(dm.Query_Subject_Box.FieldByName('info'));

dm.Last_Selected.id_subject := ID_Subject[BoxSubject.ItemIndex];

BoxTheme.Text := 'Выбирите тему';

end;

procedure Tform_private.BoxThemeChange(Sender: TObject);

begin

dm.Query_Theme_Box.Locate('theme', BoxTheme.Text, [loPartialKey]);

RichTheme.Lines.Clear;

RichTheme.Lines.Assign(dm.Query_Theme_Box.FieldByName('info'));

dm.Last_Selected.id_theme := ID_Theme[BoxTheme.ItemIndex];

end;

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

begin

form_private.Hide;

form_authentication.Show;

end;

procedure Tform_private.FormShow(Sender: TObject);

begin

LoadSubjectBox();

BoxSubject.Text := 'Выбирите предмет';

BoxTheme.Text := 'Выбирите тему';

end;

procedure Tform_private.LoadSubjectBox;

var

index: integer;

begin

try

dm.Load_Subject_Box();

BoxSubject.Items.Clear;

dm.Query_Subject_Box.First;

index := 0;

while not dm.Query_Subject_Box.Eof do

begin

BoxSubject.Items.Add(dm.Query_Subject_Box.FieldByName('subject').AsString);

ID_Subject[index] := dm.Query_Subject_Box.FieldByName('id_subject').AsInteger;

dm.Query_Subject_Box.Next;

inc(index);

end;

dm.Query_Subject_Box.First;

BoxSubject.Text := dm.Query_Subject_Box.FieldByName('subject').AsString;

RichSubject.Lines.Assign(dm.Query_Subject_Box.FieldByName('info'));

dm.Last_Selected.id_subject := ID_Subject[BoxSubject.ItemIndex];

except

;

end;

end;

procedure Tform_private.LoadThemeBox;

var

index: integer;

begin

try

dm.Load_Theme_Box(BoxSubject.Text);

BoxTheme.Items.Clear;

dm.Query_Theme_Box.First;

index := 0;

while not dm.Query_Theme_Box.Eof do

begin

BoxTheme.Items.Add(dm.Query_Theme_Box.FieldByName('theme').AsString);

ID_Theme[index] := dm.Query_Theme_Box.FieldByName('id_theme').AsInteger;

dm.Query_Theme_Box.Next;

inc(index);

end;

dm.Query_Theme_Box.First;

BoxTheme.Text := dm.Query_Theme_Box.FieldByName('theme').AsString;

RichTheme.Lines.Assign(dm.Query_Theme_Box.FieldByName('info'));

dm.Last_Selected.id_theme := ID_Theme[BoxTheme.ItemIndex];

except

;

end;

end;

procedure Tform_private.testingClick(Sender: TObject);

begin

if BoxSubject.Text = 'Выбирите предмет' then

begin

ShowMessage('Для продолжения необходимо выбрать предмет !');

exit;

end;

if BoxTheme.Text = 'Выбирите тему' then

begin

ShowMessage('Для продолжения необходимо выбрать тему !');

exit;

end;

try

dm.Last_Selected.id_subject := ID_Subject[BoxSubject.ItemIndex];

dm.Last_Selected.id_theme := ID_Theme[BoxTheme.ItemIndex];

dm.Create_Navigator();

dm.Create_Test_New();

except

ShowMessage('Неудалось загрузить вопросы. Тема пуста или не существует');

end;

dm.Load_Question();

if dm.Query_Question.IsEmpty then

begin

ShowMessage('Неудалось загрузить вопросы. Тема пуста или не существует');

exit ;

end;

form_private.Hide;

form_inquirer.Show;

form_inquirer.dbQFirst.OnClick(Sender);

form_inquirer.dbIFirst.OnClick(Sender);

end;

end.

unit unit_result;

interface

uses

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

Dialogs, StdCtrls, Buttons, sBitBtn, sMemo, sLabel, sEdit, sGroupBox, unit_dm;

type

Tform_result = class(TForm)

Box_Result: TsGroupBox;

Edit_Name: TsEdit;

sLabel1: TsLabel;

Edit_SName: TsEdit;

sLabel2: TsLabel;

Edit_Group: TsEdit;

sLabel3: TsLabel;

Edit_Subject: TsEdit;

sLabel4: TsLabel;

Edit_Theme: TsEdit;

sLabel5: TsLabel;

Edit_Mark_100: TsEdit;

sLabel6: TsLabel;

Edit_Mark_50: TsEdit;

sLabel7: TsLabel;

Edit_Mark_5: TsEdit;

sLabel8: TsLabel;

Box_Note: TsGroupBox;

sLabel9: TsLabel;

MMessage: TsMemo;

Btn_Result: TsBitBtn;

procedure Btn_ResultClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure Result();

procedure SendBettaMesage();// Сохранение пожнланий студента

end;

var

form_result: Tform_result;

implementation

{$R *.dfm}

uses

unit_authentication;

procedure Tform_result.Btn_ResultClick(Sender: TObject);

var

FullProgPath: PChar;

begin

SendBettaMesage();

Hide;

FullProgPath := PChar(Application.ExeName);

WinExec(FullProgPath, SW_SHOW); // Or better use the CreateProcess function

Application.Terminate; // or: Close;

end;

procedure Tform_result.Result;

begin

dm.LoadResult(dm.Last_Selected.id_test);

Edit_SName.Text := dm.Query_Result.FieldByName('sname').AsString;

Edit_Name.Text := dm.Query_Result.FieldByName('name').AsString;

Edit_Group.Text := IntToStr(dm.Query_Result.FieldByName('n_group').AsInteger);

Edit_Subject.Text := dm.Query_Result.FieldByName('subject').AsString;

Edit_Theme.Text := dm.Query_Result.FieldByName('theme').AsString;

Edit_Mark_100.Text := IntToStr(dm.Query_Result.FieldByName('mark_100').AsInteger);

Edit_Mark_50.Text := IntToStr(dm.Query_Result.FieldByName('mark_5').AsInteger);

Edit_Mark_5.Text := IntToStr(dm.Query_Result.FieldByName('mark').AsInteger);

end;

procedure Tform_result.SendBettaMesage;

begin

MMessage.Lines.Insert(0, '--------------------------------------');

MMessage.Lines.Add('--------------------------------------');

MMessage.Lines.Add(Edit_SName.Text);

MMessage.Lines.Add(Edit_Name.Text);

MMessage.Lines.Add(Edit_Group.Text);

MMessage.Lines.Add(Edit_Subject.Text);

MMessage.Lines.Add(Edit_Theme.Text);

MMessage.Lines.Add(Edit_Mark_100.Text);

MMessage.Lines.Add(Edit_Mark_50.Text);

MMessage.Lines.Add(Edit_Mark_5.Text);

MMessage.Lines.Add('--------------------------------------');

dm.Load_Betta();

dm.Query_Betta.Insert;

dm.Query_Betta.FieldByName('message').Assign(MMessage.Lines);

dm.Query_Betta.Post;

MMessage.Lines.Add('--------------------------------------');

end;

end.

unit unit_dm;

interface

uses

SysUtils, Classes, ZConnection, DB, ZAbstractRODataset,

ZAbstractDataset, ZDataset, Dialogs, sSkinManager, ExtDlgs, ZSqlMonitor,

ImgList, Controls, XPMan;

type

TStudent = record

id: integer;

ngr: string;

name: string;

sname: string;

mark: integer;

mark_5: real;

mark_100: real;

end;

TFSetting = record

Host: String[100];

Port: String[100];

Database: String[100];

User: String[100];

Password: String[100];

end;

TSelection = record

id_student: integer;

id_subject: integer;

id_theme: integer;

id_question: integer;

id_answer: integer;

id_test: integer;

id_s_question: integer;

id_s_answer: integer;

end;

TNavigatorQuestion = record

No_question: integer;

IndexAmax: integer;

No_answer: array[1..500] of integer;

end;

TNavigator = record

IndexQmax: integer;

NavigatorQuestion: array[0..500] of TNavigatorQuestion;

end;

Tdm = class(TDataModule)

ZConnection_spkvtk: TZConnection;

Query_login: TZQuery;

Query_Group: TZQuery;

Query_SName: TZQuery;

Query_Name: TZQuery;

SkinManager: TsSkinManager;

Query_Subject_Box: TZQuery;

Query_Theme_Box: TZQuery;

Query_Question: TZQuery;

Query_Answer: TZQuery;

Source_Question: TDataSource;

Source_Answer: TDataSource;

Query_Illustration: TZQuery;

Source_Illustration: TDataSource;

Query_Delete: TZQuery;

Query_Create: TZQuery;

Source_Subject: TDataSource;

Query_Subject: TZQuery;

Query_Theme: TZQuery;

Source_Theme: TDataSource;

OPD: TOpenPictureDialog;

Query_Select: TZQuery;

Query_S_Question: TZQuery;

Query_S_Answer: TZQuery;

Source_S_Question: TDataSource;

Source_S_Answer: TDataSource;

Query_Result: TZQuery;

SQLMonitor: TZSQLMonitor;

IList: TImageList;

Query_Betta: TZQuery;

Query_Skin: TZQuery;

Source_Skin: TDataSource;

OD: TOpenDialog;

XPManifest1: TXPManifest;

procedure DataModuleCreate(Sender: TObject);

procedure ReadSetting(FName: String; Var

Host,

Port,

Database,

User,

Password: String);

procedure ConnectOpros();

procedure Load_Group();//Загруска списка груп

procedure Load_SName(SelectGroup: String);

procedure Load_Name(SelectSName: String);

procedure Load_Subject_Box();

procedure Load_Theme_Box(SelectSubject: String);

function Load_Answer: Boolean;

function Load_Illustration: Boolean;

function Load_Question: Boolean;

function Query_Subject_Set: boolean;

function Query_Theme_Set: Boolean;

procedure Create_Test_New();

procedure Create_S_Question();

procedure Create_S_Answer();

procedure Load_S_Question();

procedure Load_S_Answer();

procedure Create_Navigator();//Заполнения навигационного массива

procedure Rendering();//подсчёт балов

procedure SetMark();//Занесение результатов тестирования в базу данных

procedure LoadResult(id_test: integer);//Получение результатов опроса студента

procedure Load_Betta();//Загрузка таблици пожеланий студентов

function SaveSkin(Path: String): String;//Сохранение скина на диск

procedure ApplySkin(FileName: String);//Применяет скин

procedure LoadSkinOutBD();//Загрузка скина ииз бд

private

{ Private declarations }

Student: TStudent;

public

{ Public declarations }

Last_Selected: TSelection;

Navigator: TNavigator;

procedure Subject_Select(SelectSubject: String);

procedure Theme_Select(ThemeSelect: String);

function log_in(ngr: String;

sname: String;

nam: String): boolean ;

end;

var

dm: Tdm;

implementation

uses unit_start, unit_authentication;

{$R *.dfm}

{ Tdm }

procedure Tdm.ApplySkin(FileName: String);

var

Fname: String;

I: Integer;

Name: String;

Path: String;

begin

Fname := dm.OD.FileName;

if FileExists( FileName ) then

begin

Path := ExtractFilePath(FileName);

Name := ExtractFileName(FileName);

Delete( Name, LastDelimiter( '.', Name ), Length( Name ) );

end

else

Name := '';

dm.SkinManager.SkinDirectory := Path;

dm.SkinManager.SkinName := Name;

dm.SkinManager.Active := true;

end;

procedure Tdm.ConnectOpros;

var

Host: String;

Port: String;

Database: String;

User: String;

Password: String;

begin

try

ReadSetting(ExtractFilePath(ParamStr(0))+'mysql.stg', Host, Port, Database, User, Password);

ZConnection_spkvtk.HostName := Host;

ZConnection_spkvtk.Port := StrToInt(Port);

ZConnection_spkvtk.Database := Database;

ZConnection_spkvtk.User := User;

ZConnection_spkvtk.Password := Password;

except

ShowMessage('Ошибка файла конфигурации');

form_authentication.Close;

end;

try

Zconnection_spkvtk.Connected := true;

except

ShowMessage('Ошибка подключения к базе данных');

form_authentication.Close;

end;

end;

procedure Tdm.Load_Betta();

begin

try

With Query_Betta do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT * FROM betta');

Active := true;

end;

except

;

end;

end;

procedure Tdm.Create_Navigator;

//Заполнения навигационного массива

var

IndexQuestion: integer;

IndexAnswer: integer;

Index: integer;

IndexRndQuestion: array[1..500] of integer;

I: integer;

RndQuestion: boolean;

begin

dm.Load_Question();

Navigator.IndexQmax := dm.Query_Question.RecordCount;

dm.Query_Question.First;

for Index := 1 to Navigator.IndexQmax do

begin

Repeat

RndQuestion := true;

Randomize();

IndexRndQuestion[Index] := Round( Random() * (Navigator.IndexQmax - 1) + 1);

I := 1;

While ( I < Index ) do

begin

if IndexRndQuestion[Index] = IndexRndQuestion[I] then

RndQuestion := false;

Inc(I);

end;

Until ( RndQuestion = true );

end;

for IndexQuestion := 1 to Navigator.IndexQmax do

begin

Navigator.NavigatorQuestion[IndexRndQuestion[IndexQuestion]].No_question := dm.Query_Question.RecNo;

dm.Load_Answer();

Navigator.NavigatorQuestion[IndexRndQuestion[IndexQuestion]].IndexAmax := dm.Query_Answer.RecordCount;

dm.Query_Answer.First;

for IndexAnswer := 1 to Navigator.NavigatorQuestion[IndexRndQuestion[IndexQuestion]].IndexAmax do

begin

Navigator.NavigatorQuestion[IndexRndQuestion[IndexQuestion]].No_answer[IndexAnswer] := dm.Query_Answer.RecNo;

dm.Query_Answer.Next;

end;

dm.Query_Question.Next;

end;

end;

procedure Tdm.Create_S_Answer;

begin

try

With Query_Create do

begin

Active := false;

SQL.Clear;

SQL.Add('INSERT INTO s_answer(id_s_question, id_answer)');

SQL.Add('VALUE(' + IntToStr(last_Selected.id_s_question) + ', ' + IntToStr(last_Selected.id_answer) + ')');

Active := true;

end;

except

;

end;

end;

procedure Tdm.Create_S_Question;

begin

try

With Query_Create do

begin

Active := false ;

SQL.Clear;

SQL.Add('INSERT INTO s_question(id_test, id_question)');

SQL.Add('VALUE(' + IntToStr(Last_Selected.id_test) + ', ' +

IntToStr(Last_Selected.id_question) + ')');

Active := true;

end;

except

;

end;

try

With Query_Create do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT MAX(id_s_question) AS max');

SQL.Add('FROM s_question');

Active := true;

Last_Selected.id_s_question := FieldByName('max').AsInteger;

end;

except

;

end;

end;

procedure Tdm.Create_Test_New;

var

IndexQuestion: integer;

IndexAnswer: integer;

begin

try

With Query_Create do

begin

Active := false ;

SQL.Clear;

SQL.Add('INSERT INTO test(id_student, id_subject, id_theme, date_begin, time_begin)');

SQL.Add('VALUE(' + IntToStr(Last_Selected.id_student) + ', ' +

IntToStr(Last_Selected.id_subject) + ', ' +

IntToStr(Last_Selected.id_theme) + ', ' +

'CURDATE(), ' +

'TIME(NOW()) )');

Active := true;

end;

except

;

end;

try

With Query_Create do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT MAX(id_test) AS max');

SQL.Add('FROM test');

Active := true;

Last_Selected.id_test := FieldByName('max').AsInteger;

end;

except

;

end;

dm.Load_Question();

dm.Query_Question.First;

for IndexQuestion := 1 to Navigator.IndexQmax do

begin

dm.Load_Answer();

dm.Query_Answer.First;

dm.Last_Selected.id_question := dm.Query_Question.FieldByName('id_question').AsInteger;

dm.Create_S_Question();

for IndexAnswer := 1 to Navigator.NavigatorQuestion[IndexQuestion].IndexAmax do

begin

dm.Last_Selected.id_answer := dm.Query_Answer.FieldByName('id_answer').AsInteger;

dm.Create_S_Answer();

dm.Query_Answer.Next;

end;

dm.Query_Question.Next;

end;

end;

procedure Tdm.DataModuleCreate(Sender: TObject);

begin

dm.ConnectOpros();

dm.LoadSkinoutBD();

Sleep(2000);

Form_authentication.Show;

Form_Start.Hide;

end;

procedure Tdm.Load_Group;

begin

try

With Query_Group do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT DISTINCT n_group');

SQL.Add('FROM student');

Active := true;

end;

except

;

end;

end;

procedure Tdm.Load_Name(SelectSName: String);

begin

try

With Query_Name do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT id_student, name');

SQL.Add('FROM student');

SQL.Add('WHERE sname=''' + SelectSName+ '''');

Active := true;

end;

except

;

end;

end;

procedure Tdm.Load_SName(SelectGroup: String);

begin

try

With Query_SName do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT id_student, sname');

SQL.Add('FROM student');

SQL.Add('WHERE n_group= ' + SelectGroup);

Active := true;

end;

except

;

end;

end;

procedure Tdm.Load_Subject_Box;

begin

try

With Query_Subject_Box do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT subject, id_subject, info');

SQL.Add('FROM subject');

SQL.Add('WHERE subject.access = 1');

Active := true;

end;

except

;

end;

end;

procedure Tdm.Load_S_Answer;

begin

try

With Query_S_Answer do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM s_answer') ;

SQL.Add('WHERE id_s_question = ' + IntToStr(Last_Selected.id_s_question));

Active := true;

end;

except

;

end;

end;

procedure Tdm.Load_S_Question;

begin

try

With Query_S_Question do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM s_question') ;

SQL.Add('WHERE id_test = ' + IntToStr(Last_Selected.id_test));

Active := true;

end;

except

;

end;

end;

procedure Tdm.Load_Theme_Box(SelectSubject: String);

begin

try

With Query_Theme_Box do

begin

Active := false ;

SQL.Clear;

SQL.Add('SELECT theme.theme, theme.id_theme, info');

SQL.Add('FROM theme');

SQL.Add('WHERE theme.id_subject IN(');

SQL.Add('SELECT subject.id_subject ' );

SQL.Add('FROM subject ');

SQL.Add('WHERE (subject.subject = ''' + SelectSubject +''' ) and (theme.access = 1))');

Active := true;

end;

except

;

end;

end;

function Tdm.log_in(ngr, sname, nam: String): boolean;

begin

log_in := true;

try

With Query_login do

begin

Active := false ;

SQL.Clear;

SQL.Add('select * from student where ');

SQL.Add('student.n_group=' + ngr + ' and ');

SQL.Add('student.sname="' + sname + '" and ');

SQL.Add('student.name="' + nam + '"');

Active := true;

if Query_login.IsEmpty then log_in := false;

Student.id := FieldByName('id_student').AsInteger;

Last_Selected.id_student := Student.id;

end;

except

log_in := false;

end;

end;

procedure Tdm.ReadSetting(FName: String; var Host, Port, Database, User, Password: String);

var

FSetting: File of TFSetting;

Setting: TFSetting;

begin

AssignFile(FSetting, FName);

Reset(FSetting);

Read(FSetting, Setting);

Host := Setting.Host;

port := Setting.Port;

user := Setting.User;

password := Setting.Password;

database := Setting.Database;

CloseFile(FSetting);

end;

procedure Tdm.Rendering;

var

IndexQuestion: integer;

IndexAnswer: integer;

markanswer: real;

markquestion: real;

ncorrect: integer;

correct: integer;

begin

dm.Load_Question();

dm.Load_S_Question();

dm.Query_Question.First;

dm.Query_S_Question.First;

dm.Last_Selected.id_s_question := dm.Query_S_Question.FieldByName('id_s_question').AsInteger;

markanswer := 0;

markquestion := 0;

for IndexQuestion := 1 to dm.Query_Question.RecordCount do

begin

dm.Last_Selected.id_question := dm.Query_Question.FieldByName('id_question').AsInteger;

dm.Load_Answer();

dm.Last_Selected.id_s_question := dm.Query_S_Question.FieldByName('id_s_question').AsInteger;

dm.Load_S_Answer();

dm.Query_Answer.First;

dm.Query_S_Answer.First;

if dm.Query_Question.FieldByName('only_one').AsInteger = 1 then //Если один ответ

begin

markanswer := 100;

for IndexAnswer := 1 to dm.Query_Answer.RecordCount do

begin

if dm.Query_Answer.FieldByName('correct').AsInteger <> dm.Query_S_Answer.FieldByName('correct').AsInteger then

markanswer := 0;

dm.Query_Answer.Next;

dm.Query_S_Answer.Next;

end;

markquestion := markquestion + markanswer;

dm.Query_Question.Next;

dm.Query_S_Question.Next;

end

else //если ответов много

begin

correct := 0;

ncorrect := 0;

for IndexAnswer := 1 to dm.Query_Answer.RecordCount do

begin

if dm.Query_Answer.FieldByName('correct').AsInteger <> dm.Query_S_Answer.FieldByName('correct').AsInteger then

ncorrect := ncorrect + 1;

if dm.Query_Answer.FieldByName('correct').AsInteger = 1 then

correct := correct + 1;

dm.Query_Answer.Next;

dm.Query_S_Answer.Next;

end;

if correct - ncorrect > 0 then

begin

markanswer := (100 * (correct - ncorrect)) / correct;

end

else

markanswer := 0;

markquestion := markquestion + markanswer;

dm.Query_Question.Next;

dm.Query_S_Question.Next;

end;

end;

Student.mark_100 := markquestion / dm.Query_Question.RecordCount;

Student.mark_5 := (5 * Student.mark_100) / 100;

if (Student.mark_100 <= 31) and (Student.mark_100 >= 0) then

Student.mark := 2;

if (Student.mark_100 <= 55) and (Student.mark_100 >= 32) then

Student.mark := 3;

if (Student.mark_100 <= 74) and (Student.mark_100 >= 56) then

Student.mark := 4;

if (Student.mark_100 <= 100) and (Student.mark_100 >= 75) then

Student.mark := 5;

end;

function Tdm.SaveSkin(Path: String): String;

var

FileName: String;

begin

try

FileName := Path + dm.Query_Skin.FieldByName('name').AsString + '.asz';

(dm.Query_Skin.FieldByName('skin') as TBlobField).SaveToFile(FileName);

SaveSkin := FileName;

except

;

end;

end;

procedure Tdm.SetMark;

begin

try

With Query_Create do

begin

Active := false ;

SQL.Clear;

SQL.Add('UPDATE test SET date_end = CURDATE(), time_end = TIME(NOW()), mark = ' + IntToStr(Student.mark) + ' , mark_5 = ' + IntToStr(Round(Student.mark_5)) + ' , mark_100 = ' + IntToStr(Round(Student.mark_100)) + ' WHERE id_test = ' + IntToStr(Last_Selected.id_test));

Active := true;

end;

except

;

end;

end;

procedure Tdm.Subject_Select(SelectSubject: String);

begin

;

end;

procedure Tdm.Theme_Select(ThemeSelect: String);

begin

;

end;

procedure Tdm.LoadResult(id_test: integer);

begin

try

With Query_Result do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM student, subject, theme, test ') ;

SQL.Add('WHERE test.id_test = ' + IntToStr(id_test) );

SQL.Add(' AND test.id_student = student.id_student');

SQL.Add(' AND test.id_subject = subject.id_subject');

SQL.Add(' AND test.id_theme = theme.id_theme');

Active := true;

end;

except

ShowMessage('Ошибка получения информации об тестировании');

end;

end;

procedure Tdm.LoadSkinOutBD;

var

path: string;

begin

try

With Query_Skin do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM skin') ;

SQL.Add('WHERE priority in (Select max(priority) FROM skin)' );

Active := true;

if Eof then Exit;

Path := ExtractFilePath(ParamStr(0)) + 'temp\';

ApplySkin(SaveSkin(Path));

end;

except

//ShowMessage('Ошибка получения списка вопросов')

end;

end;

function Tdm.Load_Answer: Boolean;

//Загрузка ответа на вопрос

begin

Load_Answer := true;

try

With Query_Answer do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM Answer') ;

SQL.Add('WHERE id_question=' + IntToStr(Query_Question.FieldByName('id_question').AsInteger));

Active := true;

end;

except

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

Load_Answer := false;

end;

end;

function Tdm.Load_Illustration: Boolean;

// загрузка иллюстраций к вопросу

begin

Load_Illustration := true;

try

With Query_illustration do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM q_illustration ') ;

SQL.Add('WHERE id_question=' + IntToStr(Query_Question.FieldByName('id_question').AsInteger));

Active := true;

end;

except

//ShowMessage('Ошибка получения списка иллюстраций');

Load_illustration := false;

end;

end;

function Tdm.Load_Question: Boolean;

//чтение вопросов по предмету

begin

Load_Question := true;

try

With Query_Question do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * ') ;

SQL.Add('FROM Question') ;

SQL.Add('WHERE id_theme=' + IntToStr(Last_Selected.id_theme));

Active := true;

end;

except

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

Load_Question := false;

end;

end;

function Tdm.Query_Subject_Set: boolean;

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

begin

Query_Subject_Set := true;

try

With Query_Subject do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * FROM Subject ') ;

Active := true;

end;

except

ShowMessage('Ошибка получения списка предметов');

Query_Subject_Set := false;

end;

end;

function Tdm.Query_Theme_Set: Boolean;

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

var

id_subject: Integer;

begin

Query_Theme_Set := true;

try

id_subject := Query_Subject.FieldByName('id_subject').AsInteger;

With Query_Theme do

begin

Active := false;

SQL.Clear;

SQL.Add('SELECT * FROM theme WHERE id_subject = ' + IntToStr(id_subject));

Active := true;

end;

except

ShowMessage('Ошибка получения списка тем по данному предмету');

Query_Theme_Set := false;

end;

end;

end.

Приложение В

SQL запросы для создания базы данных тестирования

drop database spkvtk ;

create database spkvtk CHARACTER SET "utf8";

use spkvtk ;

create table subject(

id_subject int auto_increment,

subject varchar(255) not null,

access boolean default false,

info longblob,

primary key(id_subject)

);

create table theme(

id_theme int auto_increment,

id_subject int not null,

theme varchar(255) not null,

maximum tinyint default 5,

mix_question boolean default true,

access boolean default false,

info longblob,

primary key(id_theme),

foreign key(id_subject) references subject(id_subject) on delete cascade

);

create table question(

id_question int auto_increment,

id_theme int not null,

question longblob,

only_one boolean default true,

mix_answer boolean default true,

primary key(id_question),

foreign key(id_theme) references theme(id_theme) on delete cascade

);

create table q_illustration(

id_q_illustration int auto_increment,

id_question int,

illustration longblob,

propstr boolean default true,

description longblob,

primary key(id_q_illustration),

foreign key(id_question) references question(id_question) on delete cascade

);

create table answer(

id_answer int auto_increment,

id_question int not null,

answer longblob,

illustration longblob,

propstr boolean default true,

correct boolean default false,

primary key(id_answer),

foreign key(id_question) references question(id_question) on delete cascade

);

create table student(

id_student int auto_increment,

name varchar(255) not null,

sname varchar(255) not null,

n_group smallint not null,

primary key(id_student)

);

create table test(

id_test int auto_increment,

id_student int not null,

id_subject int not null,

id_theme int not null,

date_begin date not null,

date_end date,

time_begin time not null,

time_end time,

mark int,

mark_5 decimal(6, 2),

mark_100 decimal(6, 2),

primary key(id_test),

foreign key(id_subject) references subject(id_subject) on delete cascade,

foreign key(id_theme) references theme(id_theme) on delete cascade

);

create table s_question(

id_s_question int auto_increment,

id_question int not null,

id_test int not null,

primary key(id_s_question),

foreign key(id_test) references test(id_test) on delete cascade,

foreign key(id_question) references question(id_question) on delete cascade

);

create table s_answer(

id_s_answer int auto_increment,