Стартовый пул
This commit is contained in:
@@ -0,0 +1,40 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="rx_sort_sqldb"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="rx_sort_sqldb"/>
|
||||
<UnitOutputDirectory Value="lib/rx_sort_sqldb/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Version Major="1" Minor="1" Release="1" Build="2"/>
|
||||
<Files Count="2">
|
||||
<Item1>
|
||||
<Filename Value="rx_sort_sqldb/rxsortsqldb.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="RxSortSqlDB"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="rx_sort_sqldb/exsortsql.pas"/>
|
||||
<UnitName Value="exsortsql"/>
|
||||
</Item2>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="SQLDBLaz"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="rxnew"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,22 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit dcl_rx_ctrl;
|
||||
|
||||
{$warn 5023 off : no warning about unused units}
|
||||
interface
|
||||
|
||||
uses
|
||||
register_rxctrl, rxceEditLookupFields, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('register_rxctrl', @register_rxctrl.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('dcl_rx_ctrl', @Register);
|
||||
end.
|
||||
@@ -0,0 +1,770 @@
|
||||
{ rxlogin unit
|
||||
|
||||
Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
|
||||
original conception from rx library for Delphi (c)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit rxlogin;
|
||||
|
||||
{$I RX.INC}
|
||||
|
||||
interface
|
||||
|
||||
uses LResources, LCLType, LCLIntf, SysUtils, LMessages, Classes, Graphics,
|
||||
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;
|
||||
|
||||
type
|
||||
TUpdateCaption = (ucNoChange, ucAppTitle, ucFormCaption);
|
||||
|
||||
TRxLoginOption = (rloCustomSelect, rloMoreBtn, rloHelpBtn);
|
||||
|
||||
TRxLoginOptions = set of TRxLoginOption;
|
||||
|
||||
TRxLoginStorageParam = (rlsUserName, rlsTop, rlsLeft, rlsDetailStatus,
|
||||
rlsDetailItem);
|
||||
TRxLoginStorageParams = set of TRxLoginStorageParam;
|
||||
|
||||
TRxLoginEvent = procedure(Sender: TObject; const UserName, Password: string;
|
||||
var AllowLogin: Boolean) of object;
|
||||
TCheckUnlockEvent = function(const Password: string): Boolean of object;
|
||||
TUnlockAppEvent = procedure(Sender: TObject; const UserName,
|
||||
Password: string; var AllowUnlock: Boolean) of object;
|
||||
|
||||
TRxLoginForm = class;
|
||||
|
||||
{ TRxCustomLogin }
|
||||
|
||||
TRxCustomLogin = class(TComponent)
|
||||
private
|
||||
FActive: Boolean;
|
||||
FAttemptNumber: Integer;
|
||||
FDetailItem: integer;
|
||||
FDetailItems: TStrings;
|
||||
FLoggedUser: string;
|
||||
FMaxPasswordLen: Integer;
|
||||
FAllowEmpty: Boolean;
|
||||
FLoginOptions: TRxLoginOptions;
|
||||
FShowDetails: boolean;
|
||||
FStorageParams: TRxLoginStorageParams;
|
||||
FUpdateCaption: TUpdateCaption;
|
||||
FIniFileName: string;
|
||||
FUseRegistry: Boolean;
|
||||
FLocked: Boolean;
|
||||
FUnlockDlgShowing: Boolean;
|
||||
FSaveOnRestore: TNotifyEvent;
|
||||
FAfterLogin: TNotifyEvent;
|
||||
FBeforeLogin: TNotifyEvent;
|
||||
FOnUnlock: TCheckUnlockEvent;
|
||||
FOnUnlockApp: TUnlockAppEvent;
|
||||
FOnIconDblClick: TNotifyEvent;
|
||||
function GetIniFileName: string;
|
||||
procedure SetDetailItems(const AValue: TStrings);
|
||||
procedure SetLoginOptions(const AValue: TRxLoginOptions);
|
||||
procedure SetShowDetails(const AValue: boolean);
|
||||
function UnlockHook(var Message: TLMessage): Boolean;
|
||||
protected
|
||||
function CheckUnlock(const UserName, Password: string): Boolean; dynamic;
|
||||
function CreateLoginForm(UnlockMode: Boolean): TRxLoginForm; virtual;
|
||||
procedure DoAfterLogin; dynamic;
|
||||
procedure DoBeforeLogin; dynamic;
|
||||
procedure DoIconDblCLick(Sender: TObject); dynamic;
|
||||
function DoLogin(var UserName: string): Boolean; virtual; abstract;
|
||||
function DoUnlockDialog: Boolean; virtual;
|
||||
procedure SetLoggedUser(const Value: string);
|
||||
procedure DoUpdateCaption;
|
||||
procedure UnlockOkClick(Sender: TObject);
|
||||
property Active: Boolean read FActive write FActive default True;
|
||||
property AllowEmptyPassword: Boolean read FAllowEmpty write FAllowEmpty default True;
|
||||
property AttemptNumber: Integer read FAttemptNumber write FAttemptNumber default 3;
|
||||
property IniFileName: string read GetIniFileName write FIniFileName;
|
||||
property MaxPasswordLen: Integer read FMaxPasswordLen write FMaxPasswordLen default 0;
|
||||
property UpdateCaption: TUpdateCaption read FUpdateCaption write FUpdateCaption default ucNoChange;
|
||||
property UseRegistry: Boolean read FUseRegistry write FUseRegistry default False;
|
||||
property ShowDetails: boolean read FShowDetails write SetShowDetails;
|
||||
property StorageParams:TRxLoginStorageParams read FStorageParams write FStorageParams default [rlsUserName];
|
||||
property DetailItems:TStrings read FDetailItems write SetDetailItems;
|
||||
property DetailItem:integer read FDetailItem write FDetailItem;
|
||||
property LoginOptions:TRxLoginOptions read FLoginOptions write SetLoginOptions default [rloCustomSelect, rloMoreBtn, rloHelpBtn];
|
||||
|
||||
property AfterLogin: TNotifyEvent read FAfterLogin write FAfterLogin;
|
||||
property BeforeLogin: TNotifyEvent read FBeforeLogin write FBeforeLogin;
|
||||
property OnUnlock: TCheckUnlockEvent read FOnUnlock write FOnUnlock; { obsolete }
|
||||
property OnUnlockApp: TUnlockAppEvent read FOnUnlockApp write FOnUnlockApp;
|
||||
property OnIconDblClick: TNotifyEvent read FOnIconDblClick write FOnIconDblClick;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function Login: Boolean; virtual;
|
||||
procedure TerminateApplication;
|
||||
procedure Lock;
|
||||
property LoggedUser: string read FLoggedUser;
|
||||
end;
|
||||
|
||||
{ TRxLoginDialog }
|
||||
|
||||
TRxLoginDialog = class(TRxCustomLogin)
|
||||
private
|
||||
FOnCheckUser: TRxLoginEvent;
|
||||
FUserName:string;
|
||||
FFormTop:integer;
|
||||
FFormLeft:integer;
|
||||
procedure OkButtonClick(Sender: TObject);
|
||||
procedure WriteParams;
|
||||
procedure LoadParams;
|
||||
protected
|
||||
function DoCheckUser(const UserName, Password: string): Boolean; dynamic;
|
||||
function DoLogin(var UserName: string): Boolean; override;
|
||||
procedure Loaded; override;
|
||||
published
|
||||
property Active;
|
||||
property AttemptNumber;
|
||||
property IniFileName;
|
||||
property DetailItems;
|
||||
property DetailItem;
|
||||
property MaxPasswordLen;
|
||||
property UpdateCaption;
|
||||
property UseRegistry;
|
||||
property ShowDetails;
|
||||
property LoginOptions;
|
||||
property StorageParams;
|
||||
property OnCheckUser: TRxLoginEvent read FOnCheckUser write FOnCheckUser;
|
||||
property AfterLogin;
|
||||
property BeforeLogin;
|
||||
property OnUnlockApp;
|
||||
property OnIconDblClick;
|
||||
end;
|
||||
|
||||
{ TRxLoginForm }
|
||||
|
||||
TRxLoginForm = class(TForm)
|
||||
AppIcon: TImage;
|
||||
btnHelp: TBitBtn;
|
||||
btnMore: TBitBtn;
|
||||
btnCancel: TBitBtn;
|
||||
KeyImage: TImage;
|
||||
HintLabel: TLabel;
|
||||
btnOK: TBitBtn;
|
||||
UserNameLabel: TLabel;
|
||||
PasswordLabel: TLabel;
|
||||
UserNameEdit: TEdit;
|
||||
PasswordEdit: TEdit;
|
||||
AppTitleLabel: TLabel;
|
||||
DataBaseLabel: TLabel;
|
||||
CustomCombo: TComboBox;
|
||||
procedure btnMoreClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnOKClick(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
private
|
||||
FSelectDatabase: Boolean;
|
||||
FUnlockMode: Boolean;
|
||||
FAttempt: Integer;
|
||||
FOnFormShow: TNotifyEvent;
|
||||
FOnOkClick: TNotifyEvent;
|
||||
function GetShowDetailParams: boolean;
|
||||
procedure SetLoginOptions(const AValue: TRxLoginOptions);
|
||||
procedure SetShowDetailParams(const AValue: boolean);
|
||||
public
|
||||
{ Public declarations }
|
||||
AttemptNumber: Integer;
|
||||
property Attempt: Integer read FAttempt;
|
||||
property SelectDatabase: Boolean read FSelectDatabase write FSelectDatabase;
|
||||
property OnFormShow: TNotifyEvent read FOnFormShow write FOnFormShow;
|
||||
property OnOkClick: TNotifyEvent read FOnOkClick write FOnOkClick;
|
||||
property ShowDetailParams:boolean read GetShowDetailParams write SetShowDetailParams;
|
||||
property LoginOptions:TRxLoginOptions write SetLoginOptions;
|
||||
end;
|
||||
|
||||
function CreateLoginDialog(UnlockMode, ASelectDatabase: Boolean;
|
||||
FormShowEvent, OkClickEvent: TNotifyEvent): TRxLoginForm;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Registry, IniFiles, RxAppUtils, RxDConst, rxlclutils, RxConst;
|
||||
|
||||
const
|
||||
keyLoginSection = 'Login Dialog';
|
||||
keyLastLoginUserName = 'Last Logged User';
|
||||
keyLastLoginFormTop = 'Last Logged Form Top';
|
||||
keyLastLoginFormLeft = 'Last Logged Form Left';
|
||||
keyLastLoginFormDetailStatus = 'Last Logged Detail Status';
|
||||
keyLastLoginFormDetailSelected = 'Last Logged Selected Detail';
|
||||
|
||||
|
||||
function CreateLoginDialog(UnlockMode, ASelectDatabase: Boolean;
|
||||
FormShowEvent, OkClickEvent: TNotifyEvent): TRxLoginForm;
|
||||
begin
|
||||
Result := TRxLoginForm.Create(Application);
|
||||
with Result do
|
||||
begin
|
||||
FSelectDatabase := ASelectDatabase;
|
||||
FUnlockMode := UnlockMode;
|
||||
if FUnlockMode then
|
||||
begin
|
||||
FormStyle := fsNormal;
|
||||
FSelectDatabase := False;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FormStyle := fsStayOnTop;
|
||||
end;
|
||||
OnFormShow := FormShowEvent;
|
||||
OnOkClick := OkClickEvent;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TRxCustomLogin }
|
||||
|
||||
constructor TRxCustomLogin.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDetailItems:=TStringList.Create;
|
||||
FActive := True;
|
||||
FAttemptNumber := 3;
|
||||
FAllowEmpty := True;
|
||||
FUseRegistry := False;
|
||||
FStorageParams:=[rlsUserName];
|
||||
FLoginOptions:=[rloCustomSelect, rloMoreBtn, rloHelpBtn];
|
||||
end;
|
||||
|
||||
destructor TRxCustomLogin.Destroy;
|
||||
begin
|
||||
if FLocked then
|
||||
begin
|
||||
// Application.UnhookMainWindow(UnlockHook);
|
||||
FLocked := False;
|
||||
end;
|
||||
FreeAndNil(FDetailItems);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TRxCustomLogin.GetIniFileName: string;
|
||||
begin
|
||||
Result := FIniFileName;
|
||||
if (Result = '') and not (csDesigning in ComponentState) then
|
||||
begin
|
||||
if UseRegistry then
|
||||
Result := GetDefaultIniRegKey
|
||||
else
|
||||
Result := GetDefaultIniName;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.SetDetailItems(const AValue: TStrings);
|
||||
begin
|
||||
if Assigned(AValue) then
|
||||
FDetailItems.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.SetLoginOptions(const AValue: TRxLoginOptions);
|
||||
begin
|
||||
if FLoginOptions=AValue then exit;
|
||||
FLoginOptions:=AValue;
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.SetShowDetails(const AValue: boolean);
|
||||
begin
|
||||
if FShowDetails=AValue then exit;
|
||||
FShowDetails:=AValue;
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.SetLoggedUser(const Value: string);
|
||||
begin
|
||||
FLoggedUser := Value;
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.DoAfterLogin;
|
||||
begin
|
||||
if Assigned(FAfterLogin) then FAfterLogin(Self);
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.DoBeforeLogin;
|
||||
begin
|
||||
if Assigned(FBeforeLogin) then FBeforeLogin(Self);
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.DoIconDblCLick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnIconDblClick) then FOnIconDblClick(Self);
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.DoUpdateCaption;
|
||||
var
|
||||
F: TForm;
|
||||
begin
|
||||
F := Application.MainForm;
|
||||
if (F = nil) and (Owner is TForm) then F := Owner as TForm;
|
||||
if (F <> nil) and (LoggedUser <> '') then
|
||||
case UpdateCaption of
|
||||
ucAppTitle:
|
||||
F.Caption := Format('%s (%s)', [Application.Title, LoggedUser]);
|
||||
ucFormCaption:
|
||||
begin
|
||||
F.Caption := Format('%s (%s)', [F.Caption, LoggedUser]);
|
||||
UpdateCaption := ucNoChange;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxCustomLogin.Login: Boolean;
|
||||
var
|
||||
LoginName: string;
|
||||
begin
|
||||
LoginName := EmptyStr;
|
||||
DoBeforeLogin;
|
||||
Result := DoLogin(LoginName);
|
||||
if Result then
|
||||
begin
|
||||
SetLoggedUser(LoginName);
|
||||
DoUpdateCaption;
|
||||
DoAfterLogin;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.Lock;
|
||||
begin
|
||||
// FSaveOnRestore := Application.OnRestore;
|
||||
Application.Minimize;
|
||||
// Application.HookMainWindow(UnlockHook);
|
||||
FLocked := True;
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.TerminateApplication;
|
||||
begin
|
||||
with Application do
|
||||
begin
|
||||
ShowMainForm := False;
|
||||
{ if Application.Handle <> 0 then
|
||||
ShowOwnedPopups(Handle, False);}
|
||||
Terminate;
|
||||
end;
|
||||
CallTerminateProcs;
|
||||
Halt(10);
|
||||
end;
|
||||
|
||||
procedure TRxCustomLogin.UnlockOkClick(Sender: TObject);
|
||||
var
|
||||
Ok: Boolean;
|
||||
begin
|
||||
with TRxLoginForm(Sender) do begin
|
||||
Ok := False;
|
||||
try
|
||||
Ok := CheckUnlock(UserNameEdit.Text, PasswordEdit.Text);
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
end;
|
||||
if Ok then ModalResult := mrOk
|
||||
else ModalResult := mrCancel;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxCustomLogin.CheckUnlock(const UserName, Password: string): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if Assigned(FOnUnlockApp) then
|
||||
FOnUnlockApp(Self, UserName, Password, Result)
|
||||
else if Assigned(FOnUnlock) then
|
||||
Result := FOnUnlock(Password);
|
||||
end;
|
||||
|
||||
function TRxCustomLogin.CreateLoginForm(UnlockMode: Boolean): TRxLoginForm;
|
||||
begin
|
||||
Result := TRxLoginForm.Create(Application);
|
||||
with Result do
|
||||
begin
|
||||
FUnlockMode := UnlockMode;
|
||||
if FUnlockMode then
|
||||
begin
|
||||
FormStyle := fsNormal;
|
||||
FSelectDatabase := False;
|
||||
end
|
||||
else
|
||||
FormStyle := fsStayOnTop;
|
||||
if Assigned(Self.FOnIconDblClick) then
|
||||
begin
|
||||
with AppIcon do
|
||||
begin
|
||||
OnDblClick := @DoIconDblClick;
|
||||
Cursor := crHandPoint;
|
||||
end;
|
||||
with KeyImage do
|
||||
begin
|
||||
OnDblClick := @DoIconDblClick;
|
||||
Cursor := crHandPoint;
|
||||
end;
|
||||
end;
|
||||
PasswordEdit.MaxLength := FMaxPasswordLen;
|
||||
AttemptNumber := Self.AttemptNumber;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxCustomLogin.DoUnlockDialog: Boolean;
|
||||
begin
|
||||
with CreateLoginForm(True) do
|
||||
try
|
||||
OnFormShow := nil;
|
||||
OnOkClick := @UnlockOkClick;
|
||||
with UserNameEdit do
|
||||
begin
|
||||
Text := LoggedUser;
|
||||
ReadOnly := True;
|
||||
Font.Color := clGrayText;
|
||||
end;
|
||||
Result := ShowModal = mrOk;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxCustomLogin.UnlockHook(var Message: TLMessage): Boolean;
|
||||
|
||||
function DoUnlock: Boolean;
|
||||
var
|
||||
Popup: HWnd;
|
||||
begin
|
||||
(* with Application do
|
||||
if IsWindowVisible(Application.Handle) and IsWindowEnabled(Handle) then
|
||||
{$IFDEF WIN32}
|
||||
SetForegroundWindow(Handle);
|
||||
{$ELSE}
|
||||
BringWindowToTop(Handle);
|
||||
{$ENDIF}
|
||||
if FUnlockDlgShowing then begin
|
||||
Popup := GetLastActivePopup(Application.Handle);
|
||||
if (Popup <> 0) and IsWindowVisible(Popup) and
|
||||
(WindowClassName(Popup) = TRxLoginForm.ClassName) then
|
||||
begin
|
||||
{$IFDEF WIN32}
|
||||
SetForegroundWindow(Popup);
|
||||
{$ELSE}
|
||||
BringWindowToTop(Popup);
|
||||
{$ENDIF}
|
||||
end; //*)
|
||||
Result := False;
|
||||
(* Exit;
|
||||
end;
|
||||
FUnlockDlgShowing := True;
|
||||
try
|
||||
Result := DoUnlockDialog;
|
||||
finally
|
||||
FUnlockDlgShowing := False;
|
||||
end;
|
||||
if Result then begin
|
||||
Application.UnhookMainWindow(UnlockHook);
|
||||
FLocked := False;
|
||||
end;*)
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
if not FLocked then Exit;
|
||||
with Message do begin
|
||||
case Msg of
|
||||
{ LM_QUERYOPEN:
|
||||
begin
|
||||
UnlockHook := not DoUnlock;
|
||||
end;}
|
||||
LM_SHOWWINDOW:
|
||||
if Bool(WParam) then begin
|
||||
UnlockHook := not DoUnlock;
|
||||
end;
|
||||
LM_SYSCOMMAND:
|
||||
if (WParam and $FFF0 = SC_RESTORE)
|
||||
{ or (WParam and $FFF0 = SC_ZOOM) }then
|
||||
begin
|
||||
UnlockHook := not DoUnlock;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TRxLoginDialog }
|
||||
|
||||
procedure TRxLoginDialog.Loaded;
|
||||
var
|
||||
FLoading: Boolean;
|
||||
begin
|
||||
FLoading := csLoading in ComponentState;
|
||||
inherited Loaded;
|
||||
if not (csDesigning in ComponentState) and FLoading then
|
||||
begin
|
||||
if Active and not Login then
|
||||
TerminateApplication;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxLoginDialog.OkButtonClick(Sender: TObject);
|
||||
var
|
||||
SC: Boolean;
|
||||
begin
|
||||
with TRxLoginForm(Sender) do
|
||||
begin
|
||||
{$IFDEF WIN32}
|
||||
SC := GetCurrentThreadID = MainThreadID;
|
||||
{$ELSE}
|
||||
SC := True;
|
||||
{$ENDIF}
|
||||
try
|
||||
if SC then
|
||||
Screen.Cursor := crHourGlass;
|
||||
try
|
||||
if DoCheckUser(UserNameEdit.Text, PasswordEdit.Text) then
|
||||
ModalResult := mrOk
|
||||
else
|
||||
ModalResult := mrNone;
|
||||
finally
|
||||
if SC then Screen.Cursor := crDefault;
|
||||
end;
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxLoginDialog.DoCheckUser(const UserName, Password: string): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if Assigned(FOnCheckUser) then
|
||||
FOnCheckUser(Self, UserName, Password, Result);
|
||||
end;
|
||||
|
||||
procedure TRxLoginDialog.WriteParams;
|
||||
var
|
||||
Ini: TObject;
|
||||
begin
|
||||
try
|
||||
if UseRegistry then Ini := TRegIniFile.Create(IniFileName)
|
||||
else Ini := TIniFile.Create(IniFileName);
|
||||
try
|
||||
if rlsUserName in FStorageParams then
|
||||
IniWriteString(Ini, keyLoginSection, keyLastLoginUserName, FUserName);
|
||||
if rlsTop in FStorageParams then
|
||||
IniWriteInteger(Ini, keyLoginSection, keyLastLoginFormTop, FFormTop);
|
||||
if rlsLeft in FStorageParams then
|
||||
IniWriteInteger(Ini, keyLoginSection, keyLastLoginFormLeft, FFormLeft);
|
||||
if rlsDetailStatus in FStorageParams then
|
||||
IniWriteInteger(Ini, keyLoginSection, keyLastLoginFormDetailStatus, ord(FShowDetails));
|
||||
if rlsDetailItem in FStorageParams then
|
||||
IniWriteInteger(Ini, keyLoginSection, keyLastLoginFormDetailSelected, FDetailItem);
|
||||
finally
|
||||
Ini.Free;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxLoginDialog.LoadParams;
|
||||
var
|
||||
Ini: TObject;
|
||||
begin
|
||||
try
|
||||
if UseRegistry then
|
||||
begin
|
||||
Ini := TRegIniFile.Create(IniFileName);
|
||||
TRegIniFile(Ini).Access := KEY_READ;
|
||||
end
|
||||
else
|
||||
Ini := TIniFile.Create(IniFileName);
|
||||
try
|
||||
if rlsUserName in FStorageParams then
|
||||
FUserName:=IniReadString(Ini, keyLoginSection, keyLastLoginUserName, FUserName);
|
||||
if rlsTop in FStorageParams then
|
||||
FFormTop:=IniReadInteger(Ini, keyLoginSection, keyLastLoginFormTop, FFormTop);
|
||||
if rlsLeft in FStorageParams then
|
||||
FFormLeft:=IniReadInteger(Ini, keyLoginSection, keyLastLoginFormLeft, FFormLeft);
|
||||
if rlsDetailStatus in FStorageParams then
|
||||
FShowDetails:=IniReadInteger(Ini, keyLoginSection, keyLastLoginFormDetailStatus, ord(FShowDetails))=1;
|
||||
if rlsDetailItem in FStorageParams then
|
||||
FDetailItem:=IniReadInteger(Ini, keyLoginSection, keyLastLoginFormDetailSelected, FDetailItem);
|
||||
finally
|
||||
Ini.Free;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxLoginDialog.DoLogin(var UserName: string): Boolean;
|
||||
var
|
||||
LoginForm:TRxLoginForm;
|
||||
begin
|
||||
try
|
||||
LoginForm:=CreateLoginForm(False);
|
||||
try
|
||||
FUserName:=UserName;
|
||||
LoginForm.OnOkClick := @Self.OkButtonClick;
|
||||
LoadParams;
|
||||
LoginForm.LoginOptions:=FLoginOptions;
|
||||
|
||||
if rlsUserName in StorageParams then
|
||||
LoginForm.UserNameEdit.Text := FUserName;
|
||||
if rlsTop in StorageParams then
|
||||
LoginForm.Top:=FFormTop;
|
||||
if rlsLeft in StorageParams then
|
||||
LoginForm.Left:=FFormLeft;
|
||||
|
||||
if rloCustomSelect in LoginOptions then
|
||||
begin
|
||||
LoginForm.CustomCombo.Items.Assign(DetailItems);
|
||||
if (FDetailItem>=0) and (FDetailItem<DetailItems.Count) then
|
||||
LoginForm.CustomCombo.ItemIndex:=FDetailItem;
|
||||
end;
|
||||
|
||||
LoginForm.ShowDetailParams:=ShowDetails;
|
||||
|
||||
Result := (LoginForm.ShowModal = mrOk);
|
||||
if Result then
|
||||
begin
|
||||
if rlsTop in StorageParams then
|
||||
FFormTop:=LoginForm.Top;
|
||||
if rlsLeft in StorageParams then
|
||||
FFormLeft:=LoginForm.Left;
|
||||
|
||||
if rloCustomSelect in LoginOptions then
|
||||
FDetailItem:=LoginForm.CustomCombo.ItemIndex;
|
||||
|
||||
ShowDetails:=LoginForm.ShowDetailParams;
|
||||
UserName := LoginForm.UserNameEdit.Text;
|
||||
FUserName:=UserName;
|
||||
WriteParams;
|
||||
end;
|
||||
finally
|
||||
LoginForm.Free;
|
||||
end;
|
||||
except
|
||||
Application.HandleException(Self);
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TRxLoginForm }
|
||||
|
||||
procedure TRxLoginForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Icon.Assign(Application.Icon);
|
||||
// if Icon.Empty then Icon.Handle := LoadIcon(0, IDI_APPLICATION);
|
||||
AppIcon.Picture.Assign(Icon);
|
||||
AppTitleLabel.Caption := Format(SAppTitleLabel, [Application.Title]);
|
||||
PasswordLabel.Caption := SPasswordLabel;
|
||||
UserNameLabel.Caption := SUserNameLabel;
|
||||
end;
|
||||
|
||||
procedure TRxLoginForm.btnMoreClick(Sender: TObject);
|
||||
begin
|
||||
ShowDetailParams:=not ShowDetailParams;
|
||||
end;
|
||||
|
||||
procedure TRxLoginForm.btnOKClick(Sender: TObject);
|
||||
begin
|
||||
Inc(FAttempt);
|
||||
if Assigned(FOnOkClick) then FOnOkClick(Self)
|
||||
else ModalResult := mrOk;
|
||||
if (ModalResult <> mrOk) and (FAttempt >= AttemptNumber) then
|
||||
ModalResult := mrCancel;
|
||||
end;
|
||||
|
||||
procedure TRxLoginForm.FormShow(Sender: TObject);
|
||||
var
|
||||
I: Integer;
|
||||
S: string;
|
||||
begin
|
||||
if FSelectDatabase then
|
||||
begin
|
||||
ClientHeight := CustomCombo.Top + PasswordEdit.Top - UserNameEdit.Top;
|
||||
S := SDatabaseName;
|
||||
I := Pos(':', S);
|
||||
if I = 0 then I := Length(S);
|
||||
DataBaseLabel.Caption := '&' + Copy(S, 1, I);
|
||||
end
|
||||
else
|
||||
begin
|
||||
DataBaseLabel.Visible := False;
|
||||
CustomCombo.Visible := False;
|
||||
btnMore.Visible := False;
|
||||
end;
|
||||
|
||||
SetShowDetailParams(ShowDetailParams);
|
||||
|
||||
if not FUnlockMode then
|
||||
begin
|
||||
HintLabel.Caption := SHintLabel;
|
||||
Caption := SRegistration;
|
||||
end
|
||||
else
|
||||
begin
|
||||
HintLabel.Caption := SUnlockHint;
|
||||
Caption := SUnlockCaption;
|
||||
end;
|
||||
|
||||
if (UserNameEdit.Text = EmptyStr) and not FUnlockMode then
|
||||
ActiveControl := UserNameEdit
|
||||
else
|
||||
ActiveControl := PasswordEdit;
|
||||
if Assigned(FOnFormShow) then FOnFormShow(Self);
|
||||
FAttempt := 0;
|
||||
end;
|
||||
|
||||
procedure TRxLoginForm.SetShowDetailParams(const AValue: boolean);
|
||||
begin
|
||||
DataBaseLabel.Visible:=AValue;
|
||||
CustomCombo.Visible:=AValue;
|
||||
if AValue then
|
||||
begin
|
||||
btnMore.Caption:=SMore2;
|
||||
btnCancel.AnchorSideTop.Control:=CustomCombo;
|
||||
Height := CustomCombo.Top + CustomCombo.Height + btnCancel.Height + 12;
|
||||
end
|
||||
else
|
||||
begin
|
||||
btnMore.Caption:=SMore1;
|
||||
btnCancel.AnchorSideTop.Control:=PasswordEdit;
|
||||
Height := PasswordEdit.Top + PasswordEdit.Height + btnCancel.Height + 12;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxLoginForm.GetShowDetailParams: boolean;
|
||||
begin
|
||||
Result:=CustomCombo.Visible;
|
||||
end;
|
||||
|
||||
procedure TRxLoginForm.SetLoginOptions(const AValue: TRxLoginOptions);
|
||||
begin
|
||||
btnHelp.Visible:=rloHelpBtn in AValue;
|
||||
if not btnHelp.Visible then
|
||||
begin
|
||||
btnCancel.AnchorSideLeft.Side:=asrBottom;
|
||||
btnCancel.AnchorSideLeft.Control:=Self;
|
||||
end;
|
||||
|
||||
btnMore.Visible:=rloMoreBtn in AValue;
|
||||
FSelectDatabase:=rloCustomSelect in AValue;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I rxlogin.lrs}
|
||||
end.
|
||||
@@ -0,0 +1,140 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 427
|
||||
Height = 300
|
||||
Top = 245
|
||||
Width = 460
|
||||
ActiveControl = Edit1
|
||||
Caption = 'Main form'
|
||||
ClientHeight = 272
|
||||
ClientWidth = 460
|
||||
Menu = MainMenu1
|
||||
OnCreate = FormCreate
|
||||
Position = poDesktopCenter
|
||||
ShowHint = True
|
||||
LCLVersion = '1.7'
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Edit1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 20
|
||||
Top = 75
|
||||
Width = 96
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Folder for scan'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 6
|
||||
Height = 20
|
||||
Top = 6
|
||||
Width = 72
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Default ext'
|
||||
ParentColor = False
|
||||
end
|
||||
object Button1: TButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = DirectoryEdit1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 36
|
||||
Top = 144
|
||||
Width = 47
|
||||
Action = sysScan
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
TabOrder = 0
|
||||
end
|
||||
object DirectoryEdit1: TDirectoryEdit
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideTop.Control = Label1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 12
|
||||
Height = 37
|
||||
Top = 101
|
||||
Width = 417
|
||||
Directory = 'C:\lazarus\components\'
|
||||
ShowHidden = False
|
||||
ButtonWidth = 23
|
||||
NumGlyphs = 1
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
MaxLength = 0
|
||||
TabOrder = 1
|
||||
Text = 'C:\lazarus\components\'
|
||||
end
|
||||
object Edit1: TEdit
|
||||
AnchorSideLeft.Control = Label2
|
||||
AnchorSideTop.Control = Label2
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 12
|
||||
Height = 37
|
||||
Top = 32
|
||||
Width = 80
|
||||
BorderSpacing.Around = 6
|
||||
TabOrder = 2
|
||||
Text = '.pas'
|
||||
end
|
||||
object ActionList1: TActionList
|
||||
left = 144
|
||||
top = 112
|
||||
object sysExit: TAction
|
||||
Category = 'System'
|
||||
Caption = 'Exit'
|
||||
Enabled = False
|
||||
Hint = 'Exit form demo app'
|
||||
OnExecute = sysExitExecute
|
||||
ShortCut = 32856
|
||||
end
|
||||
object hlpAbout: TAction
|
||||
Category = 'Help'
|
||||
Caption = 'About'
|
||||
Hint = 'Information of app'
|
||||
OnExecute = hlpAboutExecute
|
||||
end
|
||||
object sysScan: TAction
|
||||
Category = 'System'
|
||||
Caption = 'Scan'
|
||||
Hint = 'Scan folder'
|
||||
OnExecute = sysRescanExecute
|
||||
end
|
||||
end
|
||||
object MainMenu1: TMainMenu
|
||||
left = 144
|
||||
top = 48
|
||||
object SystemItems: TMenuItem
|
||||
Caption = 'System'
|
||||
object MenuItem3: TMenuItem
|
||||
Action = sysScan
|
||||
OnClick = sysRescanExecute
|
||||
end
|
||||
object MenuItem4: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object MenuItem2: TMenuItem
|
||||
Action = sysExit
|
||||
end
|
||||
end
|
||||
object FolderItems: TMenuItem
|
||||
Caption = 'Folder'
|
||||
end
|
||||
object HelpItems: TMenuItem
|
||||
Caption = 'Help'
|
||||
object MenuItem1: TMenuItem
|
||||
Action = hlpAbout
|
||||
OnClick = hlpAboutExecute
|
||||
end
|
||||
end
|
||||
end
|
||||
object FolderLister1: TFolderLister
|
||||
DefaultExt = '.pas'
|
||||
OnExecuteItem = FolderLister1ExecuteItem
|
||||
MenuItem = FolderItems
|
||||
left = 144
|
||||
top = 12
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,55 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, rxdbgrid, RxSortZeos, ZConnection, ZDataset,
|
||||
Forms, Controls, Graphics, Dialogs, db;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
DataSource1: TDataSource;
|
||||
RxDBGrid1: TRxDBGrid;
|
||||
RxSortZeos1: TRxSortZeos;
|
||||
ZConnection1: TZConnection;
|
||||
ZReadOnlyQuery1: TZReadOnlyQuery;
|
||||
ZReadOnlyQuery1DEPARTMENT: TStringField;
|
||||
ZReadOnlyQuery1DEPT_NO: TStringField;
|
||||
ZReadOnlyQuery1LOCATION: TStringField;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure ZReadOnlyQuery1FilterRecord(DataSet: TDataSet; var Accept: Boolean
|
||||
);
|
||||
private
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
ZConnection1.Connected:=true;
|
||||
ZReadOnlyQuery1.Open;
|
||||
end;
|
||||
|
||||
procedure TForm1.ZReadOnlyQuery1FilterRecord(DataSet: TDataSet;
|
||||
var Accept: Boolean);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,43 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<fpdoc-descriptions>
|
||||
<package name="rxnew">
|
||||
|
||||
<module name="duallist">
|
||||
<element name="TDualListDialog">
|
||||
<short>TDualListDialog Component</short>
|
||||
<descr>Unit
|
||||
DualList
|
||||
Description
|
||||
Компонента делает доступным вашему приложению диалог с двумя списками, где элементы можно перемещать из одного списка в другой, а также менять порядок следования элементов внутри списка.
|
||||
По сравнению с одноименной формой из Delphi Gallery, кроме оформления в виде компоненты, добавлены возможность Drag Drop, задания порядка внутри списка, интерфейсные улучшения.
|
||||
Задайте исходное состояние списков в свойствах List1 и List2, вызовите диалог функцией Execute и считайте новый состав списков.</descr>
|
||||
</element>
|
||||
<element name="TDualListDialog.Create"/>
|
||||
<element name="TDualListDialog.Destroy"/>
|
||||
<element name="TDualListDialog.Execute">
|
||||
<short>function Execute: Boolean;</short>
|
||||
<descr>Вызов диалога с двумя списками, где можно поменять элементы местами внутри списка или перенести элементы из одного списка в другой.</descr>
|
||||
</element>
|
||||
<element name="TDualListDialog.Ctl3D"/>
|
||||
<element name="TDualListDialog.Sorted"/>
|
||||
<element name="TDualListDialog.Title"/>
|
||||
<element name="TDualListDialog.Label1Caption"/>
|
||||
<element name="TDualListDialog.Label2Caption"/>
|
||||
<element name="TDualListDialog.OkBtnCaption"/>
|
||||
<element name="TDualListDialog.CancelBtnCaption"/>
|
||||
<element name="TDualListDialog.HelpBtnCaption"/>
|
||||
<element name="TDualListDialog.HelpContext"/>
|
||||
<element name="TDualListDialog.List1">
|
||||
<short>property List1: TStrings;</short>
|
||||
<descr>Список слева.</descr>
|
||||
</element>
|
||||
<element name="TDualListDialog.List2">
|
||||
<short>property List2: TStrings;</short>
|
||||
<descr>Список справа.</descr>
|
||||
</element>
|
||||
<element name="TDualListDialog.ShowHelp"/>
|
||||
</module>
|
||||
|
||||
|
||||
</package>
|
||||
</fpdoc-descriptions>
|
||||
@@ -0,0 +1,99 @@
|
||||
object rxShortCutForm: TrxShortCutForm
|
||||
Left = 505
|
||||
Height = 104
|
||||
Top = 526
|
||||
Width = 463
|
||||
Caption = 'ShortCut'
|
||||
ClientHeight = 104
|
||||
ClientWidth = 463
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.7'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 42
|
||||
Top = 56
|
||||
Width = 451
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.DefaultCaption = True
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 0
|
||||
ShowButtons = [pbOK, pbCancel, pbHelp]
|
||||
end
|
||||
object CheckBox1: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = ComboBox1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 10
|
||||
Width = 55
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Shift'
|
||||
TabOrder = 1
|
||||
end
|
||||
object CheckBox2: TCheckBox
|
||||
AnchorSideLeft.Control = CheckBox1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = ComboBox1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 67
|
||||
Height = 24
|
||||
Top = 10
|
||||
Width = 43
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Alt'
|
||||
TabOrder = 2
|
||||
end
|
||||
object CheckBox3: TCheckBox
|
||||
AnchorSideLeft.Control = CheckBox2
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = ComboBox1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 116
|
||||
Height = 24
|
||||
Top = 10
|
||||
Width = 49
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Ctrl'
|
||||
TabOrder = 3
|
||||
end
|
||||
object ComboBox1: TComboBox
|
||||
AnchorSideLeft.Control = CheckBox3
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Button1
|
||||
Left = 171
|
||||
Height = 32
|
||||
Top = 6
|
||||
Width = 211
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
ItemHeight = 0
|
||||
TabOrder = 4
|
||||
Text = 'ComboBox1'
|
||||
end
|
||||
object Button1: TButton
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 388
|
||||
Height = 32
|
||||
Top = 6
|
||||
Width = 69
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Grab key'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 5
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user