Обучающе-контроллирующая система для подготовки студентов

procedure butOkClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

WinEditTema: TWinEditTema;

implementation

{$R *.DFM}

procedure TWinEditTema.butCancelClick(Sender: TObject);

begin

Modalresult:= mrCancel;

end;

procedure TWinEditTema.butOkClick(Sender: TObject);

begin

Modalresult:= mrOk;

end;

end.

Текст модуля ProgrInd

unit progrInd;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls, ComCtrls;

type

TProcessForm = class(TForm)

Bevel1: TBevel;

ProgressBar: TProgressBar;

private

{ Private declarations }

public

{ Public declarations }

end;

var

ProcessForm: TProcessForm;

implementation

{$R *.DFM}

end.

Приложение 2

ТЕКСТ ПРОГРАММЫ TESTADMIN

program TestAdmin;

uses

Forms,

main in 'main.pas' {AdminForm},

TQDialog in 'TQDialog.pas' {CreateTickDlg},

ResultReport in 'ResultReport.pas' {ReportForm};

{$R *.RES}

begin

Application.Title:= 'TestAdmin';

Application.CreateForm(TAdminForm, AdminForm);

Application.CreateForm(TCreateTickDlg, CreateTickDlg);

Application.CreateForm(TReportForm, ReportForm);

Application.Run;

end.

Текст модуля Main

unit main;

interface

uses

Dialogs,IniFiles,SysUtils,Forms, DB, DBTables, Classes, Controls, Grids, DBGrids,

StdCtrls, Spin, ExtCtrls,Windows, Buttons, ComCtrls;

type

TAdminForm = class(TForm)

ControlSource: TDataSource;

DBControl: TTable;

DBControlId: TAutoIncField;

DBControlName: TStringField;

DBControlMark: TFloatField;

DBControlDate: TDateField;

DBControlTime: TTimeField;

Journal: TDBGrid;

DBControlTicket_num: TIntegerField;

DBControlOcenka: TFloatField;

Maxmark: TSpinEdit;

TestTime: TSpinEdit;

TimeLabel: TLabel;

MarkLabel: TLabel;

CreateTicketBtn: TBitBtn;

Bevel1: TBevel;

QuitBtn: TBitBtn;

ClearBtn: TBitBtn;

PrintBtn: TBitBtn;

Bevel2: TBevel;

Label1: TLabel;

StatusBar: TStatusBar;

procedure ShowHint(Sender: TObject);

procedure DBControlCalcFields(DataSet: TDataSet);

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

procedure TestTimeChange(Sender: TObject);

procedure MaxmarkChange(Sender: TObject);

procedure CreateTicketBtnClick(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure QuitBtnClick(Sender: TObject);

procedure CreateNewDBControl;

procedure ClearBtnClick(Sender: TObject);

procedure PrintBtnClick(Sender: TObject);

private

CreateForm: boolean;

public

IniFile: TIniFile;

end;

var

AdminForm: TAdminForm;

implementation

uses TQDialog, PathDialog, ResultReport;

{$R *.DFM}

procedure TAdminForm.ShowHint(Sender: TObject);

begin

StatusBar.SimpleText:= Application.Hint;

end;

procedure TAdminForm.DBControlCalcFields(DataSet: TDataSet);

begin

DBControl.Fields[3].AsFloat:= DBControl.Fields[2].AsFloat * MaxMark.Value; // fields[2] - 'Mark'

end;

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

begin

IniFile.Free;

Action:= caFree;

end;

procedure TAdminForm.TestTimeChange(Sender: TObject);

begin

IniFile.WriteInteger('Options', 'TestTime', TestTime.Value * 60000);

end;

procedure TAdminForm.MaxmarkChange(Sender: TObject);

begin

IniFile.WriteInteger('Options', 'MaxMark',MaxMark.Value);

end;

procedure TAdminForm.CreateTicketBtnClick(Sender: TObject);

begin

CreateTickDlg.ShowModal;

end;

procedure TAdminForm.CreateNewDBControl;

{создает новую таблицу DBControl. изменяет состояние DBControl.Active:= False}

begin

//--------- Create new local table CONTROL.DB --------------

with DBControl do

begin

Active:= False;

DatabaseName:= 'Common_base';

TableName:= 'Control';

TableType:= ttParadox;

with FieldDefs do

begin

Clear;

Add('Id',ftAutoInc, 0, False);

Add('Ticket_num', ftInteger, 0, False);

Add('Name',ftString, 40, False);

Add('Mark',ftFloat, 0, False);

Add('Date',ftDate, 0, False);

Add('Time',ftTime, 0, False);

end;

with IndexDefs do

begin

Clear;

Add('Id', 'Id', [ixPrimary, ixUnique]);

end;

CreateTable;

end;

//--------- end of create -------------------------

end;

procedure TAdminForm.FormShow(Sender: TObject);

Var

List: TStrings;

AliasPath: string;

begin

If CreateForm then

begin

Session.ConfigMode:= cmAll; {Global and local aliases !!!}

try

List:= TStringList.Create;

Session.GetAliasParams('Common_base',List); // may be occurs an error

AliasPath:= List.Values['PATH'];

List.Free;

except

end;

IniFile:= TIniFile.Create(AliasPath+'\Test.INI');

TestTime.Value:= IniFile.ReadInteger('Options', 'TestTime', 600000{10 min})div 60000;

MaxMark.Value:= IniFile.ReadInteger('Options', 'MaxMark', 5);

// CreateTickDlg.MaxTicket.Value:= IniFile.ReadInteger('Options', 'MaxTicket', 1);

try

DBControl.Active:= True;

except

CreateNewDBControl;

DBControl.Active:= True;

end;

CreateForm:= False;

end;

end;

procedure TAdminForm.FormCreate(Sender: TObject);

begin

CreateForm:= True;

Application.OnHint:= ShowHint;

end;

procedure TAdminForm.QuitBtnClick(Sender: TObject);

begin

Close;

end;

procedure TAdminForm.ClearBtnClick(Sender: TObject);

begin

CreateNewDBControl;

DBControl.Active:= True;

end;

procedure TAdminForm.PrintBtnClick(Sender: TObject);

begin

ReportForm.QuickReport.Preview;

end;

end.

Текст модуля TQDialog

unit TQDialog;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls, Spin, DB, DBTables, Grids, DBGrids;

type

TCreateTickDlg = class(TForm)

OKBtn: TBitBtn;

CancelBtn: TBitBtn;

Bevel1: TBevel;

QuestCount: TSpinEdit;

MaxTicket: TSpinEdit;

TickLabel: TLabel;

QuestLabel: TLabel;

DBGrid1: TDBGrid;

DBTicket: TTable;

TicketSource: TDataSource;

TemaSource: TDataSource;

DBTema: TTable;

DBQuest: TTable;

QuestSource: TDataSource;

procedure QuestCountEnter(Sender: TObject);

procedure OKBtnClick(Sender: TObject);

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

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

CreateTickDlg: TCreateTickDlg;

implementation

uses main;

{$R *.DFM}

procedure TCreateTickDlg.QuestCountEnter(Sender: TObject);

begin

QuestCount.MaxValue:= DBQuest.RecordCount;

If QuestCount.MaxValue >1 then QuestCount.Increment:=1

else

begin

QuestCount.Value:= QuestCount.MaxValue;

QuestCount.Increment:= 0;

end;

end;

procedure TCreateTickDlg.OKBtnClick(Sender: TObject);

Var

List,List2: TList;

i,j,n: longint;

begin

//--------- Create new empty table TICKETS.DB --------------

with DBTicket do

begin

Active:= False;

DatabaseName:= 'Common_base';

TableName:= 'Tickets';

TableType:= ttParadox;

IndexName:= 'many_ind';

with FieldDefs do

begin

Clear;

Add('Ticket_id', ftAutoInc, 0, False);

Add('Ticket_num', ftInteger, 0, False);

Add('Quest_id', ftInteger, 0, False);

end;

with IndexDefs do

begin

Clear;

Add('', 'Ticket_id', [ixPrimary, ixUnique]);

Add('many_ind','Ticket_num;Quest_id',[ixCaseInsensitive]);

end;

CreateTable;

end;

//--------- end of create -------------------------

DBTicket.Active:= True;

DBQuest.First;

List:= TList.Create;

List2:= TList.Create;

for i:=1 to CreateTickDlg.QuestCount.Value do

begin

for j:=1 to CreateTickDlg.MaxTicket.Value do List.Add(pointer(j)); // fill list

randomize;

repeat

n:= random(List.Count-1);

DBTicket.SetKey;

DBTicket['Ticket_num']:= longint(List.Items[n]);

DBTicket['Quest_id']:= DBQuest['Quest_id'];

If DBTicket.GotoKey then

begin

List2.Add(List.Items[n]);

List.Delete(n);

Continue;

end

else

begin

DBTicket.Append;

DBTicket['Ticket_num']:= longint(List.Items[n]);

DBTicket['Quest_id']:= DBQuest['Quest_id'];

DBTicket.Post;

DBQuest.Next; If DBQuest.EOF then DBQuest.First;

List.Delete(n); //List.Pack;

While (List2.count > 0) do

begin

List.Add(List2.Items[0]);

List2.Delete(0);

end;

end;

until List.Count = 0;

end;

DBTicket.IndexName:= '';

DBTicket.DeleteIndex('many_ind');

DBTicket.AddIndex('tick_ind','Ticket_num',[ixCaseInsensitive]);

DBTicket.Active:= False;

List.Free;

List2.Free;

AdminForm.IniFile.WriteInteger('Options', 'MaxTicket',MaxTicket.Value);

Application.MessageBox('Формирование билетов завершено!','',MB_ICONINFORMATION);

end;

procedure TCreateTickDlg.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

DBQuest.Active:= False;

DBTema.Active:= False;

end;

procedure TCreateTickDlg.FormShow(Sender: TObject);

begin

DBTema.Active:= True;

DBQuest.Active:= True;

end;

end.

Текст модуля ResultReport

unit ResultReport;

interface

uses

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

Quickrep, StdCtrls, ExtCtrls;

type

TReportForm = class(TForm)

QuickReport: TQuickReport;

PageHeader: TQRBand;

Detail: TQRBand;

QRLabel1: TQRLabel;

TicketField: TQRDBText;

NameField: TQRDBText;

OcenkaField: TQRDBText;

DateField: TQRDBText;

ColumnHeader: TQRBand;

QRLabel2: TQRLabel;

QRLabel3: TQRLabel;

CurrentNum: TQRSysData;

QRLabel4: TQRLabel;

QRLabel5: TQRLabel;

QRLabel6: TQRLabel;

QRBand1: TQRBand;

QRLabel7: TQRLabel;

PageNum: TQRSysData;

private

{ Private declarations }

public

{ Public declarations }

end;

var

ReportForm: TReportForm;

implementation

uses main;

{$R *.DFM}

end.

Приложение 3

ТЕКСТ ПРОГРАММЫ TESTCLIENT

program TestClient;

uses

Forms,

Sdimain in 'SDIMAIN.PAS' {ClientForm},

DlgUnit in 'DlgUnit.pas' {BeginDataDlg},

PathDialog in '\$$$\ADMIN\PathDialog.pas' {PathDlg};

{$R *.RES}

begin

Application.Title:= 'TestClient';

Application.CreateForm(TClientForm, ClientForm);

Application.CreateForm(TBeginDataDlg, BeginDataDlg);

Application.Run;

end.

Текст модуля SdiMain

unit Sdimain;

interface

uses Windows,DBTables, DB, ExtCtrls, StdCtrls, Forms, Classes, Controls,

ComCtrls,SysUtils, Gauges, DBCtrls,Graphics;

type

TClientForm = class(TForm)

QuestList: TListBox;

Timer: TTimer;

TicketSource: TDataSource;

DBTicket: TTable;

DBTicketTicket_id: TAutoIncField;

DBTicketTicket_num: TIntegerField;

DBTicketQuest_id: TIntegerField;

AnswerSource: TDataSource;

DBAnswer: TTable;

DBAnswerOtvet_id: TAutoIncField;

DBAnswerQuest_id: TIntegerField;

DBAnswerOtvet_name: TMemoField;

DBAnswerTrued: TBooleanField;

ResultSource: TDataSource;

DBResult: TTable;

DBResultAnswer_id: TIntegerField;

DBResultTrued: TBooleanField;

MemoScroll: TScrollBox;

PrevBut: TButton;

NextBut: TButton;

ExitBut: TButton;

TestGauge: TGauge;

ControlSource: TDataSource;

DBControl: TTable;

QuestName: TDBMemo;

QuestSource: TDataSource;

DBQuest: TTable;

StatusBar: TStatusBar;

procedure ShowHint(Sender: TObject);

procedure QuestListClick(Sender: TObject);

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

procedure FormShow(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure ExitButClick(Sender: TObject);

procedure PrevButClick(Sender: TObject);

procedure NextButClick(Sender: TObject);

procedure TimerTimer(Sender: TObject);

procedure RefreshAnswers;

procedure DeleteAnswer(AOwner: TComponent;Number: integer);

procedure FormResize(Sender: TObject);

procedure MemoScrollResize(Sender: TObject);

private

x1,x2: integer;

public

CreateMainForm: boolean;

TestTime: LongInt; {время тестирования в миллисекундах }

MaxMark: LongInt; {система оценки(балл)}

ticket: longint; {Users ticket}

StudentName: string[40];

end;

TAnswer = Class(TObject)

memo: TMemo;

check: TCheckBox;

constructor Create(AOwner:TComponent;Height_: Integer);

procedure Free;

procedure CheckClick(Sender: TObject);

procedure MemoClick(Sender: TObject);

private

nocreate: boolean; {TRUE - if don't run the CREATE-constructor}

end;

var

ClientForm: TClientForm;

implementation

uses DlgUnit, PathDialog;

{$R *.DFM}

{----------------------------------}

procedure TClientForm.RefreshAnswers;

{Изменяет размеры области вывода ответов,содержимое ответов,число ответов

в зависимости от выбранного вопроса.}

Var

NewAnswer: TAnswer;

i: integer;

begin

DBTicket.First;

DBTicket.MoveBy(QuestList.ItemIndex); {Go to the selected Question}

i:= 0; {индекс ДЛЯ ОБЪЕКТА TMemo в списке}

DBAnswer.First; {чтобы не было глюков при повторном щелчке на вопросе}

while NOT DBAnswer.Eof do

begin

If (i+1) > MemoScroll.ComponentCount then

NewAnswer:= TAnswer.Create(MemoScroll,100); {добавление new варианта ответа в список}

TMemo(MemoScroll.Components[i]).Text:= DBAnswer['Otvet_name']; {Otvet_name}

TCheckBox(MemoScroll.Components[i+1]).Checked:= DBResult['Trued'];

inc(i,2); // <--- увеличение индекса ДЛЯ ОБЪЕКТА TMemo в списке

DBAnswer.Next;

end;

While i< MemoScroll.ComponentCount do {удаление из списка лишних вариантов ответа}

DeleteAnswer(MemoScroll,MemoScroll.ComponentCount - 2);

If MemoScroll.ComponentCount > 0 then

begin

TMemo(MemoScroll.Components[0]).SetFocus; {Set focus on first answer.}

QuestList.SetFocus; {and tnen set focus on questions-list}

end;

ClientForm.MemoScrollResize(MemoScroll); {изменение размеров областей вывода ответов}

end;

{----------------------------------}

constructor TAnswer.Create(AOwner:TComponent;Height_: Integer);

begin

NoCreate:= False;

memo:= TMemo.Create(Aowner);

with memo do begin

Parent:= TWinControl(AOwner);

ReadOnly:= True;

TabStop:= False;

Left:= 0;

OnClick:= MemoClick;

end;

check:= TCheckBox.Create(AOwner);

With check do begin

Parent:= TWinControl(AOwner);

Height:= 17;

Width:= 17;

TabStop:= False;

OnClick:= CheckClick;

end;

NoCreate:= True;

end;

procedure TAnswer.Free;

begin

check.Free;

memo.Free;

end;

procedure TAnswer.MemoClick(Sender: TObject);

begin

ClientForm.QuestList.SetFocus;

end;

procedure TAnswer.CheckClick(Sender: TObject);

begin

If nocreate then begin

ClientForm.DBAnswer.First; {передвигаем указатель в DBAnswer и вместе с ним в DBResult}

ClientForm.DBAnswer.MoveBy((Check.Componentindex-1) div 2);

ClientForm.DBResult.Edit;

ClientForm.DBResult['Trued']:= Check.Checked;

ClientForm.DBResult.Post;

ClientForm.QuestList.SetFocus;

end;

end;

procedure TClientForm.DeleteAnswer(AOwner: TComponent;Number: integer);

Var

i: integer;

{удаленние из списка объекта NUMBER и NUMBER+1}

begin

TCheckBox(AOwner.Components[number+1]).Free;

TMemo(AOwner.Components[number]).Free;

For i:= Number to AOwner.ComponentCount-1 do {перерисовка компонентов в ScrollBox}

If AOwner.Components[i] is TMemo then

TMemo(AOwner.Components[i]).Top:= TMemo(AOwner.Components[i]).Top -

TMemo(AOwner.Components[i]).Height

else

TCheckBox(AOwner.Components[i]).Top:= TCheckBox(AOwner.Components[i]).Top -

TMemo(AOwner.Components[i-1]).Height;

If AOwner.ComponentCount > 0 then

TScrollBox(AOwner).VertScrollBar.Range:= (AOwner.ComponentCount div 2)*

TMemo(AOwner.Components[0]).Height;

end;

procedure TClientForm.ShowHint(Sender: TObject);

begin

StatusBar.SimpleText:= Application.Hint;

end;

procedure TClientForm.FormShow(Sender: TObject);

begin

If CreateMainForm then BeginDataDlg.ShowModal;

end;

procedure TClientForm.QuestListClick(Sender: TObject);

begin

RefreshAnswers;

end;

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

Var

Quest_cnt, {всего вопросов}

MyAnswerTrued, {1 - если ответ правильный}

TruedCnt: word; {количество правильных ответов}

SumTrued: real; {относительная оценка}

S: string;

begin

{действия по получению оценки и выводу ее на экран и в БД}

If BeginDataDlg.ModalResult <> mrOk then Exit;

quest_cnt:= 0; SumTrued:= 0; MyAnswerTrued:= 0; TruedCnt:= 0;

DBTicket.First;

while not DBTicket.EOF do

begin

inc(quest_cnt);

DBAnswer.First;

while not DBAnswer.EOF do

begin

If DBResult['Trued'] = DBAnswer['Trued'] then MyAnswerTrued:= 1

else

begin

MyAnswerTrued:= 0; {Ответ на вопрос неверен.}

Break; {выход из цикла}

end;

DBAnswer.Next;

end;

DBTicket.Next;

TruedCnt:= TruedCnt + MyAnswerTrued;

end;

SumTrued:= TruedCnt / quest_cnt; {средний бал 0..1}

Str((SumTrued*ClientForm.MaxMark):5:2,S);

Application.MessageBox(PChar('Правильных ответов: '+

IntToStr(TruedCnt)+' из '+IntToStr(Quest_cnt)+

#13+'Оценка: ' + s),

'Результат тестирования',MB_ICONINFORMATION);

DBResult.Active:= False; {Close databases}

DBAnswer.Active:= False;

DBQuest.Active:= False;

DBTicket.Active:= False;

DBControl.Active:= True; {Save info of current user in CONTROL.DB}

DBControl.Append;

DBControl['Date']:= Date;

DBControl['Time']:= Time;

DBControl['Ticket_num']:= ticket;

DBControl['Mark']:= SumTrued;

DBControl['Name']:= StudentName;

DBControl.Post;

DBControl.Active:= False;

end;

procedure TClientForm.FormCreate(Sender: TObject);

begin

CreateMainForm:= True;

x1:= ClientHeight - MemoScroll.Top - MemoScroll.Height;

x2:= ClientWidth - MemoScroll.Left - MemoScroll.Width;

ClientForm.Height:= GetSystemMetrics(SM_CYMAXIMIZED) - 10;

end;

procedure TClientForm.ExitButClick(Sender: TObject);

begin

Close;

end;

procedure TClientForm.PrevButClick(Sender: TObject);

begin

QuestList.ItemIndex:= QuestList.ItemIndex - 1;

RefreshAnswers;

end;

procedure TClientForm.NextButClick(Sender: TObject);

begin

QuestList.ItemIndex:= QuestList.ItemIndex + 1;

RefreshAnswers;

end;

procedure TClientForm.TimerTimer(Sender: TObject);

begin

TestGauge.AddProgress(Timer.Interval);

TestTime:= TestTime - Timer.Interval;

If TestGauge.PercentDone > 75 then TestGauge.BackColor:= clYellow;

If TestTime = 0 then Close; {в OnClose д/б предусмотрен расчет оценки и запись ее в БД}

end;

procedure TClientForm.FormResize(Sender: TObject);

begin

if ClientForm.Height >= 400 then

begin

MemoScroll.Height:= ClientForm.ClientHeight - MemoScroll.Top - x1;

QuestList.Height:= ClientForm.ClientHeight - QuestList.Top - x1;

StatusBar.Top:= ClientForm.ClientHeight - StatusBar.Height;

PrevBut.Top:= StatusBar.Top - PrevBut.Height - 6; {modify buttons place}

NextBut.Top:= PrevBut.Top; ExitBut.Top:= NextBut.Top;

end

else ClientForm.Height:= 400;

IF ClientForm.Width >= 440 then

begin

MemoScroll.Width:= ClientForm.ClientWidth - MemoScroll.Left - x2;

QuestName.Width:= ClientForm.ClientWidth - QuestName.Left - x2;

TestGauge.Width:= ClientForm.ClientWidth - TestGauge.Left - x2;

StatusBar.Width:= ClientForm.ClientWidth;

end

else ClientForm.Width:= 440;

end;

procedure TClientForm.MemoScrollResize(Sender: TObject);

{этот обработчик вызывается также в RefreshAnswers}

var

i,CommonHeight: integer;

begin

i:= 0; CommonHeight:= 0;

While i < (MemoScroll.ComponentCount-1) do

begin

If i>0 then TMemo(MemoScroll.Components[i]).Top:=

TMemo(MemoScroll.Components[i-2]).Top +

TMemo(MemoScroll.Components[i-2]).Height;

TMemo(MemoScroll.Components[i]).Width:= MemoScroll.Width - 60;

TMemo(MemoScroll.Components[i]).Height:=

Trunc((2-1/3)*Abs(TMemo(MemoScroll.Components[i]).Font.Height)*

TMemo(MemoScroll.Components[i]).Lines.Count);

TCheckBox(MemoScroll.Components[i+1]).Left:=

TMemo(MemoScroll.Components[i]).Left + TMemo(MemoScroll.Components[i]).Width + 15;

TCheckBox(MemoScroll.Components[i+1]).Top:=

TMemo(MemoScroll.Components[i]).Top + (TMemo(MemoScroll.Components[i]).Height-

TCheckBox(MemoScroll.Components[i+1]).Height) div 2;

CommonHeight:= CommonHeight + TMemo(MemoScroll.Components[i]).Height;

inc(i,2);

end;

MemoScroll.VertScrollBar.Range:= CommonHeight;

end;

end.

Текст модуля DlgUnit

unit DlgUnit;

interface

uses Db,Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

IniFiles,Buttons, ExtCtrls, Spin, ComCtrls;

type

TBeginDataDlg = class(TForm)

EditName: TEdit;

Label1: TLabel;

TicketEdit: TSpinEdit;

Label2: TLabel;

Bevel1: TBevel;

OkBut: TBitBtn;

QuitBut: TBitBtn;

StatusBar: TStatusBar;

procedure ShowHint(Sender: TObject);

procedure OkButClick(Sender: TObject);

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

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

BeginDataDlg: TBeginDataDlg;

implementation

uses Sdimain, PathDialog;

{$R *.DFM}

procedure TBeginDataDlg.ShowHint(Sender: TObject);

begin

StatusBar.SimpleText:= Application.Hint;

end;

procedure TBeginDataDlg.OkButClick(Sender: TObject);

Var

i: integer;

begin

with ClientForm do

begin

StudentName:= EditName.Text;

Ticket:= TicketEdit.Value;

DBTicket.Active:= True;

{Выбор номера билета. Выбранный номер билета заносим в Ticket}

DBTicket.SetRangeStart; {установка фильтра}

DBTicket['Ticket_num']:= ticket;

DBTicket.SetRangeEnd;

DBTicket['Ticket_num']:= ticket;

DBTicket.ApplyRange;

DBQuest.Active:= True;

with DBResult do //--------- Create new local table RESULT.DB ----------

begin

Active:= False;

DatabaseName:= '';

TableName:= 'Result';

TableType:= ttParadox;

with FieldDefs do

begin

Clear;

Add('Answer_id', ftInteger, 0, False);

Add('Trued', ftBoolean, 0, False);

end;

with IndexDefs do

begin

Clear;

Add('Answer_ind', 'Answer_id', [ixPrimary, ixUnique]);

end;

CreateTable;

end; //--------- end of create -------------------------

DBAnswer.Active:= True;

DBresult.Active:= True;

i:=0; {заполнение QuestList номерами вопросов}

While not DBTicket.EOF do

begin

inc(i);

QuestList.Items.Add(IntToStr(i));

While not DBAnswer.EOF do {Fill RESULT-table}

begin

DBResult.Append;

DBResult['Answer_id']:= DBAnswer['Otvet_id'];

DBResult['Trued']:= False;

DBResult.Post;

DBAnswer.Next;

end;

DBTicket.Next;

end;

RefreshAnswers;

WindowState:= wsNormal;

Application.OnHint:= ShowHint;

TestGauge.MaxValue:= TestTime; {Set max value of indicator }

Timer.Enabled:= True; { Activate the timer.}

CreateMainForm:= False;

end; { of with ClientForm}

end;

procedure TBeginDataDlg.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

If Modalresult <> mrOk then ClientForm.Close;

Action:= caFree;

end;

procedure TBeginDataDlg.FormShow(Sender: TObject);

Var

IniFile: TIniFile;

List: TStringList;

AliasPath: string;

begin

Application.OnHint:= ShowHint;

Session.ConfigMode:= cmAll; {Global and local aliases !!!}

try

List:= TStringList.Create;

Session.GetAliasParams('Common_base',List); // may be occurs an error

AliasPath:= List.Values['PATH'];

List.Free;

except

Application.CreateForm(TPathDlg, PathDlg);

PathDlg.ShowModal;

If PathDlg.Modalresult = mrOk then

begin

AliasPath:= PathDlg.DirectoryList.Directory;

Session.AddStandardAlias('Common_base',AliasPath,'PARADOX'); {add NEW alias if none}

Session.SaveConfigFile;

end

else Modalresult:= mrCancel;

end;

IniFile:= TIniFile.Create(AliasPath+'\Test.INI');

ClientForm.TestTime:= IniFile.ReadInteger('Options', 'TestTime', 600000{10 min});

TicketEdit.MaxValue:= IniFile.ReadInteger('Options', 'MaxTicket', 1);

If TicketEdit.MaxValue = 1 then TicketEdit.Increment:= 0;

IniFile.Free;

end;

end.

Текст модуля PathDialog

unit PathDialog;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls, FileCtrl;

type

TPathDlg = class(TForm)

OKBtn: TButton;

CancelBtn: TButton;

DirectoryList: TDirectoryListBox;

DriveBox: TDriveComboBox;

PathLabel: TEdit;

Label1: TLabel;

procedure DriveBoxChange(Sender: TObject);

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

procedure DirectoryListChange(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

PathDlg: TPathDlg;

implementation

{$R *.DFM}

procedure TPathDlg.DriveBoxChange(Sender: TObject);

begin

DirectoryList.Drive:= DriveBox.Drive;

end;

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

begin

Action:= caFree;

end;

procedure TPathDlg.DirectoryListChange(Sender: TObject);

begin

PathLabel.Text:= DirectoryList.Directory;

end;

procedure TPathDlg.FormActivate(Sender: TObject);

begin

PathLabel.Text:= DirectoryList.Directory;

end;

end.