EugeneBoss3
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
====================================================================
Пример реализации
====================================================================
program Initialize;
uses
Forms,
Windows,
MainFrm in 'MainFrm.pas' {frmMain},
AccessFrm in 'AccessFrm.pas' {frmAccess};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfrmMain, frmMain);
Application.CreateForm(TfrmAccess, frmAccess);
// показать форму доступа
frmAccess.Show;
Application.Run;
end.
// форма доступа
unit AccessFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TfrmAccess = class(TForm)
ePassword: TEdit;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ePasswordChange(Sender: TObject);
procedure ePasswordExit(Sender: TObject);
private
{ Private declarations }
sPassword, sUserName : string;
bAccess: Boolean;
function CheckUserAccess:Boolean;
public
{ Public declarations }
end;
var
frmAccess: TfrmAccess;
implementation
uses MainFrm;
{$R *.dfm}
procedure TfrmAccess.FormCreate(Sender: TObject);
begin
bAccess := False;
sUserName := 'User';
end;
procedure TfrmAccess.FormShow(Sender: TObject);
begin
sPassword:= Trim(ePassword.Text);
end;
procedure TfrmAccess.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//если набран необходимый пароль, то
if bAccess then
begin
//показать главное окно
frmMain.Show;
Exit //выйти из этой процедуры
end
else begin
// завершить программу
Application.Terminate;
Exit;
end;
end;
procedure TfrmAccess.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
// скрыть форму frmAccess
Hide;
// выполнить инициализацию доступа
if not( bAccess )
then MessageDlg('Извините!'+#10+
'У Вас нет прав доступа!'+#10+
'Программа будет закрыта!', mtWarning,[mbOk],0)
else begin
if (MessageDlg('Приветствую Вас '+#10+
sUserName+'!'+#10+
'Будем работать?',
mtConfirmation, [mbYes, mbNo], 0 ) = mrNo) then
begin
MessageDlg('Ваше право!'+#10+
'Программа будет закрыта!', mtWarning,[mbOk],0);
bAccess:= False;
end;
end;
end;
end;
end;
function TfrmAccess.CheckUserAccess:Boolean;
begin
Result := False;
if not (sPassword='') then
begin
if sPassword='Admin'
then Result := True
else Result := False;
end;
end;
procedure TfrmAccess.ePasswordChange(Sender: TObject);
begin
sPassword:= Trim(ePassword.Text);
CheckUserAccess;
end;
procedure TfrmAccess.ePasswordExit(Sender: TObject);
begin
sPassword:= Trim(ePassword.Text);
CheckUserAccess;
end;
end.
|
Всего записей: 247 | Зарегистр. 15-09-2009 | Отправлено: 07:50 07-12-2009 | Исправлено: EugeneBoss3, 03:41 08-12-2009 |
|
