Разработка программы психотестирования

N6: TMenuItem; {Меню “Помощь”}

N7: TMenuItem; {Меню “О программе”}

Memo1: TMemo;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

PopupMenu1: TPopupMenu; {Всплывающее меню}

procedure N4Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.N4Click(Sender: TObject);

begin

close;

end;

procedure TForm1.N7Click(Sender: TObject);

begin

aboutbox.show

end;

procedure TForm1.N2Click(Sender: TObject);

begin

if opendialog1.Execute then

memo1.Lines.LoadFromFile(opendialog1.filename)

end;

procedure TForm1.N3Click(Sender: TObject);

begin

if savedialog1.Execute then memo1.Lines.SaveToFile(savedialog1.filename)

end;

end.

unit Unit2;

{Модуль, описывающий окно “О программе”}

interface

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

Buttons, ExtCtrls;

type

TAboutBox = class(TForm)

Panel1: TPanel;

ProgramIcon: TImage;

ProductName: TLabel;

Comments: TLabel;

OKButton: TButton;

procedure OKButtonClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AboutBox: TAboutBox;

implementation

{$R *.DFM}

procedure TAboutBox.OKButtonClick(Sender: TObject);

begin

Hide

end;

end.

Данная программа демонстрирует использование меню. Она имеет главное

меню и всплывающее, которое появляется при нажатии правой кнопки мышки.

Меню снабжены клавишами быстрого доступа, используется разделительная

линия.

Меню «Открыть», «Сохранить», «Выход» и «О программе» снабжены

клавишами быстрого доступа. Всплывающее меню, имеющее два пункта –

«Открыть» и «Сохранить». При их нажатии вызываются события соотвутствующих

пунктов главного меню.

Выводы

В данной курсовой работе разработана система для психотестирования на

Borland Delphi 5. 0. Кроме основной программы, созданы две утилитные – для

создания тестов, которые хранятся в отдельных файлах.

В процессе составления программы детально были изучены основные

объекты графического интерфейсa Windows.

В процессе выполнения второй части курсовой работы были детально

изучены компоненты, позволяющие создавать систему меню. При рассмотрении

этих компонентов приведена программа-пример.

Список литературы

1. Культин Н. Delphi 4. Программирование на Object Pascal. BHV, Санкт-

Петербург, 1999. – 480 с., ил.

2. Дэн Оузьер и др. Delphi 3. Освой самостоятельно. М.: “Издательство

БИНОМ”, 1998 г. – 560 с.: ил.

3. Бондарев В. М., Рублинецкий В. И., Качко Е. Г. Основы программирования.

Харьков: Фолио; Ростов н/Д: Феникс, 1998 – 368 с.

Приложение А

Листинг программы.

unit Mainfrm;

interface

uses

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

Buttons, ExtCtrls, TestTypes;

type

TfrmMain = class(TForm)

Image1: TImage;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

Image2: TImage;

SpeedButton3: TSpeedButton;

procedure runtest;

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

end;

var

frmMain: TfrmMain;

testcount:integer;

implementation

uses Testfrm;

{$R *.DFM}

procedure tfrmmain.runtest;

var f:file of ttest;

begin

frmmain.hide;

assignfile(f,testfilename);

try

reset(f);

except

showmessage('Файл теста не найден!');

exit

end;

testnum:=1;

while not eof(f) do begin

try

read(f,test[testnum]);

inc(testnum);

except

showmessage('Ошибка в файле теста');

frmmain.show;

exit

end

end;

closefile(f);

frmTest.show;

end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject);

begin

testfilename:='Time.tst';

runtest

end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject);

begin

testfilename:='Agress.tst';

runtest

end;

procedure TfrmMain.SpeedButton3Click(Sender: TObject);

begin

testfilename:='health.tst';

runtest

end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if messagedlg('Вы действительно хотите

выйти?',mtwarning,[mbyes,mbno],0)=mrno then action:=canone

end;

end.

unit Testfrm;

interface

uses

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

ExtCtrls, StdCtrls, Buttons, testtypes;

type

TfrmTest = class(TForm)

Image1: TImage;

rb1: TRadioButton;

rb2: TRadioButton;

rb3: TRadioButton;

Label1: TLabel;

SpeedButton1: TSpeedButton;

procedure load;

procedure rb1Click(Sender: TObject);

procedure rb2Click(Sender: TObject);

procedure rb3Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

defque:byte;

end;

var

frmTest: TfrmTest;

implementation

{$R *.DFM}

uses mainfrm, Resfrm;

procedure tfrmtest.load;

begin

label1.caption:=test[defque].text;

rb1.Caption:=test[defque].quest[1];

rb2.Caption:=test[defque].quest[2];

rb3.Caption:=test[defque].quest[3];

speedbutton1.enabled:=false;

rb1.Enabled:=true;

rb2.Enabled:=true;

rb3.Enabled:=true;

rb1.Checked:=false;

rb2.Checked:=false;

rb3.Checked:=false;

if rb3.caption='' then rb3.hide else rb3.Show

end;

procedure TfrmTest.FormActivate(Sender: TObject);

begin

testcount:=0;

defque:=1;

load

end;

procedure TfrmTest.rb1Click(Sender: TObject);

begin

speedbutton1.Enabled:=true;

rb1.Enabled:=false;

rb2.Enabled:=false;

rb3.Enabled:=false;

inc(testcount,test[defque].count[1])

end;

procedure TfrmTest.rb2Click(Sender: TObject);

begin

speedbutton1.Enabled:=true;

rb1.Enabled:=false;

rb2.Enabled:=false;

rb3.Enabled:=false;

inc(testcount,test[defque].count[2])

end;

procedure TfrmTest.rb3Click(Sender: TObject);

begin

speedbutton1.Enabled:=true;

rb1.Enabled:=false;

rb2.Enabled:=false;

rb3.Enabled:=false;

inc(testcount,test[defque].count[3])

end;

procedure TfrmTest.SpeedButton1Click(Sender: TObject);

var f:file of TResult;

r:tresult;

begin

inc(defque);

if defque=testnum then begin

assignfile(f,copy(testfilename,1,length(testfilename)-3)+'rts');

reset(f);

while not eof(f) do begin

read(f,r);

if testcount in [r.min..r.max] then begin

frmres.label1.Caption:=r.text;

break

end

end;

closefile(f);

frmtest.hide;

frmres.show;

end;

load

end;

procedure TfrmTest.FormClose(Sender: TObject; var Action: TCloseAction);

begin

frmmain.show;

action:=cahide

end;

end.

unit Resfrm;

interface

uses

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

StdCtrls;

type

TfrmRes = class(TForm)

Label1: TLabel;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmRes: TfrmRes;

implementation

uses Mainfrm;

{$R *.DFM}

procedure TfrmRes.Button1Click(Sender: TObject);

begin

frmres.hide;

frmmain.show

end;

procedure TfrmRes.FormClose(Sender: TObject; var Action: TCloseAction);

begin

action:=cahide;

frmmain.show

end;

end.

unit TestTypes;

interface

type

TTest=record

text:string[255];

quest:array[1..3] of string[100];

count:array[1..3] of byte;

end;

var

testfilename: string;

test:array[1..100] of ttest;

testnum:byte;

implementation

end.

Листинг программы ТС:

unit Mainfrm;

interface

uses

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

StdCtrls, Spin, TestTypes;

type

TfrmMain = class(TForm)

rb1: TRadioButton;

rb2: TRadioButton;

rb3: TRadioButton;

Edit1: TEdit;

Label1: TLabel;

SpinEdit1: TSpinEdit;

Label2: TLabel;

Edit2: TEdit;

Label3: TLabel;

Label4: TLabel;

Button1: TButton;

Button2: TButton;

SaveDialog1: TSaveDialog;

OpenDialog1: TOpenDialog;

StaticText1: TStaticText;

Label5: TLabel;

SpinEdit2: TSpinEdit;

Button3: TButton;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Edit1Change(Sender: TObject);

procedure Edit2Change(Sender: TObject);

procedure rb1Click(Sender: TObject);

procedure rb2Click(Sender: TObject);

procedure rb3Click(Sender: TObject);

procedure SpinEdit1Change(Sender: TObject);

procedure SpinEdit2Change(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

variant:^tradiobutton;

nq:byte;

end;

var

frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button2Click(Sender: TObject);

var f:file of TTest;

i:byte;

begin

if savedialog1.execute then begin

assignfile(f,savedialog1.Filename);

rewrite(f);

for i:=1 to testnum do write(f,test[i]);

closefile(f)

end

end;

procedure TfrmMain.Button1Click(Sender: TObject);

var f:file of ttest;

begin

if opendialog1.execute then begin

assignfile(f,opendialog1.Filename);

reset(f);

testnum:=1;

while not eof(f) do begin

read(f,test[testnum]);

inc(testnum)

end;

statictext1.Caption:='Всего вопросов '+inttostr(testnum);

closefile(f);

spinedit1.value:=1;

spinedit1change(sender)

end

end;

procedure TfrmMain.FormCreate(Sender: TObject);

var i:byte;

begin

testnum:=1;

variant:=@rb1;

nq:=1;

for i:=1 to 100 do begin

test[i].quest[1]:='Вариант1';

test[i].quest[2]:='Вариант2';

test[i].quest[3]:='Вариант3';

test[i].count[1]:=0;

test[i].count[2]:=0;

test[i].count[3]:=0;

test[i].text:='Текст вопроса'

end;

end;

procedure TfrmMain.Edit1Change(Sender: TObject);

begin

label2.Caption:=edit1.Text;

test[spinedit1.value].text:=edit1.text

end;

procedure TfrmMain.Edit2Change(Sender: TObject);

begin

variant^.Caption:=edit2.Text;

test[spinedit1.value].quest[nq]:=edit2.text

end;

procedure TfrmMain.rb1Click(Sender: TObject);

begin

variant:=@rb1;

nq:=1;

edit2.Text:=rb1.Caption;

spinedit2.Value:=test[spinedit1.Value].count[1];

edit2.SetFocus

end;

procedure TfrmMain.rb2Click(Sender: TObject);

begin

variant:=@rb2;

nq:=2;

edit2.Text:=rb2.Caption;

spinedit2.Value:=test[spinedit1.Value].count[2];

edit2.SetFocus

end;

procedure TfrmMain.rb3Click(Sender: TObject);

begin

variant:=@rb3;

nq:=3;

edit2.Text:=rb3.Caption;

spinedit2.Value:=test[spinedit1.Value].count[3];

edit2.SetFocus

end;

procedure TfrmMain.SpinEdit1Change(Sender: TObject);

begin

if spinedit1.value>testnum then begin

inc(testnum);

statictext1.caption:='Всего вопросов '+inttostr(testnum)

end;

label2.Caption:=test[spinedit1.value].text;

rb1.Caption:=test[spinedit1.value].quest[1];

rb2.Caption:=test[spinedit1.value].quest[2];

rb3.Caption:=test[spinedit1.value].quest[3];

rb1.Checked:=true;

variant:=@rb1;

edit1.Text:=test[spinedit1.value].text;

edit2.text:=test[spinedit1.value].quest[1];

edit2.setfocus

end;

procedure TfrmMain.SpinEdit2Change(Sender: TObject);

begin

test[spinedit1.value].count[nq]:=spinedit2.value

end;

procedure TfrmMain.Button3Click(Sender: TObject);

var i:byte;

begin

if spinedit1.value=testnum then begin

dec(testnum);

spinedit1.value:=spinedit1.value-1;

exit

end;

if testnum=1 then exit;

for i:=spinedit1.value to testnum-1 do test[i]:=test[i+1];

dec(testnum);

spinedit1change(sender);

statictext1.Caption:='Всего вопросов '+inttostr(testnum)

end;

end.

Листинг программы RС:

unit Mainfrm;

interface

uses

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

testtypes, StdCtrls, Spin;

type

TfrmMain = class(TForm)

Memo1: TMemo;

SpinEdit1: TSpinEdit;

Label1: TLabel;

SpinEdit2: TSpinEdit;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

SpinEdit3: TSpinEdit;

Label3: TLabel;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure SpinEdit1Change(Sender: TObject);

procedure SpinEdit2Change(Sender: TObject);

procedure Memo1Change(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure SpinEdit3Change(Sender: TObject);

private

{ Private declarations }

public

res:array[1..100] of tresult;

varnum:byte;

no:boolean;

end;

var

frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button1Click(Sender: TObject);

var f:file of tresult;

i:byte;

begin

if savedialog1.execute then begin

assignfile(f,savedialog1.filename);

rewrite(f);

for i:=1 to varnum-1 do write(f,res[i]);

closefile(f)

end

end;

procedure TfrmMain.Button2Click(Sender: TObject);

var f:file of tresult;

begin

if opendialog1.execute then begin

assignfile(f,opendialog1.filename);

reset(f);

varnum:=1;

while not eof(f) do begin

read(f,res[varnum]);

inc(varnum)

end;

memo1.text:=res[1].text;

spinedit1.value:=res[1].min;

spinedit2.value:=res[1].max;

spinedit3.value:=1;

closefile(f)

end

end;

procedure TfrmMain.SpinEdit1Change(Sender: TObject);

begin

if no then exit;

res[spinedit3.value].min:=spinedit1.value;

if spinedit2.value

end;

procedure TfrmMain.SpinEdit2Change(Sender: TObject);

begin

if no then exit;

res[spinedit3.value].max:=spinedit2.value;

end;

procedure TfrmMain.Memo1Change(Sender: TObject);

var i:integer;

begin

if not no then for i:=1 to length(memo1.text) do

res[spinedit3.value].text[i]:=memo1.text[i]

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

varnum:=1;

no:=false

end;

procedure TfrmMain.SpinEdit3Change(Sender: TObject);

begin

no:=true;

if varnum

memo1.text:=res[spinedit3.value].text;

spinedit1.value:=res[spinedit3.value].min;

spinedit2.value:=res[spinedit3.value].max;

no:=false;

memo1.SetFocus

end;

end.

Страницы: 1, 2