new ref 00-000 (Разработка тестового приложения Компоненты меню Delphi), страница 4

interface

uses

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

Dialogs, ExtCtrls, StdCtrls, Gauges, Menus, jpeg;

type

TForm1 = class(TForm)

Panel1: TPanel;

Button1: TButton;

Image1: TImage;

Label5: TLabel;

Label1: TLabel;

Gauge1: TGauge;

MainMenu1: TMainMenu;

File1: TMenuItem;

Save1: TMenuItem;

exit1: TMenuItem;

Help2: TMenuItem;

About1: TMenuItem;

Contents1: TMenuItem;

SaveDialog1: TSaveDialog;

Memo1: TMemo;

N1: TMenuItem;

Timer1: TTimer;

Label2: TLabel;

procedure FormActivate(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure SelectorClick(Sender: TObject);

Продолжение приложения 1

procedure About1Click(Sender: TObject);

procedure Save1Click(Sender: TObject);

procedure Contents1Click(Sender: TObject);

procedure N1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

x:Real;

implementation

uses Unit2, Unit3;

const

N_ANSWERS=4;

N_LEVEL=4;

var

answer: array[1..N_ANSWERS] of Tlabel; //альтернативные ответы

selector: array[1..N_ANSWERS+1] of TRadioButton;// кнопки выбора ответа

f:TextFile;

fn:string; // имя файла вопросов

level:array[1..N_LEVEL] of integer;// сумма, соотв. уровню

mes:array[1..N_LEVEL] of string; // сообщение, соотв. уровню

score:array[1..N_ANSWERS] of integer; // очки за выбор ответа

summa:integer; // набрано очков

vopros:integer; // номер текущего вопроса

otv:integer; // номер выбранного ответа

// установка формы в исходное состояние

Продолжение приложения 1

Procedure ResetForm(frm:Tform1);

var

i:integer;

begin

form1.label2.visible:=false;

form1.Save1.Visible:=false;

form1.Gauge1.Visible:=false;

Form1.Memo1.Visible:=false;

for i:=1 to N_ANSWERS do

begin

answer[i].width:=frm.ClientWidth-answer[i].left-5;

answer[i].Visible:=false;

selector[i].Visible:=false;

end;

frm.Label5.width:=frm.ClientWidth-frm.Label5.left-5;

frm.Image1.Visible:=false;

end;

// Определение достигнутого уровня

procedure Itog(summa:integer;frm:TForm1);

var

i:integer;

buf:string;

begin

Form1.label2.visible:=true;

form1.Save1.Visible:=true;

Form1.Gauge1.Visible:=true;

Form1.Label5.font.size:=11;

buf:='';

str(summa:5,buf);

Продолжение приложения 1

buf:='Результаты вашего тестирования'+chr(13)+'Вы ответили правильно на:'+buf+' из 10 вопросов';

i:=1;

while (summa < level[i]) and (i

i:=i+1;

buf:=buf+chr(13)+mes[i];

frm.Label5.Caption:=buf;

if buf=',' then

buf:='Результаты вашего тестирования'+chr(13)+'Вы набрали:'+buf+'баллов';

Form1.memo1.Lines.Add(buf);

if summa=10 then // условие отображения диаграммы

Form1.gauge1.progress:=100;

if summa=9 then

Form1.Gauge1.Progress:=90;

if summa=8 then

Form1.gauge1.progress:=80;

if summa=7 then

Form1.gauge1.progress:=70;

if summa=6 then

Form1.gauge1.progress:=60;

if summa=5 then

Form1.gauge1.progress:=50;

if summa=4 then

Form1.gauge1.progress:=40;

if summa=3 then

Form1.gauge1.progress:=30;

if summa=2 then

Form1.gauge1.progress:=20;

if summa=1 then

Form1.gauge1.progress:=10;

Продолжение приложения 1

if summa=0 then

Form1.gauge1.progress:=0;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

i:integer;

begin

// создадим пять меток для вывода вопросов и альтернативных ответов

for i:=1 to N_ANSWERS do

begin

answer[i]:=TLabel.Create(self);

Form1.Label5.font.size:=12;

Form1.Label5.Font.name:='System';

answer[i].Parent:=Form1;

answer[i].Left:=36;

answer[i].WordWrap:=false;

end;

// создадим переключатели для выбора ответа

for i:=1 to N_ANSWERS+1 do

begin

selector[i]:=TRadioButton.Create(self);

selector[i].Parent:=self;

selector[i].Caption:='';

selector[i].Width:=17;

selector[i].Left:=16;

selector[i].Visible:=false;

selector[i].Enabled:=True;

selector[i].OnClick:=SelectorClick;

end;

Продолжение приложения 1

ResetForm(Form1);

end;

// вывод начальной инфы о тесте

procedure info(var f:TextFile;l:TLabel);

var

s,buf:string;

begin

buf:='';

repeat

readln(f,s);

if s[1] <> '.'

then buf:=buf+s+' ';

until s[1] ='.';

Form1.Label5.Caption:=buf;

end;

// прочитать информацию об оценках за тест

Procedure GetLevel(var f:TextFile);

var

i:integer;

buf:string;

begin // заполняем значения глобальных массивов

i:=1;

repeat

readln(f,buf);

if buf[1] <> '.' then begin

mes[i]:=buf;

readln(f,level[i]);

i:=i+1;

end;

until buf[1]='.';

Продолжение приложения 1

end;

// масштабирование иллюстрации

Procedure ScalePicture;

var

w,h:integer;

scaleX:real;

scaleY:real;

scale:real;

i:integer;

begin

// вычислит макс. допустимые размеры картинки

w:=Form1.ClientWidth-Form1.Label5.Left;

h:=Form1.ClientHeight

- Form1.Panel1.Height -5

- Form1.Label5.Top

- Form1.Label5.Height - 5;

for i:=1 to N_ANSWERS do

if answer[i].Caption <> ''

then h:=h-answer[i].Height-5;

// здесь определена максимально допустимая величина иллюстрации

// определить масштаб

if w>Form1.Image1.Picture.Width

then scaleX:=1

else scaleX:=w/Form1.Image1.Picture.Width;

if h>Form1.Image1.Picture.Height

then scaleY:=1

else scaleY:=h/Form1.Image1.Picture.Height;

if scaleY

then scale:=scaleY

else scale:=scaleX;

Продолжение приложения 1

// здесь масштаб определен

Form1.Image1.Top:=Form1.Label5.Top+Form1.Label5.Height+5;

Form1.Image1.Left:=Form1.Label5.Left;

Form1.Image1.Width:=Round(Form1.Image1.Picture.Width*scale);

Form1.Image1.Height:=Round(Form1.Image1.Picture.Height*scale);

Form1.Label5.Visible:=True;

end;

// вывод вопроса на экран

Procedure VoprosToScr(var f:TextFile;frm:TForm1;var vopros:integer);

var

i:integer;

code:integer;

s,buf:string;

ifn:string; // файл иллюстрации

begin

vopros:=vopros+1;

str(vopros:3,s);

frm.caption:='Вопрос'+s;

// Выведем текст вопроса

buf:='';

repeat

readln(f,s);

if (s[1] <> '.') and (s[1] <> '\')

then buf:=buf+s+' ';

until (s[1] ='.') or (s[1] ='\');

frm.Label5.caption:=buf;

if s[1] ='\'

then // к вопросу есть иллюстрация

Продолжение приложения 1

begin

frm.Image1.Tag:=1;

ifn:=copy(s,2,length(s));

try

frm.Image1.Picture.LoadFromFile(ifn);

except

on E:EFOpenError do

frm.Tag:=0;

end // try

end

else frm.Image1.Tag:=0;

// Читаем варианты ответов

for i:=1 to N_ANSWERS do

begin

answer[i].caption:='';

answer[i].Width:=frm.ClientWidth-Form1.Label5.Left-5;

end;

i:=1;

repeat

buf:='';

repeat // читаем текст варианта ответа

readln(f,s);

if (s[1]<>'.') and (s[1] <> ',')

then buf:=buf+s+' ';

until (s[1]=',')or(s[1]='.');

// прочитан альтеративный ответ

val(s[2],score[i],code);

answer[i].caption:=buf;

i:=i+1;

until s[1]='.';

Продолжение приложения 1

// здесь прочитана иллюстрация и альтернативные ответы

if Form1.Image1.Tag =1 // есть иллюстрация ?

then begin

ScalePicture;

Form1.Image1.Visible:=True;

end;

// вывод альтернативных ответов

i:=1;

while (answer[i].Caption <> '') and (i <= N_ANSWERS) do

begin

if i = 1

then

if frm.Image1.Tag =1

then answer[1].Top:=frm.Image1.Top+frm.Image1.Height+5

else answer[i].top:=frm.Label5.Top+frm.Label5.Height+5

else

answer[i].top:=answer[i-1].top+answer[i-1].Height+5;

selector[i].top:=answer[i].top;

selector[i].Visible:=true;

answer[i].Visible:=true;

i:=i+1;

end;

end;

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);

begin

ResetForm(Form1);

if ParamCount = 0

then

begin

Продолжение приложения 1

Label5.font.color:=clRed;

Label5.Font.Size:=12;

Label5.caption:='Не обнаружено файла вопросов теста.';

Button1.Caption:='Выход';

Button1.Tag:=2;

Button1.Enabled:=true;

end

else begin

fn:=ParamStr(1);

assignfile(f,fn);

{$I-}

reset(f);

{I+}

if IOResult=0 then

begin

Info(f,Label5);

GetLevel(f);

end;

summa:=0;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

case Button1.tag of

0: begin

Button1.caption:='Далее';

Button1.tag:=1;

Selector[N_ANSWERS+1].Checked:=true;

// вывод первого вопроса

Button1.Enabled:=false;

Продолжение приложения 1

ResetForm(Form1);

VoprosToScr(f,Form1,vopros)

end;

1: begin // вывод остальных вопросов

summa:=summa+score[otv];

Selector[N_ANSWERS+1].Checked:=true;

Button1.Enabled:=false;

ResetForm(Form1);

if not eof(f)

then VoprosToScr(f,Form1,vopros)

else

begin

closefile(f);

Button1.tag:=2;

Button1.caption:='Выход';

Button1.Enabled:=true;

Itog(summa,Form1);

end;

end;

2: begin // завершение работы

Form1.Close;

end;

end;

end;

// щёлчок на кнопке выбора ответа

Procedure TForm1.SelectorClick(Sender: TObject);

var

i:integer;

begin

i:=1;

Продолжение приложения 1

while Selector[i].Checked = false do

i:=i+1;

otv:=i;

Button1.enabled:=true;

end;

procedure TForm1.About1Click(Sender: TObject);

begin

AboutBox.ShowModal;

end;

procedure TForm1.Save1Click(Sender: TObject);

begin

savedialog1.Execute; // сохранение данных

memo1.Lines.SaveToFile(savedialog1.FileName);

end;

procedure TForm1.Contents1Click(Sender: TObject); //Вывод справки

const

HELP_TAB = 15;

INDEX_ACTIVE = 10;

CONTENTS_ACTIVE = 5;

Help_CONTENS = 10;

begin

Application.HelpCommand(HELP_TAB, INDEX_ACTIVE);

Application.HelpCommand(HELP_TAB, CONTENTS_ACTIVE);

end;

procedure TForm1.N1Click(Sender: TObject);

begin

Form1.Close;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Продолжение приложения 1

x:=x+0.1;

Label2.Left:=60+trunc(60*cos(x));

Label2.Top:=65-trunc(15*sin(x));

end;

end.