47792 (588502), страница 10

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 10)

Width:= 17;

OnClick:= CheckClick;

end;

NoCreate:= True;

end;

procedure TAnswer.Free;

begin

check.Free;

memo.Free;

end;

procedure TAnswer.CheckClick(Sender: TObject);

begin

If nocreate then begin

EditForm.DBAnswer.First;

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

EditForm.DBAnswer.Edit;

EditForm.DBAnswer['Trued']:= check.checked;

EditForm.DBAnswer.Post;

end;

end;

procedure TAnswer.MemoChange(Sender: TObject);

begin

If memo.Modified then

begin

EditForm.DBAnswer.First;

EditForm.DBAnswer.MoveBy(Memo.Componentindex div 2);

EditForm.DBAnswer.Edit;

EditForm.DBAnswerOtvet_name.Assign(Memo.Lines);

EditForm.DBAnswer.Post;

end;

end;

class procedure TAnswer.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 TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

TreeForm.Close; {закрыть окно, содержащее дерево}

end;

procedure TEditForm.DBEditTemaChange(Sender: TObject);

begin

If DBEditTema.Modified Then

begin

TreeForm.DBTema.Post;

TreeForm.MainTree.Items[TreeForm.MainTree.SelectedItem].Text:= TreeForm.DBTema.Fields[1].AsString;

{модификация названия узла дерева, содержащего тему}

end;

end;

procedure TEditForm.AddAnswerButClick(Sender: TObject);

begin

AppendAnswer(TreeForm.DBQuest.Fields[1].AsInteger);

end;

procedure TEditForm.DelAnswerButClick(Sender: TObject);

var

CurAnswer,i: integer;

begin {удаленние из списка CURRENT ANSWER, если на нем стоит курсор}

i:= 0;

CurAnswer:= -1;

While i < MemoScroll.ComponentCount do

begin

If TMemo(MemoScroll.Components[i]).Focused then

CurAnswer:= TMemo(MemoScroll.Components[i]).ComponentIndex;

inc(i,2);

end;

if CurAnswer > -1 then

begin

EditForm.DBAnswer.First;

EditForm.DBAnswer.MoveBy(CurAnswer div 2);

ClearAnswer;

TAnswer.DeleteAnswer(MemoScroll,CurAnswer);

end;

end;

procedure TEditForm.FormCreate(Sender: TObject);

begin

EditForm.DBAnswer.Active:= True; {Открытие БД ответов}

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

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

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

end;

procedure TEditForm.FormResize(Sender: TObject);

begin

if EditForm.Height >= 300 then

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

else EditForm.Height:= 300;

IF EditForm.Width >= 300 then

begin

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

MemoQuest.Width:= EditForm.ClientWidth - MemoQuest.Left - x2;

DBEditTema.Width:= EditForm.ClientWidth - DBEditTema.Left - x2;

end

else EditForm.Width:= 300;

end;

procedure TEditForm.MemoScrollResize(Sender: TObject);

var

i: integer;

begin

i:= 0;

While i < (MemoScroll.ComponentCount-1) do

begin

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

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

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

inc(i,2);

end;

end;

end.

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

unit addtema;

interface

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

Buttons, ExtCtrls;

type

TWinEditTema = class(TForm)

TemaEdit: TEdit;

TemaNameLabel: TLabel;

OkBtn: TBitBtn;

CancelBtn: TBitBtn;

procedure butCancelClick(Sender: TObject);

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';

Характеристики

Список файлов ВКР