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.