Смекни!
smekni.com
Информатика и программирование

Обучающе-контроллирующая система для подготовки студентов (стр. 12 из 13)

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 - если ответ правильный}

 
назад
читать дальше
1
2
3
4
5
6
7
8
9
10
11
12
13
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.