Все спасибо огромное всем кто помог. Для нашего учреждения хоть оно и маленькое, это незаменимая программа. Осталось только сделать форму входа(аторизации). Я ее создал все работает, создал экран приветствия но проблема в то что загружаеться сначала форма авторизации и после успеха грузиться Form1(основная форма) а подскажите пожалуйства как сделать или что добавить конкретно что бы сначала грузилась форма приветствия - потом форма авторизации и при успехе основная форма(Form1). Вот мой скрипт:
var
Timer: TTimer;
procedure frmSplash_OnShow (Sender: string; Action: string);
begin
Timer := TTimer.Create(nil); // create timer
Timer.OnTimer := @OnTimer; // event procedure
Timer.Interval := 5000; // 5 sec
Timer.Enabled := True; // Start timer
frmSplash.ShowModal; // Show welcome screen
end;
procedure OnTimer (Sender: TObject);
begin
Timer.Enabled := False;
frmSplash.Close;
Timer.Free;
end;
CONST
APP_NAME = 'MVDLogin';
var
sUser: string = '';
procedure Form1_OnShow (Sender: string; Action: string);
begin
// Initial check whether there is a database administrator user
// if not, create an administrator with username admin and password admin
if SQLExecute('SELECT count(id) FROM users;') = '0' then
SQLExecute('INSERT INTO users (login, password) VALUES ("ОО", "ТАЙНА");');
frmLogin.Button1.Default := True;
LoadRememberUser;
frmLogin.edPassword.PasswordChar := '*';
frmLogin.ShowModal; // show windows for login
end;
procedure frmLogin_bLogin_OnClick (Sender: string; var Cancel: boolean);
var
s: string;
begin
// SQL query for check user and password
s := SQLExecute('SELECT count(id) FROM users WHERE (id = ' + IntToStr(frmLogin.cbLogin.dbItemID) + ') AND (password = ''' + frmLogin.edPassword.Text + ''');');
// if SQL query found login and password
if (s <> '0') and (s<>'') then
begin
sUser := frmLogin.cbLogin.Text; // remember username
Form1.Caption := 'User: ' + sUser;
frmLogin.Close; // close login form
SaveRememberUser;
end else MessageDlg('password is incorrect', mtError, mbOk, 0); // message if the password is incorrect
end;
// window closing event for login
procedure frmLogin_OnClose (Sender: string; Action: string);
begin
// if the user has not been defined, and the user closes the login window, then close the main form
if sUser='' then Form1.Close;
end;
procedure SaveRememberUser;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.Access := KEY_ALL_ACCESS;
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKey('software\' + APP_NAME, true) then
begin
if frmLogin.chbRemember.Checked then
Reg.WriteInteger('userid', frmLogin.cbLogin.dbItemID)
else Reg.DeleteValue('userid');
reg.CloseKey;
end;
reg.Free;
end;
procedure LoadRememberUser;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.Access := KEY_ALL_ACCESS;
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKey('software\' + APP_NAME, true) then
begin
if reg.ValueExists('userid') then
begin
frmLogin.cbLogin.dbItemID := Reg.ReadInteger('userid');
if Reg.ReadInteger('userid') <> -1 then frmLogin.chbRemember.Checked := True;
end;
reg.CloseKey;
end;
reg.Free;
end;
procedure frmLogin_Image1_OnMouseDown (Sender: TObject; MouseLeft, MouseRight, MouseMiddle: boolean; Shift, Alt, Ctrl: boolean; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Form1.Handle, WM_SYSCOMMAND, 61458, 0) ;
end;
procedure frmLogin_Label5_OnClick (Sender: TObject);
begin
frmLogin.WindowState := wsMinimized;
end;
procedure frmLogin_Label5_OnMouseLeave (Sender: TObject);
begin
Form1.Label5.Font.Style:= fsUnderline - fsUnderline;
end;
procedure frmLogin_Label6_OnClick (Sender: TObject);
begin
frmLogin.Close;
end;
procedure frmLogin_chbRemember_OnMouseEnter (Sender: TObject);
begin
frmLogin.chbRemember.Color:=$002F2C21 ;
end;
begin
end.
archived orders.zip
Безымянный.png
