СПИСОК ВИКОРИСТАНОЇ ЛІТЕРАТУРИ. 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.