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

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

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

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.

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

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