Список використаної літератури. 1. швачко г. г., назарчук і.в., програмування та алгоритмічні мови (мова прогр

1. Швачко Г. Г., Назарчук І.В., Програмування та алгоритмічні мови (мова прогр. Паскаль, частина ІІ): Метод. Вказівки до комп’ютерн. Практикуму для студентів напрямів підготовки 6.040303 «Системний аналіз», 6.050101 «Компютерні науки». – К. ННК «ІПСА» НТУУ «КПІ», 2011. - 106 с.

2. Архангельский А. Я. Delphi 7. Справочное пособие / А. Я. Архангельский.. – М.: ООО «Бином-Пресс», 2003 г. – 1024 с.

3. В. Гуленко, И. Вайсбанд, А. Толстикова, Е. Филатова, В. Мегедь. Сборник тестов на соционический тип – Ц.: Институт им. К. Юнга в Цюрихе, 2000 г.

ДОДАТОК. ЛІСТІНГ ПРОГРАМИ

unit main;

interface

uses

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

Dialogs, StdCtrls, Menus;

type

TStartForm = class(TForm)

UserButton: TButton;

AdminButton: TButton;

ChooseLabel: TLabel;

MainMenu1: TMainMenu;

help1: TMenuItem;

about1: TMenuItem;

procedure AdminButtonClick(Sender: TObject);

procedure UserButtonClick(Sender: TObject);

procedure help1Click(Sender: TObject);

procedure about1Click(Sender: TObject);

private

procedure showhelp(c,s:string);

public

end;

var

StartForm: TStartForm;

implementation

uses user, pas, choose, help;

{$R *.dfm}

procedure TStartform.showhelp(c,s:string);

begin

helpForm.Caption:=c;

helpForm.helpMemo.Text:=s;

helpForm.visible:=true;

end;

procedure TStartForm.AdminButtonClick(Sender: TObject);

begin

startForm.Visible:=false;

pasForm.Visible:=true;

end;

procedure TStartForm.UserButtonClick(Sender: TObject);

begin

startForm.Visible:=false;

userForm.Visible:=true;

end;

procedure TStartForm.help1Click(Sender: TObject);

var c,s:string;

begin

c:='Помощь';

s:='Выберите режим "Испытуемый", если вы хотите узнать свой тип информационного метаболизма. В случае, если вы хотите просмотреть прошлые результаты, очистить историю результатов либо сменить пароль, выберите режим "Администратор".';

startform.showhelp(c,s);

end;

procedure TStartForm.about1Click(Sender: TObject);

var c,s:string;

begin

c:='О программе';

s:='Данная программа явлется курсовой работой студентки первого курса ИПСА группы КА-21 Светловой Елены.';

startform.showhelp(c,s);

end;

end.

unit user;

interface

uses

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

Dialogs, StdCtrls, Menus;

type

TUserForm = class(TForm)

fnameEdit: TEdit;

snameEdit: TEdit;

AgeEdit: TEdit;

MainMenu1: TMainMenu;

menu1: TMenuItem;

about1: TMenuItem;

UpButton: TButton;

DownButton: TButton;

FirstName: TLabel;

SecondName: TLabel;

Age: TLabel;

Label1: TLabel;

procedure UpButtonClick(Sender: TObject);

procedure DownButtonClick(Sender: TObject);

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

procedure menu1Click(Sender: TObject);

procedure about1Click(Sender: TObject);

private

procedure showhelp(c,s:string);

public

{ Public declarations }

end;

var

UserForm: TUserForm;

nextStep:boolean;

implementation

uses main, admin, choose, que, help;

{$R *.dfm}

procedure Tuserform.showhelp(c,s:string);

begin

helpForm.Caption:=c;

helpForm.helpMemo.Text:=s;

helpForm.visible:=true;

end;

procedure TUserForm.UpButtonClick(Sender: TObject);

begin

UserForm.Visible:=false;

startForm.Visible:=true;

end;

procedure TUserForm.DownButtonClick(Sender: TObject);

var users:textfile; k:integer;

begin

trystrtoint(AgeEdit.text,k);

if (fnameEdit.text<>'')and (snameEdit.text<>'') and (AgeEdit.text<>'') and (k<100) and (k>6) then begin

AssignFile(users,'users.txt');

Append(users);

write(users,snameEdit.text,' ',fnameEdit.text,' ',AgeEdit.text, ' ');

CloseFile(users);

UserForm.Visible:=false;

quetionForm.Visible:=true;

end

else

ShowMessage('Пожалуйста, введите ваши данные.Проверте, что в графе "Возраст" вы указали натуральное число, большее 6 и меньшее 100.');

end;

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

begin

If MessageDlg('Выйти из программы?',

mtConfirmation, mbOkCancel,0)=mrOk Then begin

Action:=caFree; //Нажата Ok - закрываем форму.

startForm.Close;

end

Else

Action:=caNone; //Нажата Cancel - игнорируем закрытие.

end;

procedure TUserForm.menu1Click(Sender: TObject);

var c,s:string;

begin

c:='Помощь';

s:='Для того, чтобы перейти к прохождению теста, введите ваши личные данные. Если вы хотите выбрать другую учетную запись, вернитесь назад';

userform.showhelp(c,s);

end;

procedure TUserForm.about1Click(Sender: TObject);

var c,s:string;

begin

c:='О программе';

s:='Данная программа явлется курсовой работой студентки первого курса ИПСА группы КА-21 Светловой Елены.';

userform.showhelp(c,s);

end;

end.

unit que;

interface

uses

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

Dialogs, StdCtrls, Menus;

type

setans= set of 1..150;

TQuetionForm = class(TForm)

ans2Button: TRadioButton;

queLabel: TLabel;

ans1Label: TLabel;

ans2Label: TLabel;

next: TButton;

ans1button: TRadioButton;

Button1: TButton;

MainMenu1: TMainMenu;

help1: TMenuItem;

about1: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure nextClick(Sender: TObject);

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

procedure Button1Click(Sender: TObject);

procedure help1Click(Sender: TObject);

procedure about1Click(Sender: TObject);

private

procedure showhelp(c,s:string);

public

{ Public declarations }

end;

var

QuetionForm: TQuetionForm;

flag:boolean; count,n1,n2:byte;

T:setans=[13, 19, 21, 25, 27, 43, 47, 51, 55, 75, 77, 81, 85, 91, 93, 105, 123, 137];

F:setans=[14, 20, 22, 26, 28, 44, 48, 52, 56, 76, 78, 82, 86, 92, 94, 106, 124, 138];

S:setans=[1, 33, 35, 39, 41, 49, 65, 69, 73, 97, 99, 101, 117, 121, 125, 131, 133, 139];

N:setans=[2, 34, 36, 40, 42, 50, 66, 70, 74, 98, 100, 102, 118, 122, 126, 132, 134, 140];

J:setans=[7, 9, 11, 17, 23, 29, 31, 57, 71, 79, 87, 89, 95, 109, 115, 135, 141, 143];

P:setans=[8, 10, 12, 18, 24, 30, 32, 58, 72, 80, 88, 90, 96, 110, 116, 136, 142, 144];

I:setans=[4, 6, 16, 38, 46, 54, 60, 62, 64, 68, 84, 104, 108, 112, 114, 120, 128, 130];

E:setans=[3, 5, 15, 37, 45, 53, 59, 61, 63, 67, 83, 103, 107, 111, 113, 119, 127, 129];

t_count,f_count,s_count,n_count,j_count,p_count,i_count,e_count:byte;

implementation

{$R *.dfm}

uses choose,que2,main, help;

procedure Tquetionform.showhelp(c,s:string);

begin

helpForm.Caption:=c;

helpForm.helpMemo.Text:=s;

helpForm.visible:=true;

end;

procedure TQuetionForm.FormCreate(Sender: TObject);

var f:textfile; s1,s2:string;

begin

button1.Visible:=false;

t_count:=0; f_count:=0; s_count:=0; n_count:=0; j_count:=0; p_count:=0; i_count:=0; e_count:=0;

queLabel.Caption:='Выберите утверждение, с которым наиболее согласны.';

AssignFile(f,'test1.txt');

Reset(f);

read(f,n1,s1);

readln(f,n2,s2);

ans1label.Caption:=s1;

ans2label.Caption:=s2;

CloseFile(f);

count:=1;

end;

procedure TQuetionForm.nextClick(Sender: TObject);

var fil,users:textfile; s1,s2,rez:string; l,k:byte;

begin

if ans1button.Checked=true then k:=n1

else k:=n2;

if k>30 then

button1.Visible:=true;

if k in T then

t_count:=t_count+1;

if k in F then

f_count:=f_count+1;

if k in S then

s_count:=s_count+1;

if k in N then

n_count:=n_count+1;

if k in J then

j_count:=j_count+1;

if k in P then

p_count:=p_count+1;

if k in I then

i_count:=i_count+1;

if k in E then

e_count:=e_count+1;

AssignFile(fil,'test1.txt');

Reset(fil);

for l:=1 to count*2 do

readln(fil);

if not eof(fil) then begin

read(fil,n1,s1);

readln(fil,n2,s2);

ans1label.Caption:=s1;

ans2label.Caption:=s2;

count:=count+1;

end

else

begin

rez:='';

if i_count>e_count then

rez:=rez+'I'

else

rez:=rez+'E';

if s_count>n_count then

rez:=rez+'S'

else

rez:=rez+'N';

if t_count>f_count then

rez:=rez+'T'

else

rez:=rez+'F';

if p_count>j_count then

rez:=rez+'P'

else

rez:=rez+'J';

AssignFile(users,'users.txt');

Append(users);

write(users,rez,' ');

CloseFile(users);

QuetionForm.Visible:=false;

quetion2Form.Visible:=true;

end;

CloseFile(fil);

end;

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

var users:textfile;

begin

AssignFile(users,'users.txt');

Append(users);

writeln(users);

Closefile(users);

If MessageDlg('Завершить тест?',

mtConfirmation, mbOkCancel,0)=mrOk Then begin

Action:=caFree;

startForm.close;

end

Else

Action:=caNone;

end;

procedure TQuetionForm.Button1Click(Sender: TObject);

var rez:string; var users:textfile;

begin

rez:='';

if i_count>e_count then

rez:=rez+'I'

else

rez:=rez+'E';

if s_count>n_count then

rez:=rez+'S'

else

rez:=rez+'N';

if t_count>f_count then

rez:=rez+'T'

else

rez:=rez+'F';

if p_count>j_count then

rez:=rez+'P'

else

rez:=rez+'J';

AssignFile(users,'users.txt');

Append(users);

write(users,rez,' ');

CloseFile(users);

quetionForm.Visible:=false;

quetion2Form.Visible:=true;

end;

procedure TQuetionForm.help1Click(Sender: TObject);

var c,s:string;

begin

c:='Помощь';

s:='В данном виде тестирования Вы можете выбрать один из наиболее подходящих вариантов. Этот вариант должен наиболее точно описывает Ваши мысли, чувства, жизненные ситуации.';

quetionform.showhelp(c,s);

end;

procedure TQuetionForm.about1Click(Sender: TObject);

var c,s:string;

begin

c:='О программе';

s:='Данная программа явлется курсовой работой студентки первого курса ИПСА группы КА-21 Светловой Елены.';

quetionform.showhelp(c,s);

end;

end.

unit que2;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Menus;

type

Tquetion2Form = class(TForm)

queLabel: TLabel;

ans1Label: TLabel;

ans2Label: TLabel;

RadioGroup1: TRadioGroup;

ans1: TRadioButton;

ans2: TRadioButton;

ans3: TRadioButton;

ans4: TRadioButton;

Button1: TButton;

MainMenu1: TMainMenu;

help1: TMenuItem;

about1: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

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

procedure help1Click(Sender: TObject);

procedure about1Click(Sender: TObject);

private

procedure showhelp(c,s:string);

public

{ Public declarations }

end;

var

quetion2Form: Tquetion2Form;

count1,count2,count3,count4,count,n:byte;

implementation

uses que3, que, help, main;

{$R *.dfm}

procedure Tquetion2form.showhelp(c,s:string);

begin

helpForm.Caption:=c;

helpForm.helpMemo.Text:=s;

helpForm.visible:=true;

end;

procedure Tquetion2Form.FormCreate(Sender: TObject);

var filo:textfile; s1,s2,s3:string;

begin

count1:=0;count2:=0;count3:=0;count4:=0;

AssignFile(filo,'test2.txt');

Reset(filo);

readln(filo,n, s1);

readln(filo,s2);

readln(filo,s3);

queLabel.Caption:=s1;

ans1label.Caption:=s3;

ans2label.Caption:=s2;

CloseFile(filo);

count:=1;

end;

procedure Tquetion2Form.Button1Click(Sender: TObject);

var filo,users:textfile; l:byte; s1,s2,s3,rez:string;

begin

if (n mod 4)=0 then begin

if ans1.Checked=true then

count4:=count4+1;

if ans2.Checked=true then

count4:=count4+3;

if ans3.Checked=true then

count4:=count4+7;

if ans4.Checked=true then

count4:=count4+9;

end;

if (n mod 4)=1 then begin

if ans1.Checked=true then

count1:=count1+1;

if ans2.Checked=true then

count1:=count1+3;

if ans3.Checked=true then

count1:=count1+7;

if ans4.Checked=true then

count1:=count1+9;

end;

if (n mod 4)=2 then begin

if ans1.Checked=true then

count2:=count2+1;

if ans2.Checked=true then

count2:=count2+3;

if ans3.Checked=true then

count2:=count2+7;

if ans4.Checked=true then

count2:=count2+9;

end;

if (n mod 4)=3 then begin

if ans1.Checked=true then

count3:=count3+1;

if ans2.Checked=true then

count3:=count3+3;

if ans3.Checked=true then

count3:=count3+7;

if ans4.Checked=true then

count3:=count3+9;

end;

AssignFile(filo,'test2.txt');

Reset(filo);

for l:=1 to count*3 do

readln(filo);

if not eof(filo) then begin

readln(filo,n,s1);

readln(filo,s2);

readln(filo,s3);

queLabel.Caption:=s1;

ans1label.Caption:=s3;

ans2label.Caption:=s2;

count:=count+1;

CloseFile(filo);

end

else begin

rez:='';

if count1>22 then

rez:=rez+'I'

else

rez:=rez+'E';

if count4>=22 then

rez:=rez+'N'

else

rez:=rez+'S';

if count3>=22 then

rez:=rez+'T'

else

rez:=rez+'F';

if count2>=22 then

rez:=rez+'P'

else

rez:=rez+'J';

AssignFile(users,'users.txt');

Append(users);

write(users,rez,'');

CloseFile(users);

quetion2Form.Visible:=false;

quetion3Form.Visible:=true;

end;

end;

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

var users:textfile;

begin

AssignFile(users,'users.txt');

Append(users);

writeln(users);

Closefile(users);

If MessageDlg('Вы уверены?',

mtConfirmation, mbOkCancel,0)=mrOk Then begin

Action:=caFree;

startForm.close;

end

Else

Action:=caNone;

end;

procedure Tquetion2Form.help1Click(Sender: TObject);

var c,s:string;

begin

c:='Помощь';

s:='В данном виде тестирования Вы можете выбрать один из наиболее подходящих вариантов. Этот вариант должен наиболее точно описывает Ваши мысли, чувства, жизненные ситуации.';

quetion2form.showhelp(c,s);

end;

procedure Tquetion2Form.about1Click(Sender: TObject);

var c,s:string;

begin

c:='О программе';

s:='Данная программа явлется курсовой работой студентки первого курса ИПСА группы КА-21 Светловой Елены.';

quetion2form.showhelp(c,s);

end;

end.

unit que3;

interface

uses

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

Dialogs, StdCtrls, Menus;

type

Tquetion3Form = class(TForm)

ans1Label: TLabel;

ans2Label: TLabel;

ans1button: TRadioButton;

ans2Button: TRadioButton;

next: TButton;

queLabel: TLabel;

MainMenu1: TMainMenu;

help1: TMenuItem;

about1: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure nextClick(Sender: TObject);

procedure help1Click(Sender: TObject);

procedure about1Click(Sender: TObject);

private

procedure showhelp(c,s:string);

public

{ Public declarations }

end;

var

quetion3Form: Tquetion3Form; str:string;

implementation

uses rezult, help;

{$R *.dfm}

procedure Tquetion3form.showhelp(c,s:string);

begin

helpForm.Caption:=c;

helpForm.helpMemo.Text:=s;

helpForm.visible:=true;

end;

procedure Tquetion3Form.FormCreate(Sender: TObject);

var f:textfile; s1,s2:string;

begin

AssignFile(f,'test3.txt');

Reset(f);

readln(f,s1);

readln(f,s2);

Closefile(f);

queLabel.Caption:='Выберите утверждение, которое наиболее точно описывает вас';

delete(s1,1,2);

delete(s2,1,2);

ans1label.Caption:=s1;

ans2label.Caption:=s2;

str:='';

end;

procedure Tquetion3Form.nextClick(Sender: TObject);

var f,users,otv:textfile; s1,s2:string; n1,n2,i:integer;

begin

if length(str+'11')<5 then begin

if ans1button.Checked=true then str:=str+'1'

else str:=str+'2';

AssignFile(f,'test3.txt');

Reset(f);

for i:=1 to 16 do begin

readln(f, n1, s1);

readln(f, n2, s2);

if n1=strtoint(str+'1') then ans1label.Caption:=s1;

if n2=strtoint(str+'2') then ans2label.Caption:=s2;

end;

CloseFile(f);

end

else begin

if ans1button.Checked=true then str:=str+'1'

else str:=str+'2';

AssignFile(otv,'test3_rez.txt');

Reset(otv);

AssignFile(users,'users.txt');

Append(users);

for i:=1 to 16 do begin

readln(otv, n1, s1);

if n1=strtoint(str) then writeln(users,s1);

end;

CloseFile(users);

CloseFile(otv);

quetion3form.Visible:=false;

rezultForm.Visible:=true;

end;

end;

procedure Tquetion3Form.help1Click(Sender: TObject);

var c,s:string;

begin

c:='Помощь';

s:='В данном виде тестирования Вы можете выбрать один из наиболее подходящих вариантов. Этот вариант должен наиболее точно описывает Ваши мысли, чувства, жизненные ситуации.';

quetion3form.showhelp(c,s);

end;

procedure Tquetion3Form.about1Click(Sender: TObject);

var c,s:string;

begin

c:='О программе';

s:='Данная программа явлется курсовой работой студентки первого курса ИПСА группы КА-21 Светловой Елены.';

quetion3form.showhelp(c,s);

end;

end.

unit rezult;

interface

uses

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

Dialogs, StdCtrls;

type

TrezultForm = class(TForm)

queLabel: TLabel;

next: TButton;

ans1Label: TMemo;

procedure FormShow(Sender: TObject);

procedure nextClick(Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

end;

var

rezultForm: TrezultForm;

implementation

uses main;

{$R *.dfm}

procedure TrezultForm.FormShow(Sender: TObject);

var users,rez:textfile; i,j,k:byte; s1,str1,str2,str3:string;

begin

AssignFile(users,'users.txt');

Reset(users);

i:=0;

while not eof(users) do begin

readln(users,s1);

i:=i+1;

end;

CloseFile(users);

Reset(users);

if i>1 then begin

for j:=1 to i-1 do

readln(users,s1);

readln(users,s1);

end;

CloseFile(users);

for j:=1 to 3 do begin

k:=pos(' ',s1);

delete(s1,1,k);

end;

k:=pos(' ',s1);

str1:=copy(s1,1,k-1);

delete(s1,1,k);

k:=pos(' ',s1);

str2:=copy(s1,1,k-1);

delete(s1,1,k);

str3:=s1;

AssignFile(rez,'fin_rez.txt');

Reset(rez);

if ((str1=str2) and (str2=str3)) or (str1=str2) or (str1=str3) then begin

while not eof(rez) do begin

s1:='';

readln(rez,s1);

if s1=str1 then begin

readln(rez,str2);

quelabel.Caption:='Поздравляем, тестирование окончено! Вы - '+str2;

readln(rez,str2);

ans1label.text:=str2;

end;

end;

end

else begin

if (str2=str3) then begin

while not eof(rez) do begin

readln(rez,s1);

if s1=str2 then begin

readln(rez,str1);

quelabel.Caption:='Поздравляем, тестирование окончено! Вы - '+str1;

readln(rez,str1);

ans1label.text:=str1;

end;

end;

end

else begin

quelabel.Caption:='Поздравляем, тестирование окончено!';

ans1label.text:='Вы настолько противоречивый человек, что мы не смогли определить Ваш тип. Вам стоит обратиться к консультанту.';

end;

end;

CloseFile(rez);

end;

procedure TrezultForm.nextClick(Sender: TObject);

begin

startForm.Close;

end;

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

begin

If MessageDlg('Вы уверены?',

mtConfirmation, mbOkCancel,0)=mrOk Then begin

Action:=caFree;

startForm.Close;

end

Else

Action:=caNone;

end;

end.

unit pas;

interface

uses

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

Dialogs, StdCtrls;

type

TpasForm = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Label1: TLabel;

Button1: TButton;

Button2: TButton;

Label2: TLabel;

Label3: TLabel;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

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

procedure pasread(password:string);

private

{ Private declarations }

public

{ Public declarations }

end;

var

pasForm: TpasForm;

implementation

uses main, admin;

{$R *.dfm}

procedure TpasForm.pasread(password:string);

var pasfile:textfile;

begin

AssignFile(pasfile,'password.txt');

Reset(pasfile);

read(pasfile,password);

closefile(pasfile);

end;

procedure TpasForm.Button2Click(Sender: TObject);

begin

startForm.visible:=true;

pasForm.Visible:=false;

end;

procedure TpasForm.Button1Click(Sender: TObject);

var password:string; pasfile:textfile;

begin

AssignFile(pasfile,'password.txt');

Reset(pasfile);

read(pasfile,password);

closefile(pasfile);

if (edit1.Text=edit2.Text) and (edit1.Text=password) then begin

AdminForm.Visible:=true;

pasForm.Visible:=false;

edit1.Text:='';

edit2.Text:='';

end

else

ShowMessage('Неверный пароль');

end;

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

begin

If MessageDlg('Выйти из программы?',

mtConfirmation, mbOkCancel,0)=mrOk Then begin

Action:=caFree;

startForm.Close;

end

Else

Action:=caNone;

end;

end.

unit admin;

interface

uses

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

Dialogs, StdCtrls;

type

TAdminForm = class(TForm)

ViewButton: TButton;

ClearButton: TButton;

Label1: TLabel;

ChangeButton: TButton;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Button2: TButton;

Button3: TButton;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

ExitButton: TButton;

procedure ClearButtonClick(Sender: TObject);

procedure ExitButtonClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure ChangeButtonClick(Sender: TObject);

procedure Button3Click(Sender: TObject);

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

procedure Button2Click(Sender: TObject);

procedure ViewButtonClick(Sender: TObject);

procedure pasread(password:string);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AdminForm: TAdminForm;

implementation

uses main,data;

{$R *.dfm}

procedure TAdminForm.ClearButtonClick(Sender: TObject);

var users:textfile;

begin

AssignFile(users,'users.txt');

Rewrite(users);

CloseFile(users);

ShowMessage('Готово');

end;

procedure TAdminForm.pasread(password:string);

var pasfile:textfile;

begin

AssignFile(pasfile,'password.txt');

Reset(pasfile);

read(pasfile,password);

closefile(pasfile);

end;

procedure TAdminForm.ExitButtonClick(Sender: TObject);

begin

AdminForm.Visible:=false;

StartForm.Visible:=true;

end;

procedure TAdminForm.FormCreate(Sender: TObject);

begin

label2.Visible:=false;

label3.Visible:=false;

label4.Visible:=false;

edit1.Visible:=false;

edit2.Visible:=false;

edit3.Visible:=false;

button2.Visible:=false;

button3.Visible:=false;

end;

procedure TAdminForm.ChangeButtonClick(Sender: TObject);

begin

viewButton.Visible:=false;

ClearButton.Visible:=false;

ExitButton.Visible:=false;

changeButton.Visible:=false;

label1.Caption:='Смена пароля';

label2.Visible:=true;

label3.Visible:=true;

label4.Visible:=true;

edit1.Visible:=true;

edit2.Visible:=true;

edit3.Visible:=true;

button2.Visible:=true;

button3.Visible:=true;

label2.Caption:='Введите старый пароль';

label3.Caption:='Введите новый пароль';

label4.Caption:='Повторите новый пароль';

edit1.text:='';

edit2.text:='';

edit3.text:='';

button3.Caption:='Отмена';

button2.Caption:='Готово';

end;

procedure TAdminForm.Button3Click(Sender: TObject);

begin

viewButton.Visible:=true;

ClearButton.Visible:=true;

ExitButton.Visible:=true;

changeButton.Visible:=true;

label1.Caption:='Выберите действие';

label2.Visible:=false;

label3.Visible:=false;

label4.Visible:=false;

edit1.Visible:=false;

edit2.Visible:=false;

edit3.Visible:=false;

button2.Visible:=false;

button3.Visible:=false;

end;

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

begin

If MessageDlg('Выйти из программы?',

mtConfirmation, mbOkCancel,0)=mrOk Then begin

Action:=caFree;

startForm.Close;

end

Else

Action:=caNone; //Нажата Cancel - игнорируем закрытие.

end;

procedure TAdminForm.Button2Click(Sender: TObject);

var password:string; pasfile:textfile;

begin

pasread(password);

AssignFile(pasfile,'password.txt');

if (edit1.Text=password) then begin

if (edit2.Text=edit3.Text) then begin

password:=edit2.Text;

Rewrite(pasfile);

write(pasfile,password);

closeFile(pasfile);

viewButton.Visible:=true;

ClearButton.Visible:=true;

ExitButton.Visible:=true;

changeButton.Visible:=true;

label1.Caption:='Выберите действие';

label2.Visible:=false;

label3.Visible:=false;

label4.Visible:=false;

edit1.Visible:=false;

edit2.Visible:=false;

edit3.Visible:=false;

button2.Visible:=false;

button3.Visible:=false;

end

else

showmessage('Введенные пароли не совпадают.');

end

else

showmessage('Старый пароль не верный.');

end;

procedure TAdminForm.ViewButtonClick(Sender: TObject);

begin

DataForm.Visible:=true;

end;

end.

unit data;

interface

uses

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

Dialogs, StdCtrls, Grids;

type

TDataForm = class(TForm)

table: TStringGrid;

StaticText1: TStaticText;

StaticText2: TStaticText;

StaticText4: TStaticText;

StaticText5: TStaticText;

StaticText6: TStaticText;

StaticText3: TStaticText;

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

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

DataForm: TDataForm;

implementation

uses main, admin, help;

{$R *.dfm}

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

begin

DataForm.Visible:=false;

end;

procedure TDataForm.FormCreate(Sender: TObject);

var users,outf:textfile; i,j,n,k:byte; str,c:string;

begin

AssignFile(users,'users.txt');

AssignFile(outf,'out.txt');

Rewrite(outf);

Reset(users); i:=0; n:=0;

while not eof(users) do begin

readln(users,str);

i:=i+1;

end;

n:=i+1;

write(outf,n);

closeFile(users);

closeFile(outf);

table.RowCount:=n;

AssignFile(users,'users.txt');

Reset(users);

for i:=1 to n do begin

j:=1;

readln(users,c);

while (length(c)>4) do begin

k:=pos(' ',c);

str:=copy(c,1,k-1);

delete(c,1,k);

table.Cells[j,i]:=str;

j:=j+1;

end;

table.Cells[j,i]:=c;

end;

closeFile(users);

end;

end.

unit help;

interface

uses

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

Dialogs, StdCtrls;

type

ThelpForm = class(TForm)

helpMemo: TMemo;

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

private

{ Private declarations }

public

{ Public declarations }

end;

var helpForm: ThelpForm;

implementation

uses main;

{$R *.dfm}

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

begin

helpform.Visible:=false;

end;

end.

Наши рекомендации