Стартовый пул

RXLib/rxcontrols/rxaboutdialog.pas

@@ -0,0 +1,148 @@
+{ RxAboutDialog
+
+  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 RxAboutDialog;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;
+
+type
+
+  TRxAboutDialogOption = (radHelpButton, radLicenseTab, radShowImageLogo);
+  TRxAboutDialogOptions = set of TRxAboutDialogOption;
+  { TRxAboutDialog }
+
+  TRxAboutDialog = class(TComponent)
+  private
+    FAdditionalInfo: TStrings;
+    FApplicationTitle: string;
+    FCaption: string;
+    FLicenseFileName: string;
+    FOptions: TRxAboutDialogOptions;
+    FPicture: TPicture;
+    procedure SetAdditionalInfo(const AValue: TStrings);
+    procedure SetPicture(const AValue: TPicture);
+    procedure SetRxAboutDialogOptions(const AValue: TRxAboutDialogOptions);
+  protected
+    { Protected declarations }
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Execute;
+  published
+    property Options:TRxAboutDialogOptions read FOptions write SetRxAboutDialogOptions;
+    property ApplicationTitle:string read FApplicationTitle write FApplicationTitle;
+    property LicenseFileName:string read FLicenseFileName write FLicenseFileName;
+    property Caption:string read FCaption write FCaption;
+    property Picture: TPicture read FPicture write SetPicture;
+    property AdditionalInfo:TStrings read FAdditionalInfo write SetAdditionalInfo;
+  end;
+
+
+implementation
+uses rxAboutFormUnit, ButtonPanel, rxconst;
+
+{ TRxAboutDialog }
+
+procedure TRxAboutDialog.SetRxAboutDialogOptions(
+  const AValue: TRxAboutDialogOptions);
+begin
+  if FOptions=AValue then exit;
+  FOptions:=AValue;
+end;
+
+procedure TRxAboutDialog.SetPicture(const AValue: TPicture);
+begin
+  if FPicture=AValue then exit;
+  FPicture.Assign(AValue);
+end;
+
+procedure TRxAboutDialog.SetAdditionalInfo(const AValue: TStrings);
+begin
+  FAdditionalInfo.Assign(AValue);
+end;
+
+constructor TRxAboutDialog.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FPicture := TPicture.Create;
+  FCaption:=sAbout;
+  FAdditionalInfo:= TStringList.Create;
+end;
+
+destructor TRxAboutDialog.Destroy;
+begin
+  FAdditionalInfo.Free;
+  FPicture.Graphic := nil;
+  FPicture.Free;
+  inherited Destroy;
+end;
+
+procedure TRxAboutDialog.Execute;
+var
+  rxAboutFormForm: TrxAboutFormForm;
+begin
+  rxAboutFormForm:=TrxAboutFormForm.Create(Application);
+  rxAboutFormForm.Caption:=FCaption;
+  if radLicenseTab in FOptions then
+    rxAboutFormForm.LoadLicense(FLicenseFileName)
+  else
+    rxAboutFormForm.TabSheet3.TabVisible:=false;
+
+  if radHelpButton in FOptions then
+    rxAboutFormForm.ButtonPanel1.ShowButtons:=rxAboutFormForm.ButtonPanel1.ShowButtons + [pbHelp]
+  else
+    rxAboutFormForm.ButtonPanel1.ShowButtons:=rxAboutFormForm.ButtonPanel1.ShowButtons - [pbHelp];
+
+  if FApplicationTitle <> '' then
+    rxAboutFormForm.lblAppTitle.Caption:=FApplicationTitle;
+
+  if radShowImageLogo in FOptions then
+  begin
+    rxAboutFormForm.Image1.Picture.Assign(Picture);
+  end
+  else
+  begin
+  end;
+
+  rxAboutFormForm.Memo2.Lines.Assign(FAdditionalInfo);
+
+  try
+    rxAboutFormForm.ShowModal;
+  finally
+    rxAboutFormForm.Free;
+  end;
+end;
+
+end.

RXLib/rxcontrols/rxaboutformunit.lfm

@@ -0,0 +1,225 @@
+object rxAboutFormForm: TrxAboutFormForm
+  Left = 546
+  Height = 386
+  Top = 349
+  Width = 498
+  Caption = 'rxAboutFormForm'
+  ClientHeight = 386
+  ClientWidth = 498
+  OnCreate = FormCreate
+  Position = poScreenCenter
+  LCLVersion = '1.9.0.0'
+  object PageControl1: TPageControl
+    Left = 0
+    Height = 328
+    Top = 0
+    Width = 498
+    ActivePage = TabSheet2
+    Align = alClient
+    TabIndex = 1
+    TabOrder = 0
+    object TabSheet1: TTabSheet
+      Caption = 'General'
+      ClientHeight = 294
+      ClientWidth = 488
+      object lblAppTitle: TLabel
+        AnchorSideLeft.Control = Image1
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = TabSheet1
+        AnchorSideRight.Control = TabSheet1
+        AnchorSideRight.Side = asrBottom
+        Left = 140
+        Height = 20
+        Top = 6
+        Width = 342
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Around = 6
+        Caption = 'App title'
+        ParentColor = False
+        WordWrap = True
+      end
+      object Image1: TImage
+        AnchorSideLeft.Control = TabSheet1
+        AnchorSideTop.Control = TabSheet1
+        Left = 6
+        Height = 128
+        Top = 6
+        Width = 128
+        AutoSize = True
+        BorderSpacing.Around = 6
+      end
+      object lblVersion: TLabel
+        AnchorSideLeft.Control = lblAppTitle
+        AnchorSideTop.Control = lblAppTitle
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = lblAppTitle
+        AnchorSideRight.Side = asrBottom
+        Left = 140
+        Height = 20
+        Top = 33
+        Width = 342
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 7
+        Caption = 'Version : '
+        ParentColor = False
+      end
+      object Memo2: TMemo
+        AnchorSideLeft.Control = Image1
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = lblVersion
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet1
+        AnchorSideRight.Side = asrBottom
+        AnchorSideBottom.Control = TabSheet1
+        AnchorSideBottom.Side = asrBottom
+        Left = 140
+        Height = 241
+        Top = 53
+        Width = 348
+        Anchors = [akTop, akLeft, akRight, akBottom]
+        BorderStyle = bsNone
+        ParentColor = True
+        ReadOnly = True
+        TabOrder = 0
+        WordWrap = False
+      end
+    end
+    object TabSheet2: TTabSheet
+      Caption = 'Detail'
+      ClientHeight = 294
+      ClientWidth = 488
+      object lblBuildDate: TLabel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 0
+        Height = 20
+        Top = 6
+        Width = 488
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        Caption = 'Build date :'
+        ParentColor = False
+      end
+      object lblLCLVersion: TLabel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = lblBuildDate
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 0
+        Height = 20
+        Top = 32
+        Width = 488
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        Caption = 'LCL Version :'
+        ParentColor = False
+      end
+      object lblFPCVersion: TLabel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = lblLCLVersion
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 0
+        Height = 20
+        Top = 58
+        Width = 488
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        Caption = 'FPC Version :'
+        ParentColor = False
+      end
+      object lblTargCPU: TLabel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = lblFPCVersion
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 0
+        Height = 20
+        Top = 84
+        Width = 488
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        Caption = 'Target CPU :'
+        ParentColor = False
+      end
+      object lblTargetOS: TLabel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = lblTargCPU
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 0
+        Height = 20
+        Top = 110
+        Width = 488
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        Caption = 'Target OS :'
+        ParentColor = False
+      end
+      object lblWidgetName: TLabel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = lblTargetOS
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 0
+        Height = 20
+        Top = 136
+        Width = 488
+        Alignment = taCenter
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        Caption = 'Widget Name'
+        ParentColor = False
+      end
+    end
+    object TabSheet3: TTabSheet
+      Caption = 'License'
+      ClientHeight = 294
+      ClientWidth = 488
+      object Memo1: TMemo
+        Left = 0
+        Height = 294
+        Top = 0
+        Width = 488
+        Align = alClient
+        Lines.Strings = (
+          'Memo1'
+        )
+        TabOrder = 0
+      end
+    end
+  end
+  object ButtonPanel1: TButtonPanel
+    Left = 6
+    Height = 46
+    Top = 334
+    Width = 486
+    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 = 1
+    ShowButtons = [pbClose, pbHelp]
+  end
+  object RxVersionInfo1: TRxVersionInfo
+    Left = 432
+    Top = 88
+  end
+end

RXLib/rxcontrols/rxaboutformunit.pas

@@ -0,0 +1,107 @@
+{ RxAboutForm
+
+  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 rxAboutFormUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  ComCtrls, StdCtrls, ExtCtrls, ButtonPanel, RxVersInfo;
+
+type
+
+  { TrxAboutFormForm }
+
+  TrxAboutFormForm = class(TForm)
+    ButtonPanel1: TButtonPanel;
+    Image1: TImage;
+    lblAppTitle: TLabel;
+    lblBuildDate: TLabel;
+    lblFPCVersion: TLabel;
+    lblLCLVersion: TLabel;
+    lblTargCPU: TLabel;
+    lblTargetOS: TLabel;
+    lblVersion: TLabel;
+    lblWidgetName: TLabel;
+    Memo1: TMemo;
+    Memo2: TMemo;
+    PageControl1: TPageControl;
+    RxVersionInfo1: TRxVersionInfo;
+    TabSheet1: TTabSheet;
+    TabSheet2: TTabSheet;
+    TabSheet3: TTabSheet;
+    procedure FormCreate(Sender: TObject);
+  private
+    { private declarations }
+  public
+    procedure LoadLicense(AFileName:string);
+  end; 
+
+implementation
+uses rxconst, LazFileUtils, LazUTF8;
+
+{$R *.lfm}
+
+{ TrxAboutFormForm }
+
+procedure TrxAboutFormForm.FormCreate(Sender: TObject);
+begin
+  lblAppTitle.Caption:=RxVersionInfo1.ProductName;
+  if lblAppTitle.Caption = '' then
+    lblAppTitle.Caption:=Application.Title;
+
+  PageControl1.ActivePageIndex:=0;
+  Memo1.Text:='';
+  lblWidgetName.Caption:=RxVersionInfo1.WidgetName;
+  lblVersion.Caption:=sAppVersion + RxVersionInfo1.FileLongVersion;
+  lblLCLVersion.Caption:=sLCLVersion + LCLVersion;
+  lblFPCVersion.Caption:=sFpcVersion + {$I %FPCVERSION%};
+  lblTargCPU.Caption:=sTargetCPU + {$I %FPCTARGETCPU%};
+  lblTargetOS.Caption:=sTargetOS + {$I %FPCTARGETOS%};
+  lblBuildDate.Caption:=sBuildDate + {$I %DATE%};
+  TabSheet1.Caption:=sGeneral;
+  TabSheet2.Caption:=sDetails;
+  TabSheet3.Caption:=sLicense;
+  Memo2.Color:=TabSheet1.Color;
+end;
+
+
+procedure TrxAboutFormForm.LoadLicense(AFileName: string);
+begin
+  if FileExistsUTF8(AFileName) then
+    Memo1.Lines.LoadFromFile(UTF8ToSys(AFileName));
+end;
+
+end.
+

RXLib/rxcontrols/rxapputils.pas

@@ -0,0 +1,427 @@
+{ rxapputils 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 rxAppUtils;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, IniFiles;
+
+const
+  {$IFNDEF LINUX}
+  AllMask = '*.*';
+  {$ELSE}
+  AllMask = '*';
+  {$ENDIF}
+
+var
+  DefCompanyName: string = '';
+  RegUseAppTitle: Boolean = False;
+
+
+function GetDefaultSection(Component: TComponent): string;
+procedure GetDefaultIniData(Control: TControl; var IniFileName,
+  Section: string; UseRegistry: Boolean = false);
+function GetDefaultIniName: string;
+
+type
+  TOnGetDefaultIniName = function: string;
+  TRxLoggerEvent = procedure( ALogType:TEventType; const ALogMessage:string);
+
+const
+  OnGetDefaultIniName: TOnGetDefaultIniName = nil;
+  OnRxLoggerEvent:TRxLoggerEvent = nil;
+
+//Save to IniFile or TRegIniFile string value
+procedure IniWriteString(IniFile: TObject; const Section, Ident,
+  Value: string);
+function IniReadString(IniFile: TObject; const Section, Ident,
+  Value: string):string;
+
+//Save to IniFile or TRegIniFile integer value
+procedure IniWriteInteger(IniFile: TObject; const Section, Ident:string;
+  const Value: integer);
+function IniReadInteger(IniFile: TObject; const Section, Ident:string;
+  const Value: integer):integer;
+
+function GetDefaultIniRegKey: string;
+function RxGetAppConfigDir(Global : Boolean) : String;
+
+
+procedure InfoBox(const S:string); overload;
+procedure InfoBox(const S:string; Params:array of const); overload;
+
+procedure WarningBox(const S:string); overload;
+procedure WarningBox(const S:string; Params:array of const); overload;
+
+procedure ErrorBox(const S:string);
+procedure ErrorBox(const S:string; Params:array of const);
+
+procedure RxDefaultWriteLog( ALogType:TEventType; const ALogMessage:string);
+function RxDefaultLogFileName:string;
+procedure InitRxLogs;
+
+function RxGetKeyboardLayoutName:string;
+
+implementation
+uses
+  {$IFDEF WINDOWS}
+  Windows, windirs,
+  {$ENDIF}
+  {$IFDEF LINUX}
+  X, XKB, xkblib, xlib,
+  {$ENDIF}
+  Registry, Forms, FileUtil, LazUTF8, LazFileUtils, Dialogs;
+
+function RxGetAppConfigDir(Global: Boolean): String;
+{$IFDEF WINDOWS}
+begin
+  If Global then
+    Result:=GetWindowsSpecialDir(CSIDL_COMMON_APPDATA)
+  else
+    Result:=GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA);
+  If (Result<>'') then
+    begin
+      if VendorName<>'' then
+        Result:=IncludeTrailingPathDelimiter(Result+ UTF8ToSys(VendorName));
+      Result:=IncludeTrailingPathDelimiter(Result+UTF8ToSys(ApplicationName));
+    end
+  else
+    Result:=ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))); //IncludeTrailingPathDelimiter(DGetAppConfigDir(Global));
+end;
+{$ELSE}
+begin
+  Result:=GetAppConfigDir(Global);
+end;
+{$ENDIF}
+
+procedure DoWriteLog(ALogType:TEventType; const ALogMessage:string);
+begin
+  if Assigned(OnRxLoggerEvent) then
+    OnRxLoggerEvent(ALogType, ALogMessage)
+end;
+
+procedure InfoBox(const S: string);
+begin
+  MessageDlg(S, mtInformation, [mbOK], 0);
+  DoWriteLog(etInfo, S);
+  Application.Log(etInfo, S);
+end;
+
+procedure InfoBox(const S: string; Params: array of const);
+begin
+  InfoBox(Format(S, Params));
+end;
+
+procedure WarningBox(const S: string);
+begin
+  MessageDlg(S, mtWarning, [mbOK], 0);
+  DoWriteLog(etWarning, S);
+  Application.Log(etWarning, S);
+end;
+
+procedure WarningBox(const S: string; Params: array of const);
+begin
+  WarningBox(Format(S, Params));
+end;
+
+procedure ErrorBox(const S: string);
+begin
+  MessageDlg(S, mtError, [mbOK], 0);
+  DoWriteLog(etError, S);
+  Application.Log(etError, S);
+end;
+
+procedure ErrorBox(const S: string; Params: array of const);
+begin
+  ErrorBox(Format(S, Params));
+end;
+
+procedure RxDefaultWriteLog(ALogType: TEventType; const ALogMessage: string);
+var
+  F: Text;
+  S: String;
+const
+  sEventNames : array [TEventType] of string =
+    ('CUSTOM','INFO','WARNING','ERROR','DEBUG');
+begin
+  S:=RxDefaultLogFileName;
+  if S<>'' then
+  begin
+    Assign(F, S);
+    if FileExists(S) then
+      Append(F)
+    else
+      Rewrite(F);
+
+    Writeln(F,Format( '|%s| %20s |%s', [sEventNames[ALogType], DateTimeToStr(Now), ALogMessage]));
+    CloseFile(F);
+  end;
+end;
+
+function RxDefaultLogFileName: string;
+begin
+  Result:=AppendPathDelim(GetTempDir) + ExtractFileNameOnly(ParamStr(0)) + '.log';
+end;
+
+procedure InitRxLogs;
+begin
+  OnRxLoggerEvent:=@RxDefaultWriteLog;
+end;
+
+{$IFDEF LINUX}
+function getKeyboardLang(dpy:PDisplay; AGroup:Integer):string;
+var
+  baseEventCode, baseErrorCode, opcode:integer;
+  groupCount:integer;
+  major:integer;
+  minor:integer;
+  kbdDescPtr: PXkbDescPtr;
+  tmpGroupSource: TAtom;
+begin
+  major:=0;
+  minor:=0;
+  XkbQueryExtension(dpy, @opcode, @baseEventCode, @baseErrorCode, @major, @minor);
+
+  kbdDescPtr := XkbAllocKeyboard();
+
+  if not Assigned(kbdDescPtr) then
+  begin
+    Result:='Failed to get keyboard description.';
+    exit;
+  end;
+
+  kbdDescPtr^.dpy := dpy;
+  kbdDescPtr^.device_spec := XkbUseCoreKbd;
+
+  XkbGetControls(dpy, XkbAllControlsMask, kbdDescPtr);
+  XkbGetNames(dpy, XkbSymbolsNameMask, kbdDescPtr);
+  XkbGetNames(dpy, XkbGroupNamesMask, kbdDescPtr);
+
+  if (not Assigned(kbdDescPtr^.names)) then
+  begin
+    Result:='Failed to get keyboard description.';
+    exit;
+  end;
+
+  if AGroup in [0 .. XkbNumKbdGroups -1] then
+  begin
+    tmpGroupSource := kbdDescPtr^.names^.groups[AGroup];
+    Result:=XGetAtomName(dpy, tmpGroupSource);
+  end
+  else
+    Result:='';
+end;
+
+{$ENDIF}
+
+function RxGetKeyboardLayoutName: string;
+{$IFDEF WINDOWS}
+var
+  LayoutName:array [0..KL_NAMELENGTH + 1] of char;
+  LangName: array [0 .. 1024] of Char;
+{$ENDIF}
+{$IFDEF LINUX}
+var
+  Disp: PDisplay;
+  RtrnState: TXkbStateRec;
+{$ENDIF}
+begin
+  {$IFDEF WINDOWS}
+  GetKeyboardLayoutName(@LayoutName);
+  if GetLocaleInfo(StrToInt('$' + StrPas(LayoutName)), LOCALE_SABBREVLANGNAME, @LangName, SizeOf(LangName) - 1) <> 0  then
+    Result := StrPas(LangName);
+//  end;
+//  Result := AnsiUpperCase(Copy(Result, 1, 2));
+  {$ELSE}
+  {$IFDEF LINUX}
+  Disp := XOpenDisplay(nil);
+  if Assigned(Disp) then
+  begin
+    XkbGetState(Disp, XkbUseCoreKbd, @RtrnState);
+    Result:=getKeyboardLang(Disp, RtrnState.group);
+    XCloseDisplay(Disp);
+  end
+  else
+    Result:='';
+  {$ELSE}
+    //Other system - maybe in future?
+    Result:='';
+  {$ENDIF LINUX}
+  {$ENDIF WINDOWS}
+end;
+
+
+function GetDefaultSection(Component: TComponent): string;
+var
+  F: TCustomForm;
+  Owner: TComponent;
+begin
+  if Component <> nil then begin
+    if Component is TCustomForm then Result := Component.ClassName
+    else begin
+      Result := Component.Name;
+      if Component is TControl then begin
+        F := GetParentForm(TControl(Component));
+        if F <> nil then Result := F.ClassName + Result
+        else begin
+          if TControl(Component).Parent <> nil then
+            Result := TControl(Component).Parent.Name + Result;
+        end;
+      end
+      else begin
+        Owner := Component.Owner;
+        if Owner is TForm then
+          Result := Format('%s.%s', [Owner.ClassName, Result]);
+      end;
+    end;
+  end
+  else Result := '';
+end;
+
+function GetDefaultIniName: string;
+var
+  S:string;
+begin
+  if Assigned(OnGetDefaultIniName) then
+    Result:= OnGetDefaultIniName()
+  else
+  begin
+    Result := ExtractFileName(ChangeFileExt(Application.ExeName, '.ini'));
+    S:=RxGetAppConfigDir(false);
+    S:=SysToUTF8(S);
+    ForceDirectoriesUTF8(S);
+    Result:=S+Result;
+  end;
+end;
+
+procedure GetDefaultIniData(Control: TControl; var IniFileName,
+  Section: string; UseRegistry: Boolean );
+var
+  I: Integer;
+begin
+  IniFileName := EmptyStr;
+{  with Control do
+    if Owner is TCustomForm then
+      for I := 0 to Owner.ComponentCount - 1 do
+        if (Owner.Components[I] is TFormPropertyStorage) then
+        begin
+          IniFileName := TFormPropertyStorage(Owner.Components[I]).IniFileName;
+          Break;
+        end;}
+  Section := GetDefaultSection(Control);
+  if IniFileName = EmptyStr then
+    if UseRegistry then IniFileName := GetDefaultIniRegKey
+    else
+      IniFileName := GetDefaultIniName;
+end;
+
+procedure IniWriteString(IniFile: TObject; const Section, Ident,
+  Value: string);
+var
+  S: string;
+begin
+  if IniFile is TRegIniFile then
+    TRegIniFile(IniFile).WriteString(Section, Ident, Value)
+  else
+  begin
+    S := Value;
+    if S <> '' then
+    begin
+      if ((S[1] = '"') and (S[Length(S)] = '"')) or
+        ((S[1] = '''') and (S[Length(S)] = '''')) then
+        S := '"' + S + '"';
+    end;
+    if IniFile is TIniFile then
+      TIniFile(IniFile).WriteString(Section, Ident, S);
+  end;
+end;
+
+function IniReadString(IniFile: TObject; const Section, Ident, Value: string
+  ): string;
+var
+  S: string;
+begin
+  if IniFile is TRegIniFile then
+    Result:=TRegIniFile(IniFile).ReadString(Section, Ident, Value)
+  else
+  begin
+    S := Value;
+    if S <> '' then begin
+      if ((S[1] = '"') and (S[Length(S)] = '"')) or
+        ((S[1] = '''') and (S[Length(S)] = '''')) then
+        S := '"' + S + '"';
+    end;
+    if IniFile is TIniFile then
+      Result:=TIniFile(IniFile).ReadString(Section, Ident, S);
+  end;
+end;
+
+procedure IniWriteInteger(IniFile: TObject; const Section, Ident: string;
+  const Value: integer);
+begin
+  if IniFile is TRegIniFile then
+    TRegIniFile(IniFile).WriteInteger(Section, Ident, Value)
+  else
+  begin
+    if IniFile is TIniFile then
+      TIniFile(IniFile).WriteInteger(Section, Ident, Value);
+  end;
+end;
+
+function IniReadInteger(IniFile: TObject; const Section, Ident: string;
+  const Value: integer): integer;
+begin
+  if IniFile is TRegIniFile then
+    Result:=TRegIniFile(IniFile).ReadInteger(Section, Ident, Value)
+  else
+  begin
+    if IniFile is TIniFile then
+      Result:=TIniFile(IniFile).ReadInteger(Section, Ident, Value);
+  end;
+end;
+
+function GetDefaultIniRegKey: string;
+begin
+  if RegUseAppTitle and (Application.Title <> '') then
+    Result := Application.Title
+  else Result := ExtractFileName(ChangeFileExt(Application.ExeName, ''));
+  if DefCompanyName <> '' then
+    Result := DefCompanyName + '\' + Result;
+  Result := 'Software\' + Result;
+end;
+
+
+end.
+

RXLib/rxcontrols/rxautopanel.pas

@@ -0,0 +1,216 @@
+{  AutoPanel 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 RxAutoPanel;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, Classes, LCLType, ExtCtrls;
+type
+
+  TPlacement = packed record
+    Left, Top, Width, Height: Integer;
+  end;
+  
+  PIntArray = ^TRectArray;
+  TRectArray = array[0..4096] of TPlacement;
+
+  TAutoPanel = class(TPanel)
+  private
+    { Private declarations }
+  protected
+    { Protected declarations }
+    pWidth :Integer;
+    pHeight:Integer;
+    FAutoChildPosLeft : Boolean;
+    FAutoChildPosTop : Boolean;
+    FAutoChildWidth : Boolean;
+    FAutoChildHeight : Boolean;
+    PCtrlsCoordArr:PIntArray;
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Loaded; override;
+    procedure Resize; override;
+  published
+    { Published declarations }
+    property AutoChildPosLeft : Boolean read FAutoChildPosLeft write FAutoChildPosLeft default False;
+    property AutoChildPosTop : Boolean read FAutoChildPosTop write FAutoChildPosTop default False;
+    property AutoChildWidth : Boolean  read FAutoChildWidth write FAutoChildWidth default False;
+    property AutoChildHeight : Boolean read FAutoChildHeight write FAutoChildHeight default False;
+
+    property Align;
+    property Alignment;
+    property BevelInner;
+    property BevelOuter;
+    property BevelWidth;
+    property BorderWidth;
+    property BorderStyle;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Caption;
+    property Color;
+    property Font;
+    //property Locked;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnResize;
+    property OnStartDrag;
+
+    property Anchors;
+    property AutoSize;
+    //property BiDiMode;
+    property Constraints;
+    property UseDockManager default True;
+    property DockSite;
+    property DragKind;
+    property FullRepaint;
+    //property ParentBiDiMode;
+
+    //property OnCanResize;
+    property OnConstrainedResize;
+    property OnDockDrop;
+    property OnDockOver;
+    property OnEndDock;
+    property OnGetSiteInfo;
+    property OnStartDock;
+    property OnUnDock;
+  end;
+
+//procedure Register;
+
+implementation
+
+//--------------------------------------
+constructor TAutoPanel.Create(AOwner: TComponent);
+begin
+ inherited;
+ FAutoChildPosLeft := False;
+ FAutoChildPosTop := False;
+ FAutoChildWidth := False;
+ FAutoChildHeight := False;
+ pWidth := -1;
+ pHeight := -1;
+ PCtrlsCoordArr := nil;
+end;
+
+
+destructor TAutoPanel.Destroy;
+begin
+ inherited;
+ FreeMem(PCtrlsCoordArr);
+end;
+
+procedure TAutoPanel.Loaded;
+var i:Integer;
+begin
+  inherited Loaded;
+  if (csDesigning in ComponentState) then Exit;
+
+  if (pWidth = -1) and (pHeight = -1) then begin
+   GetMem(PCtrlsCoordArr, ControlCount * sizeof(TRect));
+   for  i := 0 to ControlCount - 1 do begin
+      PCtrlsCoordArr^[i].Left := Controls[i].Left;
+      PCtrlsCoordArr^[i].Top := Controls[i].Top;
+      PCtrlsCoordArr^[i].Width := Controls[i].Width;
+      PCtrlsCoordArr^[i].Height := Controls[i].Height;
+   end;
+   pWidth := Width;
+   pHeight := Height;
+  end;
+end;
+
+procedure TAutoPanel.Resize;
+var I:Integer;
+begin
+  inherited;
+  if (csDesigning in ComponentState) then Exit;
+  if not (AutoChildPosLeft or AutoChildWidth or AutoChildPosTop or AutoChildHeight) then Exit;
+  try
+    for  i := 0 to ControlCount - 1 do
+    begin
+      if(AutoChildPosLeft = true) then
+        if (AutoChildWidth = true) then
+        begin
+          Controls[i].Left := MulDiv (PCtrlsCoordArr^[i].Left,Width,pWidth);
+          Controls[i].Width :=  MulDiv (PCtrlsCoordArr^[i].Width,Width,pWidth);
+        end
+        else
+          Controls[i].Left := Round(
+             PCtrlsCoordArr^[i].Left * Width / pWidth  +
+             ((PCtrlsCoordArr^[i].Width) * Width / pWidth -
+             (PCtrlsCoordArr^[i].Width))/2
+            );
+
+      if(AutoChildPosTop = true) then
+        if (AutoChildHeight = true) then
+        begin
+          Controls[i].Top := MulDiv (PCtrlsCoordArr^[i].Top,Height,pHeight);
+          Controls[i].Height := MulDiv (PCtrlsCoordArr^[i].Height,Height,pHeight);
+        end
+        else
+          Controls[i].Top := Round(
+             PCtrlsCoordArr^[i].Top * Height / pHeight +
+             ((PCtrlsCoordArr^[i].Height)  * Height / pHeight -
+             (PCtrlsCoordArr^[i].Height))/2
+            );
+    end;
+  finally
+  end;
+end;
+//--------------------------------------
+
+end.

RXLib/rxcontrols/rxboxprocs.pas

@@ -0,0 +1,339 @@
+{ boxprocs 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 rxboxprocs;
+
+{$I rx.inc}
+
+interface
+
+uses Classes, Controls, StdCtrls;
+const
+  LB_ERR = -1;
+  
+procedure BoxMoveSelectedItems(SrcList, DstList: TWinControl);
+procedure BoxMoveAllItems(SrcList, DstList: TWinControl);
+procedure BoxDragOver(List: TWinControl; Source: TObject;
+  X, Y: Integer; State: TDragState; var Accept: Boolean; Sorted: Boolean);
+procedure BoxMoveFocusedItem(List: TWinControl; DstIndex: Integer);
+
+procedure BoxMoveSelected(List: TWinControl; Items: TStrings);
+procedure BoxSetItem(List: TWinControl; Index: Integer);
+function BoxGetFirstSelection(List: TWinControl): Integer;
+function BoxCanDropItem(List: TWinControl; X, Y: Integer;
+  var DragIndex: Integer): Boolean;
+
+implementation
+
+uses LCLIntf, Graphics;
+
+function BoxItems(List: TWinControl): TStrings;
+begin
+  if List is TCustomListBox then
+    Result := TCustomListBox(List).Items
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).Items}
+  else Result := nil;
+end;
+
+function BoxGetSelected(List: TWinControl; Index: Integer): Boolean;
+begin
+  if List is TCustomListBox then
+  begin
+    if TCustomListBox(List).MultiSelect then
+      Result := TCustomListBox(List).Selected[Index]
+    else
+      Result := TCustomListBox(List).ItemIndex = Index
+  end
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).Selected[Index]}
+  else Result := False;
+end;
+
+procedure BoxSetSelected(List: TWinControl; Index: Integer; Value: Boolean);
+begin
+  if List is TCustomListBox then
+    TCustomListBox(List).Selected[Index] := Value
+{  else if List is TRxCustomListBox then
+    TRxCustomListBox(List).Selected[Index] := Value;}
+end;
+
+function BoxGetItemIndex(List: TWinControl): Integer;
+begin
+  if List is TCustomListBox then
+    Result := TCustomListBox(List).ItemIndex
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).ItemIndex}
+  else Result := -1;
+end;
+
+{.$IFNDEF WIN32}
+function BoxGetCanvas(List: TWinControl): TCanvas;
+begin
+  if List is TCustomListBox then
+    Result := TCustomListBox(List).Canvas
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).Canvas }
+  else Result := nil;
+end;
+{.$ENDIF}
+
+procedure BoxSetItemIndex(List: TWinControl; Index: Integer);
+begin
+  if List is TCustomListBox then
+    TCustomListBox(List).ItemIndex := Index
+{  else if List is TRxCustomListBox then
+    TRxCustomListBox(List).ItemIndex := Index;}
+end;
+
+function BoxMultiSelect(List: TWinControl): Boolean;
+begin
+  if List is TCustomListBox then
+    Result := TListBox(List).MultiSelect
+{  else if List is TRxCustomListBox then
+    Result := TRxCheckListBox(List).MultiSelect}
+  else Result := False;
+end;
+
+function BoxSelCount(List: TWinControl): Integer;
+begin
+  if List is TCustomListBox then
+    Result := TCustomListBox(List).SelCount
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).SelCount}
+  else Result := 0;
+end;
+
+function BoxItemAtPos(List: TWinControl; Pos: TPoint;
+  Existing: Boolean): Integer;
+begin
+  if List is TCustomListBox then
+    Result := TCustomListBox(List).ItemAtPos(Pos, Existing)
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).ItemAtPos(Pos, Existing)}
+  else Result := LB_ERR;
+end;
+
+function BoxItemRect(List: TWinControl; Index: Integer): TRect;
+begin
+  if List is TCustomListBox then
+    Result := TCustomListBox(List).ItemRect(Index)
+{  else if List is TRxCustomListBox then
+    Result := TRxCustomListBox(List).ItemRect(Index)}
+  else FillChar(Result, SizeOf(Result), 0);
+end;
+
+procedure BoxMoveSelected(List: TWinControl; Items: TStrings);
+var
+  I: Integer;
+begin
+  if BoxItems(List) = nil then Exit;
+  I := 0;
+  while I < BoxItems(List).Count do begin
+    if BoxGetSelected(List, I) then begin
+      Items.AddObject(BoxItems(List).Strings[I], BoxItems(List).Objects[I]);
+      BoxItems(List).Delete(I);
+    end
+    else Inc(I);
+  end;
+end;
+
+function BoxGetFirstSelection(List: TWinControl): Integer;
+var
+  I: Integer;
+begin
+  Result := LB_ERR;
+  if BoxItems(List) = nil then Exit;
+  for I := 0 to BoxItems(List).Count - 1 do begin
+    if BoxGetSelected(List, I) then begin
+      Result := I;
+      Exit;
+    end;
+  end;
+  Result := LB_ERR;
+end;
+
+procedure BoxSetItem(List: TWinControl; Index: Integer);
+var
+  MaxIndex: Integer;
+begin
+  if BoxItems(List) = nil then Exit;
+  with List do begin
+    if CanFocus then SetFocus;
+    MaxIndex := BoxItems(List).Count - 1;
+    if Index = LB_ERR then Index := 0
+    else if Index > MaxIndex then Index := MaxIndex;
+    if Index >= 0 then begin
+      if BoxMultiSelect(List) then BoxSetSelected(List, Index, True)
+      else BoxSetItemIndex(List, Index);
+    end;
+  end;
+end;
+
+procedure BoxMoveSelectedItems(SrcList, DstList: TWinControl);
+var
+  Index, I, NewIndex: Integer;
+begin
+  Index := BoxGetFirstSelection(SrcList);
+  if Index <> LB_ERR then
+  begin
+    BoxItems(SrcList).BeginUpdate;
+    BoxItems(DstList).BeginUpdate;
+    try
+      I := 0;
+      while I < BoxItems(SrcList).Count do
+      begin
+        if BoxGetSelected(SrcList, I) then
+        begin
+          NewIndex := BoxItems(DstList).AddObject(BoxItems(SrcList).Strings[I],
+            BoxItems(SrcList).Objects[I]);
+{          if (SrcList is TRxCheckListBox) and (DstList is TRxCheckListBox) then
+          begin
+            TRxCheckListBox(DstList).State[NewIndex] :=
+              TRxCheckListBox(SrcList).State[I];
+          end;}
+          BoxItems(SrcList).Delete(I);
+        end
+        else Inc(I);
+      end;
+      BoxSetItem(SrcList, Index);
+    finally
+      BoxItems(SrcList).EndUpdate;
+      BoxItems(DstList).EndUpdate;
+    end;
+  end;
+end;
+
+procedure BoxMoveAllItems(SrcList, DstList: TWinControl);
+var
+  I, NewIndex: Integer;
+begin
+  for I := 0 to BoxItems(SrcList).Count - 1 do begin
+    NewIndex := BoxItems(DstList).AddObject(BoxItems(SrcList)[I],
+      BoxItems(SrcList).Objects[I]);
+{    if (SrcList is TRxCheckListBox) and (DstList is TRxCheckListBox) then
+    begin
+      TRxCheckListBox(DstList).State[NewIndex] :=
+        TRxCheckListBox(SrcList).State[I];
+    end;}
+  end;
+  BoxItems(SrcList).Clear;
+  BoxSetItem(SrcList, 0);
+end;
+
+function BoxCanDropItem(List: TWinControl; X, Y: Integer;
+  var DragIndex: Integer): Boolean;
+var
+  Focused: Integer;
+begin
+  Result := False;
+  if (BoxSelCount(List) = 1) or (not BoxMultiSelect(List)) then
+  begin
+    Focused := BoxGetItemIndex(List);
+    if Focused <> LB_ERR then
+    begin
+      DragIndex := BoxItemAtPos(List, Point(X, Y), True);
+      if (DragIndex >= 0) and (DragIndex <> Focused) then
+      begin
+        Result := True;
+      end;
+    end;
+  end;
+end;
+
+procedure BoxDragOver(List: TWinControl; Source: TObject;
+  X, Y: Integer; State: TDragState; var Accept: Boolean; Sorted: Boolean);
+var
+  DragIndex: Integer;
+  R: TRect;
+
+procedure DrawItemFocusRect(Idx: Integer);
+(*
+{$IFDEF WIN32}
+  var
+    P: TPoint;
+    DC: HDC;
+{$ENDIF}
+  begin
+    R := BoxItemRect(List, Idx);
+{$IFDEF WIN32}
+    P := List.ClientToScreen(R.TopLeft);
+    R := Bounds(P.X, P.Y, R.Right - R.Left, R.Bottom - R.Top);
+    DC := GetDC(0);
+    DrawFocusRect(DC, R);
+    ReleaseDC(0, DC);
+{$ELSE}
+    BoxGetCanvas(List).DrawFocusRect(R);
+{$ENDIF}
+*)
+begin
+   BoxGetCanvas(List).DrawFocusRect(R);
+end;
+
+begin
+  if Source <> List then
+    Accept := (Source is TWinControl) { or (Source is TRxCustomListBox) }
+  else
+  begin
+    if Sorted then
+      Accept := False
+    else
+    begin
+      Accept := BoxCanDropItem(List, X, Y, DragIndex);
+      if ((List.Tag - 1) = DragIndex) and (DragIndex >= 0) then
+      begin
+        if State = dsDragLeave then
+        begin
+          DrawItemFocusRect(List.Tag - 1);
+          List.Tag := 0;
+        end;
+      end
+      else
+      begin
+        if List.Tag > 0 then DrawItemFocusRect(List.Tag - 1);
+        if DragIndex >= 0 then DrawItemFocusRect(DragIndex);
+        List.Tag := DragIndex + 1;
+      end;
+    end;
+  end;
+end;
+
+procedure BoxMoveFocusedItem(List: TWinControl; DstIndex: Integer);
+begin
+  if (DstIndex >= 0) and (DstIndex < BoxItems(List).Count) then
+    if (DstIndex <> BoxGetItemIndex(List)) then
+    begin
+      BoxItems(List).Move(BoxGetItemIndex(List), DstIndex);
+      BoxSetItem(List, DstIndex);
+    end;
+end;
+
+end.

RXLib/rxcontrols/rxclock.pas

@@ -0,0 +1,993 @@
+{ rxclock 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 rxclock;
+
+interface
+
+{$I rx.inc}
+uses LCLType, LMessages, SysUtils, Classes, Graphics, Controls, Forms,
+  ExtCtrls, Menus, messages;
+
+type
+  TShowClock = (scDigital, scAnalog);
+  TPaintMode = (pmPaintAll, pmHandPaint);
+
+  TRxClockTime = packed record
+    Hour, Minute, Second: Word;
+  end;
+
+  TRxGetTimeEvent = procedure (Sender: TObject; var ATime: TDateTime) of object;
+
+{ TRxClock }
+
+  TRxClock = class(TCustomPanel)
+  private
+    { Private declarations }
+    FTimer: TTimer;
+    FAutoSize: Boolean;
+    FShowMode: TShowClock;
+    FTwelveHour: Boolean;
+    FLeadingZero: Boolean;
+    FShowSeconds: Boolean;
+    FAlarm: TDateTime;
+    FAlarmEnabled: Boolean;
+    FHooked: Boolean;
+    FDotsColor: TColor;
+    FAlarmWait: Boolean;
+    FDisplayTime: TRxClockTime;
+    FClockRect: TRect;
+    FClockRadius: Longint;
+    FClockCenter: TPoint;
+    FOnGetTime: TRxGetTimeEvent;
+    FOnAlarm: TNotifyEvent;
+    procedure TimerExpired(Sender: TObject);
+    procedure GetTime(var T: TRxClockTime);
+    function IsAlarmTime(ATime: TDateTime): Boolean;
+    procedure SetShowMode(Value: TShowClock);
+    function GetAlarmElement(Index: Integer): Byte;
+    procedure SetAlarmElement(Index: Integer; Value: Byte);
+    procedure SetDotsColor(Value: TColor);
+    procedure SetTwelveHour(Value: Boolean);
+    procedure SetLeadingZero(Value: Boolean);
+    procedure SetShowSeconds(Value: Boolean);
+    procedure PaintAnalogClock(PaintMode: TPaintMode);
+    procedure Paint3DFrame(var Rect: TRect);
+    procedure DrawAnalogFace;
+    procedure CircleClock(MaxWidth, MaxHeight: Integer);
+    procedure DrawSecondHand(Pos: Integer);
+    procedure DrawFatHand(Pos: Integer; HourHand: Boolean);
+    procedure PaintTimeStr(var Rect: TRect; FullTime: Boolean);
+    procedure ResizeFont(const Rect: TRect);
+    procedure ResetAlarm;
+    procedure CheckAlarm;
+    function FormatSettingsChange(var Message: TLMessage): Boolean;
+//    procedure CMCtl3DChanged(var Message: TLMessage); message CM_CTL3DCHANGED;
+    procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
+    procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
+    {$IFDEF windows}
+    procedure WMTimeChange(var Message: TLMessage); message WM_TIMECHANGE;
+    {$ENDIF}
+  protected
+    { Protected declarations }
+    procedure SetAutoSize(const Value: Boolean); virtual;
+    procedure Alarm; dynamic;
+    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
+    procedure CreateWnd; override;
+//    procedure DestroyWindowHandle; override;
+    procedure Loaded; override;
+    procedure Paint; override;
+    function GetSystemTime: TDateTime; virtual;
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure SetAlarmTime(AlarmTime: TDateTime);
+    procedure UpdateClock;
+  published
+    { Published declarations }
+    property AlarmEnabled: Boolean read FAlarmEnabled write FAlarmEnabled default False;
+    property AlarmHour: Byte Index 1 read GetAlarmElement write SetAlarmElement default 0;
+    property AlarmMinute: Byte Index 2 read GetAlarmElement write SetAlarmElement default 0;
+    property AlarmSecond: Byte Index 3 read GetAlarmElement write SetAlarmElement default 0;
+    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
+    property BevelInner default bvLowered;
+    property BevelOuter default bvRaised;
+    property DotsColor: TColor read FDotsColor write SetDotsColor default clTeal;
+    property ShowMode: TShowClock read FShowMode write SetShowMode default scDigital;
+    property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default True;
+    property TwelveHour: Boolean read FTwelveHour write SetTwelveHour default False;
+    property LeadingZero: Boolean read FLeadingZero write SetLeadingZero default True;
+    property Align;
+    property BevelWidth;
+    property BorderWidth;
+    property BorderStyle;
+{$IFDEF RX_D4}
+    property Anchors;
+    property Constraints;
+    property UseDockManager default True;
+    property DockSite;
+    property DragKind;
+    property FullRepaint;
+{$ENDIF}
+    property Color;
+    property Cursor;
+    property DragMode;
+    property DragCursor;
+    property Enabled;
+    property Font;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property Visible;
+    property OnAlarm: TNotifyEvent read FOnAlarm write FOnAlarm;
+    property OnGetTime: TRxGetTimeEvent read FOnGetTime write FOnGetTime;
+    property OnClick;
+    property OnDblClick;
+    property OnMouseMove;
+    property OnMouseDown;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnDragOver;
+    property OnDragDrop;
+    property OnEndDrag;
+    property OnResize;
+    property OnContextPopup;
+    property OnStartDrag;
+//    property OnCanResize;
+    property OnConstrainedResize;
+    property OnDockDrop;
+    property OnDockOver;
+    property OnEndDock;
+//    property OnGetSiteInfo;
+//    property OnStartDock;
+//    property OnUnDock;
+  end;
+
+implementation
+
+uses rxlclutils, RTLConsts, LCLIntf;
+
+const
+  Registered: Boolean = False;
+
+type
+  PPointArray = ^TPointArray;
+  TPointArray = array [0..60 * 2 - 1] of TSmallPoint;
+
+const
+  ClockData: array[0..60 * 4 - 1] of Byte = (
+    $00, $00, $C1, $E0, $44, $03, $EC, $E0, $7F, $06, $6F, $E1,
+    $A8, $09, $48, $E2, $B5, $0C, $74, $E3, $9F, $0F, $F0, $E4,
+    $5E, $12, $B8, $E6, $E9, $14, $C7, $E8, $39, $17, $17, $EB,
+    $48, $19, $A2, $ED, $10, $1B, $60, $F0, $8C, $1C, $4B, $F3,
+    $B8, $1D, $58, $F6, $91, $1E, $81, $F9, $14, $1F, $BC, $FC,
+    $40, $1F, $00, $00, $14, $1F, $44, $03, $91, $1E, $7F, $06,
+    $B8, $1D, $A8, $09, $8C, $1C, $B5, $0C, $10, $1B, $A0, $0F,
+    $48, $19, $5E, $12, $39, $17, $E9, $14, $E9, $14, $39, $17,
+    $5E, $12, $48, $19, $9F, $0F, $10, $1B, $B5, $0C, $8C, $1C,
+    $A8, $09, $B8, $1D, $7F, $06, $91, $1E, $44, $03, $14, $1F,
+    $00, $00, $3F, $1F, $BC, $FC, $14, $1F, $81, $F9, $91, $1E,
+    $58, $F6, $B8, $1D, $4B, $F3, $8C, $1C, $60, $F0, $10, $1B,
+    $A2, $ED, $48, $19, $17, $EB, $39, $17, $C7, $E8, $E9, $14,
+    $B8, $E6, $5E, $12, $F0, $E4, $9F, $0F, $74, $E3, $B5, $0C,
+    $48, $E2, $A8, $09, $6F, $E1, $7F, $06, $EC, $E0, $44, $03,
+    $C1, $E0, $00, $00, $EC, $E0, $BC, $FC, $6F, $E1, $81, $F9,
+    $48, $E2, $58, $F6, $74, $E3, $4B, $F3, $F0, $E4, $60, $F0,
+    $B8, $E6, $A2, $ED, $C7, $E8, $17, $EB, $17, $EB, $C7, $E8,
+    $A2, $ED, $B8, $E6, $61, $F0, $F0, $E4, $4B, $F3, $74, $E3,
+    $58, $F6, $48, $E2, $81, $F9, $6F, $E1, $BC, $FC, $EC, $E0);
+
+const
+  AlarmSecDelay = 60; { seconds for try alarm event after alarm time occured }
+  MaxDotWidth   = 25; { maximum Hour-marking dot width  }
+  MinDotWidth   = 2;  { minimum Hour-marking dot width  }
+  MinDotHeight  = 1;  { minimum Hour-marking dot height }
+
+  { distance from the center of the clock to... }
+  HourSide   = 7;   { ...either side of the Hour hand   }
+  MinuteSide = 5;   { ...either side of the Minute hand }
+  HourTip    = 60;  { ...the tip of the Hour hand       }
+  MinuteTip  = 80;  { ...the tip of the Minute hand     }
+  SecondTip  = 80;  { ...the tip of the Second hand     }
+  HourTail   = 15;  { ...the tail of the Hour hand      }
+  MinuteTail = 20;  { ...the tail of the Minute hand    }
+
+  { conversion factors }
+  CirTabScale = 8000; { circle table values scale down value  }
+  MmPerDm     = 100;  { millimeters per decimeter             }
+
+  { number of hand positions on... }
+  HandPositions = 60;                    { ...entire clock         }
+  SideShift     = (HandPositions div 4); { ...90 degrees of clock  }
+  TailShift     = (HandPositions div 2); { ...180 degrees of clock }
+
+var
+  CircleTab: PPointArray;
+  HRes: Integer;    { width of the display (in pixels)                    }
+  VRes: Integer;    { height of the display (in raster lines)             }
+  AspectH: Longint; { number of pixels per decimeter on the display       }
+  AspectV: Longint; { number of raster lines per decimeter on the display }
+
+{ Exception routine }
+
+procedure InvalidTime(Hour, Min, Sec: Word);
+var
+  sTime: string[50];
+begin
+  sTime := IntToStr(Hour) + DefaultFormatSettings.TimeSeparator + IntToStr(Min) +
+    DefaultFormatSettings.TimeSeparator + IntToStr(Sec);
+  raise EConvertError.CreateFmt(SInvalidTime, [sTime]);
+end;
+
+function VertEquiv(l: Integer): Integer;
+begin
+  VertEquiv := Longint(l) * AspectV div AspectH;
+end;
+
+function HorzEquiv(l: Integer): Integer;
+begin
+  HorzEquiv := Longint(l) * AspectH div AspectV;
+end;
+
+function LightColor(Color: TColor): TColor;
+var
+  L: Longint;
+  C: array[1..3] of Byte;
+  I: Byte;
+begin
+  L := ColorToRGB(Color);
+  C[1] := GetRValue(L);
+  C[2] := GetGValue(L);
+  C[3] := GetBValue(L);
+  for I := 1 to 3 do
+  begin
+    if C[I] = $FF then
+    begin
+      Result := clBtnHighlight;
+      Exit;
+    end;
+    if C[I] <> 0 then
+      if C[I] = $C0 then C[I] := $FF
+      else C[I] := C[I] + $7F;
+  end;
+  Result := TColor(RGB(C[1], C[2], C[3]));
+end;
+
+procedure ClockInit;
+var
+  Pos: Integer;   { hand position Index into the circle table }
+  vSize: Integer; { height of the display in millimeters      }
+  hSize: Integer; { width of the display in millimeters       }
+  DC: HDC;
+begin
+  DC := GetDC(0);
+  try
+    VRes := GetDeviceCaps(DC, VERTRES);
+    HRes := GetDeviceCaps(DC, HORZRES);
+    vSize := GetDeviceCaps(DC, VERTSIZE);
+    hSize := GetDeviceCaps(DC, HORZSIZE);
+  finally
+    ReleaseDC(0, DC);
+  end;
+  AspectV := (Longint(VRes) * MmPerDm) div Longint(vSize);
+  AspectH := (Longint(HRes) * MmPerDm) div Longint(hSize);
+  CircleTab := PPointArray(@ClockData);
+  for Pos := 0 to HandPositions - 1 do
+    CircleTab^[Pos].Y := VertEquiv(CircleTab^[Pos].Y);
+end;
+
+function HourHandPos(T: TRxClockTime): Integer;
+begin
+  Result := (T.Hour * 5) + (T.Minute div 12);
+end;
+
+{ Digital clock font routine }
+
+procedure SetNewFontSize(Canvas: TCanvas; const Text: string;
+  MaxH, MaxW: Integer);
+const
+  fHeight = 1000;
+var
+  Font: TFont;
+  NewH: Integer;
+begin
+  Font := Canvas.Font;
+  { empiric calculate character height by cell height }
+  MaxH := MulDiv(MaxH, 4, 5);
+{  with Font do
+  begin}
+    Font.Height := -fHeight;
+    NewH := MulDiv(fHeight, MaxW, Canvas.TextWidth(Text));
+    if NewH > MaxH then NewH := MaxH;
+    Font.Height := -NewH;
+//  end;
+end;
+
+{ TRxClock }
+
+constructor TRxClock.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  if not Registered then begin
+    ClockInit;
+    Registered := True;
+  end;
+  Caption := TimeToStr(Time);
+  ControlStyle := ControlStyle - [csSetCaption] - [csReplicatable];
+  BevelInner := bvLowered;
+  BevelOuter := bvRaised;
+  FTimer := TTimer.Create(Self);
+  FTimer.Interval := 450; { every second }
+  FTimer.OnTimer := @TimerExpired;
+  FDotsColor := clTeal;
+  FShowSeconds := True;
+  FLeadingZero := True;
+  GetTime(FDisplayTime);
+  if FDisplayTime.Hour >= 12 then Dec(FDisplayTime.Hour, 12);
+  FAlarmWait := True;
+  FAlarm := EncodeTime(0, 0, 0, 0);
+end;
+
+destructor TRxClock.Destroy;
+begin
+  if FHooked then
+  begin
+//    Application.UnhookMainWindow(FormatSettingsChange);
+    FHooked := False;
+  end;
+  inherited Destroy;
+end;
+
+procedure TRxClock.Loaded;
+begin
+  inherited Loaded;
+  ResetAlarm;
+end;
+
+procedure TRxClock.CreateWnd;
+begin
+  inherited CreateWnd;
+  if not (csDesigning in ComponentState) and not (IsLibrary or FHooked) then
+  begin
+//    Application.HookMainWindow(FormatSettingsChange);
+    FHooked := True;
+  end;
+end;
+
+{procedure TRxClock.DestroyWindowHandle;
+begin
+  if FHooked then begin
+    Application.UnhookMainWindow(FormatSettingsChange);
+    FHooked := False;
+  end;
+  inherited DestroyWindowHandle;
+end;
+}
+{
+procedure TRxClock.CMCtl3DChanged(var Message: TMessage);
+begin
+  inherited;
+  if ShowMode = scAnalog then Invalidate;
+end;
+}
+procedure TRxClock.CMTextChanged(var Message: TMessage);
+begin
+  { Skip this message, no repaint }
+end;
+
+procedure TRxClock.CMFontChanged(var Message: TMessage);
+begin
+  inherited;
+  Invalidate;
+  if AutoSize then Realign;
+end;
+
+{$IFDEF windows}
+procedure TRxClock.WMTimeChange(var Message: TMessage);
+begin
+  inherited;
+  Invalidate;
+  CheckAlarm;
+end;
+{$ENDIF}
+
+function TRxClock.FormatSettingsChange(var Message: TMessage): Boolean;
+begin
+{$IFDEF windows}
+  Result := False;
+  case Message.Msg of
+    WM_WININICHANGE:
+      begin
+        Invalidate;
+        if AutoSize then Realign;
+      end;
+  end;
+{$ENDIF}
+end;
+
+function TRxClock.GetSystemTime: TDateTime;
+begin
+  Result := SysUtils.Time;
+  if Assigned(FOnGetTime) then FOnGetTime(Self, Result);
+end;
+
+procedure TRxClock.GetTime(var T: TRxClockTime);
+var
+  MSec: Word;
+begin
+  with T do
+    DecodeTime(GetSystemTime, Hour, Minute, Second, MSec);
+end;
+
+procedure TRxClock.UpdateClock;
+begin
+  Invalidate;
+  if AutoSize then Realign;
+  Update;
+end;
+
+procedure TRxClock.ResetAlarm;
+begin
+  FAlarmWait := (FAlarm > GetSystemTime) or (FAlarm = 0);
+end;
+
+function TRxClock.IsAlarmTime(ATime: TDateTime): Boolean;
+var
+  Hour, Min, Sec, MSec: Word;
+  AHour, AMin, ASec: Word;
+begin
+  DecodeTime(FAlarm, Hour, Min, Sec, MSec);
+  DecodeTime(ATime, AHour, AMin, ASec, MSec);
+  Result := {FAlarmWait and} (Hour = AHour) and (Min = AMin) and
+    (ASec >= Sec) and (ASec <= Sec + AlarmSecDelay);
+end;
+
+procedure TRxClock.ResizeFont(const Rect: TRect);
+var
+  H, W: Integer;
+  DC: HDC;
+  TimeStr: string;
+begin
+  H := Rect.Bottom - Rect.Top - 4;
+  W := (Rect.Right - Rect.Left - 30);
+  if (H <= 0) or (W <= 0) then Exit;
+  DC := GetDC(0);
+  try
+    Canvas.Handle := DC;
+    Canvas.Font := Font;
+    TimeStr := '88888';
+    if FShowSeconds then TimeStr := TimeStr + '888';
+    if FTwelveHour then begin
+      if Canvas.TextWidth(DefaultFormatSettings.TimeAMString) > Canvas.TextWidth(DefaultFormatSettings.TimePMString) then
+        TimeStr := TimeStr + ' ' + DefaultFormatSettings.TimeAMString
+      else TimeStr := TimeStr + ' ' + DefaultFormatSettings.TimePMString;
+    end;
+    SetNewFontSize(Canvas, TimeStr, H, W);
+    Font := Canvas.Font;
+  finally
+    Canvas.Handle := 0;
+    ReleaseDC(0, DC);
+  end;
+end;
+
+procedure TRxClock.AlignControls(AControl: TControl; var Rect: TRect);
+{$IFDEF RX_D4}
+var
+  InflateWidth: Integer;
+{$ENDIF}
+begin
+  inherited AlignControls(AControl, Rect);
+  FClockRect := Rect;
+{$IFDEF RX_D4}
+  InflateWidth := BorderWidth + 1;
+  if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
+  if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
+  InflateRect(FClockRect, -InflateWidth, -InflateWidth);
+{$ENDIF}
+  with FClockRect do CircleClock(Right - Left, Bottom - Top);
+  if AutoSize then ResizeFont(Rect);
+end;
+
+procedure TRxClock.Alarm;
+begin
+  if Assigned(FOnAlarm) then FOnAlarm(Self);
+end;
+
+procedure TRxClock.SetAutoSize(const Value: Boolean);
+begin
+  if (Value <> FAutoSize) then
+  begin
+    FAutoSize := Value;
+    if FAutoSize then
+    begin
+      Invalidate;
+      Realign;
+    end;
+  end;
+end;
+
+procedure TRxClock.SetTwelveHour(Value: Boolean);
+begin
+  if FTwelveHour <> Value then begin
+    FTwelveHour := Value;
+    Invalidate;
+    if AutoSize then Realign;
+  end;
+end;
+
+procedure TRxClock.SetLeadingZero(Value: Boolean);
+begin
+  if FLeadingZero <> Value then begin
+    FLeadingZero := Value;
+    Invalidate;
+  end;
+end;
+
+procedure TRxClock.SetShowSeconds(Value: Boolean);
+begin
+  if FShowSeconds <> Value then begin
+    {if FShowSeconds and (ShowMode = scAnalog) then
+      DrawSecondHand(FDisplayTime.Second);}
+    FShowSeconds := Value;
+    Invalidate;
+    if AutoSize then Realign;
+  end;
+end;
+
+procedure TRxClock.SetDotsColor(Value: TColor);
+begin
+  if Value <> FDotsColor then begin
+    FDotsColor := Value;
+    Invalidate;
+  end;
+end;
+
+procedure TRxClock.SetShowMode(Value: TShowClock);
+begin
+  if FShowMode <> Value then begin
+    FShowMode := Value;
+    Invalidate;
+  end;
+end;
+
+function TRxClock.GetAlarmElement(Index: Integer): Byte;
+var
+  Hour, Min, Sec, MSec: Word;
+begin
+  DecodeTime(FAlarm, Hour, Min, Sec, MSec);
+  case Index of
+    1: Result := Hour;
+    2: Result := Min;
+    3: Result := Sec;
+    else Result := 0;
+  end;
+end;
+
+procedure TRxClock.SetAlarmElement(Index: Integer; Value: Byte);
+var
+  Hour, Min, Sec, MSec: Word;
+begin
+  DecodeTime(FAlarm, Hour, Min, Sec, MSec);
+  case Index of
+    1: Hour := Value;
+    2: Min := Value;
+    3: Sec := Value;
+    else Exit;
+  end;
+  if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
+    FAlarm := EncodeTime(Hour, Min, Sec, 0);
+    ResetAlarm;
+  end
+  else InvalidTime(Hour, Min, Sec);
+end;
+
+procedure TRxClock.SetAlarmTime(AlarmTime: TDateTime);
+var
+  Hour, Min, Sec, MSec: Word;
+begin
+  DecodeTime(FAlarm, Hour, Min, Sec, MSec);
+  if (Hour < 24) and (Min < 60) and (Sec < 60) then begin
+    FAlarm := Frac(AlarmTime);
+    ResetAlarm;
+  end
+  else InvalidTime(Hour, Min, Sec);
+end;
+
+procedure TRxClock.TimerExpired(Sender: TObject);
+var
+  DC: HDC;
+  Rect: TRect;
+  InflateWidth: Integer;
+begin
+  DC := GetDC(Handle);
+  try
+    Canvas.Handle := DC;
+    Canvas.Brush.Color := Color;
+    Canvas.Font := Font;
+    Canvas.Pen.Color := Font.Color;
+    if FShowMode = scAnalog then PaintAnalogClock(pmHandPaint)
+    else begin
+      Rect := GetClientRect;
+      InflateWidth := BorderWidth;
+      if BevelOuter <> bvNone then Inc(InflateWidth, BevelWidth);
+      if BevelInner <> bvNone then Inc(InflateWidth, BevelWidth);
+      InflateRect(Rect, -InflateWidth, -InflateWidth);
+      PaintTimeStr(Rect, False);
+    end;
+  finally
+    Canvas.Handle := 0;
+    ReleaseDC(Handle, DC);
+  end;
+  CheckAlarm;
+end;
+
+procedure TRxClock.CheckAlarm;
+begin
+  if FAlarmEnabled and IsAlarmTime(GetSystemTime) then begin
+    if FAlarmWait then begin
+      FAlarmWait := False;
+      Alarm;
+    end;
+  end
+  else ResetAlarm;
+end;
+
+procedure TRxClock.DrawAnalogFace;
+var
+  Pos, DotHeight, DotWidth: Integer;
+  DotCenter: TPoint;
+  R: TRect;
+  SaveBrush, SavePen: TColor;
+  MinDots: Boolean;
+begin
+  DotWidth := (MaxDotWidth * Longint(FClockRect.Right - FClockRect.Left)) div HRes;
+  DotHeight := VertEquiv(DotWidth);
+  if DotHeight < MinDotHeight then DotHeight := MinDotHeight;
+  if DotWidth < MinDotWidth then DotWidth := MinDotWidth;
+  DotCenter.X := DotWidth div 2;
+  DotCenter.Y := DotHeight div 2;
+  InflateRect(FClockRect, -DotCenter.Y, -DotCenter.X);
+  FClockRadius := ((FClockRect.Right - FClockRect.Left) div 2);
+  FClockCenter.X := FClockRect.Left + FClockRadius;
+  FClockCenter.Y := FClockRect.Top + ((FClockRect.Bottom - FClockRect.Top) div 2);
+  InflateRect(FClockRect, DotCenter.Y, DotCenter.X);
+  SaveBrush := Canvas.Brush.Color;
+  SavePen := Canvas.Pen.Color;
+  try
+    Canvas.Brush.Color := Canvas.Pen.Color;
+    MinDots := ((DotWidth > MinDotWidth) and (DotHeight > MinDotHeight));
+    for Pos := 0 to HandPositions - 1 do
+    begin
+      R.Top := (CircleTab^[Pos].Y * FClockRadius) div CirTabScale + FClockCenter.Y;
+      R.Left := (CircleTab^[Pos].X * FClockRadius) div CirTabScale + FClockCenter.X;
+      if (Pos mod 5) <> 0 then
+      begin
+        if MinDots then
+        begin
+//          if Ctl3D then
+          begin
+            Canvas.Brush.Color := clBtnShadow;
+            OffsetRect(R, -1, -1);
+            R.Right := R.Left + 2;
+            R.Bottom := R.Top + 2;
+            Canvas.FillRect(R);
+            Canvas.Brush.Color := clBtnHighlight;
+            OffsetRect(R, 1, 1);
+            Canvas.FillRect(R);
+            Canvas.Brush.Color := Self.Color;
+          end;
+          R.Right := R.Left + 1;
+          R.Bottom := R.Top + 1;
+          Canvas.FillRect(R);
+        end;
+      end
+      else begin
+        R.Right := R.Left + DotWidth;
+        R.Bottom := R.Top + DotHeight;
+        OffsetRect(R, -DotCenter.X, -DotCenter.Y);
+        if {Ctl3D and} MinDots then
+          with Canvas do
+          begin
+            Brush.Color := FDotsColor;
+            Brush.Style := bsSolid;
+            FillRect(R);
+            RxFrame3D(Canvas, R, LightColor(FDotsColor), clWindowFrame, 1);
+          end;
+        Canvas.Brush.Color := Canvas.Pen.Color;
+        if not ({Ctl3D and} MinDots) then Canvas.FillRect(R);
+      end;
+    end;
+  finally
+    Canvas.Brush.Color := SaveBrush;
+    Canvas.Pen.Color := SavePen;
+  end;
+end;
+
+procedure TRxClock.CircleClock(MaxWidth, MaxHeight: Integer);
+var
+  ClockHeight: Integer;
+  ClockWidth: Integer;
+begin
+  if MaxWidth > HorzEquiv(MaxHeight) then begin
+    ClockWidth := HorzEquiv(MaxHeight);
+    FClockRect.Left := FClockRect.Left + ((MaxWidth - ClockWidth) div 2);
+    FClockRect.Right := FClockRect.Left + ClockWidth;
+  end
+  else begin
+    ClockHeight := VertEquiv(MaxWidth);
+    FClockRect.Top := FClockRect.Top + ((MaxHeight - ClockHeight) div 2);
+    FClockRect.Bottom := FClockRect.Top + ClockHeight;
+  end;
+end;
+
+procedure TRxClock.DrawSecondHand(Pos: Integer);
+var
+  Radius: Longint;
+  SaveMode: TPenMode;
+begin
+  Radius := (FClockRadius * SecondTip) div 100;
+  SaveMode := Canvas.Pen.Mode;
+  Canvas.Pen.Mode := pmNot;
+  try
+    Canvas.MoveTo(FClockCenter.X, FClockCenter.Y);
+    Canvas.LineTo(FClockCenter.X + ((CircleTab^[Pos].X * Radius) div
+      CirTabScale), FClockCenter.Y + ((CircleTab^[Pos].Y * Radius) div
+      CirTabScale));
+  finally
+    Canvas.Pen.Mode := SaveMode;
+  end;
+end;
+
+procedure TRxClock.DrawFatHand(Pos: Integer; HourHand: Boolean);
+var
+  ptSide, ptTail, ptTip: TPoint;
+  Index, Hand: Integer;
+  Scale: Longint;
+  SaveMode: TPenMode;
+begin
+  if HourHand then Hand := HourSide else Hand := MinuteSide;
+  Scale := (FClockRadius * Hand) div 100;
+  Index := (Pos + SideShift) mod HandPositions;
+  ptSide.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
+  ptSide.X := (CircleTab^[Index].X * Scale) div CirTabScale;
+  if HourHand then Hand := HourTip else Hand := MinuteTip;
+  Scale := (FClockRadius * Hand) div 100;
+  ptTip.Y := (CircleTab^[Pos].Y * Scale) div CirTabScale;
+  ptTip.X := (CircleTab^[Pos].X * Scale) div CirTabScale;
+  if HourHand then Hand := HourTail else Hand := MinuteTail;
+  Scale := (FClockRadius * Hand) div 100;
+  Index := (Pos + TailShift) mod HandPositions;
+  ptTail.Y := (CircleTab^[Index].Y * Scale) div CirTabScale;
+  ptTail.X := (CircleTab^[Index].X * Scale) div CirTabScale;
+  with Canvas do begin
+    SaveMode := Pen.Mode;
+    Pen.Mode := pmCopy;
+    try
+      MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
+      LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
+      MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
+      LineTo(FClockCenter.X + ptTip.X, FClockCenter.Y + ptTip.Y);
+      MoveTo(FClockCenter.X + ptSide.X, FClockCenter.Y + ptSide.Y);
+      LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
+      MoveTo(FClockCenter.X - ptSide.X, FClockCenter.Y - ptSide.Y);
+      LineTo(FClockCenter.X + ptTail.X, FClockCenter.Y + ptTail.Y);
+    finally
+      Pen.Mode := SaveMode;
+    end;
+  end;
+end;
+
+procedure TRxClock.PaintAnalogClock(PaintMode: TPaintMode);
+var
+  NewTime: TRxClockTime;
+begin
+  Canvas.Pen.Color := Font.Color;
+  Canvas.Brush.Color := Color;
+  SetBkMode(Canvas.Handle, TRANSPARENT);
+  if PaintMode = pmPaintAll then
+  begin
+    with Canvas do
+    begin
+      FillRect(FClockRect);
+      Pen.Color := Self.Font.Color;
+      DrawAnalogFace;
+      DrawFatHand(HourHandPos(FDisplayTime), True);
+      DrawFatHand(FDisplayTime.Minute, False);
+      Pen.Color := Brush.Color;
+      if ShowSeconds then
+        DrawSecondHand(FDisplayTime.Second);
+    end;
+  end
+  else
+  begin
+    with Canvas do
+    begin
+      Pen.Color := Brush.Color;
+      GetTime(NewTime);
+      if NewTime.Hour >= 12 then
+        Dec(NewTime.Hour, 12);
+      if (NewTime.Second <> FDisplayTime.Second) then
+        if ShowSeconds then
+          DrawSecondHand(FDisplayTime.Second);
+      if ((NewTime.Minute <> FDisplayTime.Minute) or
+        (NewTime.Hour <> FDisplayTime.Hour)) then
+      begin
+        DrawFatHand(FDisplayTime.Minute, False);
+        DrawFatHand(HourHandPos(FDisplayTime), True);
+        Pen.Color := Self.Font.Color;
+        DrawFatHand(NewTime.Minute, False);
+        DrawFatHand(HourHandPos(NewTime), True);
+      end;
+      Pen.Color := Brush.Color;
+      if (NewTime.Second <> FDisplayTime.Second) then
+      begin
+        if ShowSeconds then
+          DrawSecondHand(NewTime.Second);
+        FDisplayTime := NewTime;
+      end;
+    end;
+  end;
+end;
+
+procedure TRxClock.PaintTimeStr(var Rect: TRect; FullTime: Boolean);
+var
+  FontHeight, FontWidth, FullWidth, I, L, H: Integer;
+  TimeStr, SAmPm: string;
+  NewTime: TRxClockTime;
+
+  function IsPartSym(Idx, Num: Byte): Boolean;
+  var
+    TwoSymHour: Boolean;
+  begin
+    TwoSymHour := (H >= 10) or FLeadingZero;
+    case Idx of
+      1: begin {hours}
+           Result := True;
+         end;
+      2: begin {minutes}
+           if TwoSymHour then Result := (Num in [4, 5])
+           else Result := (Num in [3, 4]);
+         end;
+      3: begin {seconds}
+           if TwoSymHour then Result := FShowSeconds and (Num in [7, 8])
+           else Result := FShowSeconds and (Num in [6, 7]);
+         end;
+      else Result := False;
+    end;
+  end;
+
+  procedure DrawSym(Sym: Char; Num: Byte);
+  begin
+    if FullTime or
+      ((NewTime.Second <> FDisplayTime.Second) and IsPartSym(3, Num)) or
+      ((NewTime.Minute <> FDisplayTime.Minute) and IsPartSym(2, Num)) or
+      (NewTime.Hour <> FDisplayTime.Hour) then
+    begin
+      Canvas.FillRect(Rect);
+      DrawText(Canvas.Handle, @Sym, 1, Rect, DT_EXPANDTABS or
+        DT_VCENTER or DT_CENTER or DT_NOCLIP or DT_SINGLELINE);
+    end;
+  end;
+
+begin
+  GetTime(NewTime);
+  H := NewTime.Hour;
+  if NewTime.Hour >= 12 then Dec(NewTime.Hour, 12);
+  if FTwelveHour then begin
+    if H > 12 then Dec(H, 12) else if H = 0 then H := 12;
+  end;
+  if (not FullTime) and (NewTime.Hour <> FDisplayTime.Hour) then begin
+    Repaint;
+    Exit;
+  end;
+  if FLeadingZero then TimeStr := 'hh:mm' else TimeStr := 'h:mm';
+  if FShowSeconds then TimeStr := TimeStr + ':ss';
+  if FTwelveHour then TimeStr := TimeStr + ' ampm';
+  with NewTime do
+    TimeStr := FormatDateTime(TimeStr, GetSystemTime);
+  if (H >= 10) or FLeadingZero then L := 5 else L := 4;
+  if FShowSeconds then Inc(L, 3);
+  SAmPm := Copy(TimeStr, L + 1, MaxInt);
+  with Canvas do begin
+    Font := Self.Font;
+    FontHeight := TextHeight('8');
+    FontWidth := TextWidth('8');
+    FullWidth := TextWidth(SAmPm) + (L * FontWidth);
+    with Rect do begin
+      Left := ((Right + Left) - FullWidth) div 2 {shr 1};
+      Right := Left + FullWidth;
+      Top := ((Bottom + Top) - FontHeight) div 2 {shr 1};
+      Bottom := Top + FontHeight;
+    end;
+    Brush.Color := Color;
+    for I := 1 to L do begin
+      Rect.Right := Rect.Left + FontWidth;
+      DrawSym(TimeStr[I], I);
+      Inc(Rect.Left, FontWidth);
+    end;
+    if FullTime or (NewTime.Hour <> FDisplayTime.Hour) then begin
+      Rect.Right := Rect.Left + TextWidth(SAmPm);
+      DrawText(Handle, @SAmPm[1], Length(SAmPm), Rect,
+        DT_EXPANDTABS or DT_VCENTER or DT_NOCLIP or DT_SINGLELINE);
+    end;
+  end;
+  FDisplayTime := NewTime;
+end;
+
+procedure TRxClock.Paint3DFrame(var Rect: TRect);
+var
+  TopColor, BottomColor: TColor;
+
+  procedure AdjustColors(Bevel: TPanelBevel);
+  begin
+    TopColor := clBtnHighlight;
+    if Bevel = bvLowered then TopColor := clBtnShadow;
+    BottomColor := clBtnShadow;
+    if Bevel = bvLowered then BottomColor := clBtnHighlight;
+  end;
+
+begin
+  Rect := GetClientRect;
+  with Canvas do
+  begin
+    Brush.Color := Color;
+    FillRect(Rect);
+  end;
+  if BevelOuter <> bvNone then
+  begin
+    AdjustColors(BevelOuter);
+    RxFrame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
+  end;
+  InflateRect(Rect, -BorderWidth, -BorderWidth);
+  if BevelInner <> bvNone then
+  begin
+    AdjustColors(BevelInner);
+    RxFrame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
+  end;
+end;
+
+procedure TRxClock.Paint;
+var
+  R: TRect;
+begin
+  Paint3DFrame(R);
+  case FShowMode of
+    scDigital: PaintTimeStr(R, True);
+    scAnalog: PaintAnalogClock(pmPaintAll);
+  end;
+end;
+
+end.

RXLib/rxcontrols/rxcloseformvalidator.pas

@@ -0,0 +1,416 @@
+{ RxCloseFormValidator 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 RxCloseFormValidator;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DB;
+
+type
+  TRxCloseFormValidator = class;
+
+  TValidateEvent = procedure(AOwner:TRxCloseFormValidator; AControl:TWinControl; var Validate:boolean) of object;
+
+  { TValidateItem }
+
+  TValidateItem = class(TCollectionItem)
+  private
+    FControl: TWinControl;
+    FEnabled: boolean;
+    FFieldCaption: string;
+    FOnValidate: TValidateEvent;
+    procedure SetControl(AValue: TWinControl);
+    procedure SetEnabled(AValue: boolean);
+    procedure SetFieldCaption(AValue: string);
+    function DBComponentField:TField;
+  protected
+    function GetDisplayName: string; override;
+  public
+    constructor Create(ACollection: TCollection); override;
+    destructor Destroy; override;
+    function CheckClose(AForm:TCustomForm):boolean;
+    function ErrorMessage:string;
+    procedure SetFocus;
+  published
+    property Control:TWinControl read FControl write SetControl;
+    property Enabled:boolean read FEnabled write SetEnabled default true;
+    property FieldCaption:string read FFieldCaption write SetFieldCaption;
+    property OnValidate:TValidateEvent read FOnValidate write FOnValidate;
+  end;
+
+  { TValidateItems }
+
+  TValidateItems = class(TOwnedCollection)
+  private
+    function GetItems(Index: Integer): TValidateItem;
+    procedure SetItems(Index: Integer; AValue: TValidateItem);
+  public
+    property Items[Index: Integer]: TValidateItem read GetItems write SetItems; default;
+  end;
+
+  { TRxCloseFormValidator }
+
+  TRxCloseFormValidator = class(TComponent)
+  private
+    FErrorMsgCaption: string;
+    FIgnoreDisabled: boolean;
+    FOnCloseQuery : TCloseQueryEvent;
+    FItems:TValidateItems;
+    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
+    function GetItems: TValidateItems;
+    procedure SetCloseQueryHandler;
+    procedure SetItems(AValue: TValidateItems);
+  protected
+    procedure Notification(AComponent: TComponent;
+      Operation: TOperation); override;
+    procedure Loaded; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function CheckCloseForm:boolean;
+    function ByControl(AControl: TWinControl):TValidateItem;
+  published
+    property ErrorMsgCaption:string read FErrorMsgCaption write FErrorMsgCaption;
+    property Items:TValidateItems read GetItems write SetItems;
+    property IgnoreDisabled:boolean read FIgnoreDisabled write FIgnoreDisabled default false;
+  end;
+
+implementation
+uses LCLType, StdCtrls, DbCtrls, typinfo, ComCtrls, ExtCtrls, rxconst;
+
+{ TValidateItems }
+
+function TValidateItems.GetItems(Index: Integer): TValidateItem;
+begin
+  result := TValidateItem( inherited Items[Index] );
+end;
+
+procedure TValidateItems.SetItems(Index: Integer; AValue: TValidateItem);
+begin
+  Items[Index].Assign( AValue );
+end;
+
+{constructor TValidateItems.Create;
+begin
+  inherited Create(TValidateItem);
+end;}
+
+{ TValidateItem }
+
+procedure TValidateItem.SetControl(AValue: TWinControl);
+var
+  i:integer;
+  OwnForm, P:TComponent;
+  F:TField;
+begin
+  if FControl=AValue then Exit;
+  FControl:=AValue;
+
+  if Assigned(FControl) and (FFieldCaption = '') then
+  begin
+    //Установим название поля по текст компоненты
+    if FControl is TCustomRadioGroup then
+      FFieldCaption:=TCustomRadioGroup(FControl).Caption
+    else
+    if FControl is TCustomCheckBox then
+      FFieldCaption:=TCustomCheckBox(FControl).Caption
+    else
+    if Assigned(FControl.Owner) then
+    begin
+      OwnForm:=FControl.Owner;
+      //Попробуем найти название поле - по тексту метки, которая связана с данным полем
+      for i:=0 to OwnForm.ComponentCount-1 do
+      begin
+        P:=OwnForm.Components[i];
+        if P is TLabel then
+          if TLabel(P).FocusControl = FControl then
+          begin
+            FFieldCaption:=TLabel(P).Caption;
+            break;
+          end;
+      end;
+    end;
+
+    if FFieldCaption = '' then
+    begin
+      F:=DBComponentField;
+      if Assigned(F) then
+        FFieldCaption:=F.DisplayLabel;
+    end;
+  end
+end;
+
+procedure TValidateItem.SetEnabled(AValue: boolean);
+begin
+  if FEnabled=AValue then Exit;
+  FEnabled:=AValue;
+end;
+
+procedure TValidateItem.SetFieldCaption(AValue: string);
+begin
+  if FFieldCaption=AValue then Exit;
+  FFieldCaption:=AValue;
+end;
+
+function TValidateItem.DBComponentField: TField;
+var
+  P:TObject;
+  PI1, PI2:PPropInfo;
+  FiName:string;
+  DS:TDataSet;
+begin
+  Result:=nil;
+  if not Assigned(FControl) then exit;
+  //Сначала проверим - вдруги это завязки на работу с БД
+  PI1:=GetPropInfo(Control, 'DataSource');
+  PI2:=GetPropInfo(Control, 'DataField');
+  if Assigned(PI1) and Assigned(PI2) then
+  begin
+     //Точно - БД
+     P:=GetObjectProp(Control, 'DataSource');
+     FiName:=GetPropValue(Control, 'DataField');
+     if Assigned(P) and (FiName<>'') then
+     begin
+       DS:=(P as TDataSource).DataSet;
+       if Assigned(DS) then
+         Result:=DS.FieldByName(FiName);
+     end;
+  end
+end;
+
+function TValidateItem.GetDisplayName: string;
+begin
+  if Assigned(FControl) then
+  begin
+    if FEnabled then
+      Result:=FControl.Name + ' - validate'
+    else
+      Result:=FControl.Name + ' - disabled'
+  end
+  else
+    Result:=inherited GetDisplayName;
+end;
+
+constructor TValidateItem.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FEnabled:=true;
+end;
+
+destructor TValidateItem.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TValidateItem.CheckClose(AForm: TCustomForm): boolean;
+var
+  P:TObject;
+  PI1, PI2:PPropInfo;
+  FiName:string;
+  DS:TDataSet;
+begin
+  Result:=true;
+  if not Assigned(FControl) then exit;
+
+  if (not FControl.Enabled) and (TRxCloseFormValidator(TValidateItems(Collection).Owner).IgnoreDisabled) then
+    exit;
+
+  if Assigned(FOnValidate) then
+    FOnValidate( TRxCloseFormValidator(TValidateItems(Collection).Owner), FControl, Result)
+  else
+  begin
+    if FControl = AForm.ActiveControl then
+    begin
+      AForm.SelectNext(FControl, true, true);
+    end;
+    //Сначала проверим - вдруги это завязки на работу с БД
+    PI1:=GetPropInfo(Control, 'DataSource');
+    PI2:=GetPropInfo(Control, 'DataField');
+    if Assigned(PI1) and Assigned(PI2) then
+    begin
+       //Точно - БД
+       //Проверка выполняется если только указан источник данных и поле в нём
+       P:=GetObjectProp(Control, 'DataSource');
+       FiName:=GetPropValue(Control, 'DataField');
+       if Assigned(P) and (FiName<>'') then
+       begin
+         DS:=(P as TDataSource).DataSet;
+         if Assigned(DS) then
+           Result:=not DS.FieldByName(FiName).IsNull;
+       end;
+    end
+    else
+    if Control is TCustomEdit then
+      Result:=TCustomEdit(Control).Text<>'';
+  end;
+end;
+
+function TValidateItem.ErrorMessage: string;
+begin
+  Result:=Format(sReqValue, [FFieldCaption]);
+end;
+
+procedure TValidateItem.SetFocus;
+var
+  P:TWinControl;
+begin
+
+  if FControl is TWinControl then
+  begin
+    P:=TWinControl(FControl).Parent;
+    //Необходимо обработать случай нахождения компоненты на PageControl-e
+    while Assigned(P) and not (P is TCustomForm) do
+    begin
+      if P is TTabSheet then
+        TTabSheet(P).PageControl.ActivePage:=TTabSheet(P);
+      P:=P.Parent;
+    end;
+    TWinControl(FControl).SetFocus;
+  end;
+end;
+
+{ TRxCloseFormValidator }
+
+procedure TRxCloseFormValidator.FormCloseQuery(Sender: TObject;
+  var CanClose: boolean);
+begin
+  if Sender is TCustomForm then
+  begin
+    if TForm(Sender).ModalResult = mrOk then
+    begin
+     if CanClose and Assigned(FOnCloseQuery) then
+       FOnCloseQuery(Sender, CanClose);
+     if CanClose then
+       CanClose:=CheckCloseForm;
+    end;
+  end;
+end;
+
+function TRxCloseFormValidator.CheckCloseForm: boolean;
+var
+  i:integer;
+  F:TComponent;
+begin
+  F:=Owner;
+  while Assigned(F) and not (F is TCustomForm) do
+    F:=F.Owner;
+
+  Result:=false;
+
+  if not Assigned(F) then exit;
+
+  for i:=0 to FItems.Count-1 do
+  begin
+    if FItems[i].Enabled and (not FItems[i].CheckClose(F as TCustomForm)) then
+    begin
+      FItems[i].SetFocus;
+      Application.MessageBox(PChar(FItems[i].ErrorMessage), PChar(FErrorMsgCaption), MB_OK + MB_ICONERROR);
+      exit;
+    end;
+  end;
+  Result:=true;
+end;
+
+function TRxCloseFormValidator.ByControl(AControl: TWinControl): TValidateItem;
+var
+  i:integer;
+begin
+  Result:=nil;
+  for i:=0 to FItems.Count - 1 do
+  begin
+    if FItems[i].FControl = AControl then
+    begin
+      Result:=FItems[i];
+      exit;
+    end;
+  end;
+  raise Exception.CreateFmt(sExptControlNotFound, [Name]);
+end;
+
+function TRxCloseFormValidator.GetItems: TValidateItems;
+begin
+  Result:=FItems;
+end;
+
+procedure TRxCloseFormValidator.SetCloseQueryHandler;
+begin
+  if (csDesigning in ComponentState) or (not Assigned(Owner)) then exit;
+  if Owner is TCustomForm then
+  begin
+    FOnCloseQuery:=TForm(Owner).OnCloseQuery;
+    TForm(Owner).OnCloseQuery:=@FormCloseQuery;
+  end;
+end;
+
+procedure TRxCloseFormValidator.SetItems(AValue: TValidateItems);
+begin
+  FItems.Assign(AValue);
+end;
+
+procedure TRxCloseFormValidator.Notification(AComponent: TComponent;
+  Operation: TOperation);
+var
+  i:integer;
+begin
+  inherited Notification(AComponent, Operation);
+  if AComponent = Self then exit;
+  if Operation = opRemove then
+  begin
+    for i:=0 to FItems.Count - 1 do
+      if FItems[i].Control = AComponent then
+        FItems[i].Control := nil;
+  end;
+end;
+
+procedure TRxCloseFormValidator.Loaded;
+begin
+  inherited Loaded;
+  SetCloseQueryHandler;
+end;
+
+constructor TRxCloseFormValidator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FErrorMsgCaption:=sCloseValidError;
+  FItems:=TValidateItems.Create(Self, TValidateItem);
+end;
+
+destructor TRxCloseFormValidator.Destroy;
+begin
+  FreeAndNil(FItems);
+  inherited Destroy;
+end;
+
+end.

RXLib/rxcontrols/rxcurredit.pas

@@ -0,0 +1,694 @@
+{ curredit 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 rxcurredit;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LMessages,
+  MaskEdit;
+
+type
+
+  { TCustomNumEdit }
+
+  TCustomNumEdit = class(TCustomMaskEdit)
+  private
+    FEditFormat: string;
+    FFocusedDisplay: boolean;
+    FBeepOnError: Boolean;
+    FCheckOnExit: Boolean;
+    FDecimalPlaces: Cardinal;
+    FDisplayFormat: string;
+//    FFormatOnEditing: Boolean;
+    FFormatting: Boolean;
+    FMaxValue: Extended;
+    FMinValue: Extended;
+    FValue: Extended;
+    FFocused: Boolean;
+    FZeroEmpty: Boolean;
+    function GetAsInteger: Longint;
+    function GetIsNull: boolean;
+    function GetText: string;
+    function GetValue: Extended;
+    procedure SetAsInteger(const AValue: Longint);
+    procedure SetBeepOnError(const AValue: Boolean);
+    procedure SetDecimalPlaces(const AValue: Cardinal);
+    procedure SetDisplayFormat(const AValue: string);
+    procedure SetEditFormat(AValue: string);
+//    procedure SetFormatOnEditing(const AValue: Boolean);
+    procedure SetMaxValue(const AValue: Extended);
+    procedure SetMinValue(const AValue: Extended);
+    procedure SetText(const AValue: string);
+    procedure SetValue(const AValue: Extended);
+    procedure SetZeroEmpty(const AValue: Boolean);
+    function TextToValText(const AValue: string): string;
+    function CheckValue(NewValue: Extended; RaiseOnError: Boolean): Extended;
+//    procedure SetFocused(Value: Boolean);
+  protected
+    //messages
+{    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
+    procedure CMEnter(var Message: TLMEnter); message LM_ENTER;
+    procedure WMExit(var Message: TLMExit); message LM_EXIT; }
+
+    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
+    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
+
+//    procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
+//    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
+    procedure WMPaste(var Message: TLMessage); message LM_PASTE;
+//    procedure GetSel(var ASelStart: Integer; var SelStop: Integer);
+{    procedure DoEnter; override;
+    procedure DoExit; override;}
+//    procedure AcceptValue(const Value: Variant); override;
+
+//    procedure Change; override;
+//    procedure ReformatEditText; dynamic;
+    procedure DataChanged; virtual;
+    procedure KeyPress(var Key: Char); override;
+    function IsValidChar(Key: Char): Boolean; virtual;
+    function FormatDisplayText(Value: Extended): string;
+    function GetDisplayText: string; virtual;
+    procedure Reset; override;
+    procedure CheckRange;
+    procedure UpdateData;
+    property Formatting: Boolean read FFormatting;
+    property BeepOnError: Boolean read FBeepOnError write SetBeepOnError
+      default True;
+    property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
+    property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces
+      default 2;
+    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
+    property EditFormat: string read FEditFormat write SetEditFormat;
+    property MaxValue: Extended read FMaxValue write SetMaxValue;
+    property MinValue: Extended read FMinValue write SetMinValue;
+//    property FormatOnEditing: Boolean read FFormatOnEditing write SetFormatOnEditing default False;
+    property Text: string read GetText write SetText stored False;
+    property MaxLength default 0;
+    property ZeroEmpty: Boolean read FZeroEmpty write SetZeroEmpty default True;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Clear;
+    property AsInteger: Longint read GetAsInteger write SetAsInteger;
+    property DisplayText: string read GetDisplayText;
+    property Value: Extended read GetValue write SetValue;
+    property IsNull:boolean read GetIsNull;
+  published
+    { Published declarations }
+  end;
+  
+  { TCurrencyEdit }
+
+  TCurrencyEdit = class(TCustomNumEdit)
+  protected
+  public
+  published
+    property Alignment;
+    property AutoSelect;
+    property AutoSize;
+    property BeepOnError;
+    property BorderStyle;
+    property BorderSpacing;
+    property CheckOnExit;
+    property Color;
+    property DecimalPlaces;
+    property DisplayFormat;
+    property EditFormat;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property HideSelection;
+    property Anchors;
+    property BiDiMode;
+    property Constraints;
+    property DragKind;
+    property ParentBiDiMode;
+{$IFDEF WIN32}
+  {$IFNDEF VER90}
+//    property ImeMode;
+//    property ImeName;
+  {$ENDIF}
+{$ENDIF}
+    property MaxLength;
+    property MaxValue;
+    property MinValue;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property Value;
+    property Visible;
+    property ZeroEmpty;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+
+    property OnContextPopup;
+    property OnStartDrag;
+    property OnEndDock;
+    property OnStartDock;
+  end;
+
+implementation
+uses strutils, Math, rxtooledit, rxconst;
+
+function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
+var
+  I: Integer;
+  Buffer: array[0..63] of Char;
+begin
+  Result := False;
+  for I := 1 to Length(Value) do
+    if not (Value[I] in [DefaultFormatSettings.DecimalSeparator, '-', '+', '0'..'9', 'e', 'E']) then
+      Exit;
+  Result := TextToFloat(StrPLCopy(Buffer, Value,
+    SizeOf(Buffer) - 1), RetValue, fvExtended);
+end;
+
+function FormatFloatStr(const S: string; Thousands: Boolean): string;
+var
+  I, MaxSym, MinSym, Group: Integer;
+  IsSign: Boolean;
+begin
+  Result := '';
+  MaxSym := Length(S);
+  IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
+  if IsSign then MinSym := 2
+  else MinSym := 1;
+  I := Pos(DefaultFormatSettings.DecimalSeparator, S);
+  if I > 0 then MaxSym := I - 1;
+  I := Pos('E', AnsiUpperCase(S));
+  if I > 0 then MaxSym := Min(I - 1, MaxSym);
+  Result := Copy(S, MaxSym + 1, MaxInt);
+  Group := 0;
+  for I := MaxSym downto MinSym do begin
+    Result := S[I] + Result;
+    Inc(Group);
+    if (Group = 3) and Thousands and (I > MinSym) then begin
+      Group := 0;
+      Result := DefaultFormatSettings.ThousandSeparator + Result;
+    end;
+  end;
+  if IsSign then Result := S[1] + Result;
+end;
+
+{ TCustomNumEdit }
+
+function TCustomNumEdit.GetAsInteger: Longint;
+begin
+  Result := Trunc(Value);
+end;
+
+function TCustomNumEdit.GetIsNull: boolean;
+begin
+  Result:=false;
+end;
+
+function TCustomNumEdit.GetDisplayText: string;
+begin
+  Result := FormatDisplayText(Value);
+end;
+
+procedure TCustomNumEdit.Reset;
+begin
+  DataChanged;
+  SelectAll;
+end;
+
+procedure TCustomNumEdit.CheckRange;
+begin
+  if not (csDesigning in ComponentState) and CheckOnExit then
+    CheckValue(StrToFloat(TextToValText(EditText)), True);
+end;
+
+procedure TCustomNumEdit.UpdateData;
+begin
+  ValidateEdit;
+  FValue := CheckValue(StrToFloat(TextToValText(EditText)), False);
+end;
+
+constructor TCustomNumEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  ControlStyle := ControlStyle - [csSetCaption];
+  MaxLength := 0;
+  FBeepOnError := True;
+  FDecimalPlaces := 2;
+  FZeroEmpty := True;
+  inherited Text := '';
+  Alignment := taRightJustify;
+  DataChanged;
+  ControlState := ControlState + [csCreating];
+end;
+
+function TCustomNumEdit.GetText: string;
+begin
+  if (FValue = 0) and FZeroEmpty then
+    Result:=''
+  else
+  begin
+    if FEditFormat <> '' then
+      Result := FormatFloat(FEditFormat, FValue)
+    else
+      Result := FloatToStr(FValue);
+  end;
+end;
+
+function TCustomNumEdit.GetValue: Extended;
+begin
+  if (not (csDesigning in ComponentState)) and FFocusedDisplay then
+  begin
+    try
+      UpdateData;
+    except
+      FValue := FMinValue;
+    end;
+  end;
+  Result := FValue;
+end;
+
+procedure TCustomNumEdit.SetAsInteger(const AValue: Longint);
+begin
+  SetValue(AValue);
+end;
+
+procedure TCustomNumEdit.SetBeepOnError(const AValue: Boolean);
+begin
+  if FBeepOnError=AValue then exit;
+  FBeepOnError:=AValue;
+end;
+
+procedure TCustomNumEdit.SetDecimalPlaces(const AValue: Cardinal);
+begin
+  if FDecimalPlaces=AValue then exit;
+  FDecimalPlaces:=AValue;
+  DataChanged;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.SetDisplayFormat(const AValue: string);
+begin
+  if FDisplayFormat=AValue then exit;
+  FDisplayFormat:=AValue;
+  DataChanged;
+end;
+
+procedure TCustomNumEdit.SetEditFormat(AValue: string);
+begin
+  if FEditFormat=AValue then Exit;
+  FEditFormat:=AValue;
+  DataChanged;
+end;
+
+{
+procedure TCustomNumEdit.SetFormatOnEditing(const AValue: Boolean);
+begin
+  if FFormatOnEditing=AValue then exit;
+  FFormatOnEditing:=AValue;
+  if FFormatOnEditing and FFocused then
+    ReformatEditText
+  else
+  if FFocused then
+  begin
+    UpdateData;
+    DataChanged;
+  end;
+end;
+}
+procedure TCustomNumEdit.SetMaxValue(const AValue: Extended);
+begin
+  if FMaxValue=AValue then exit;
+  FMaxValue:=AValue;
+  if Value > AValue then
+    Value:=AValue;
+end;
+
+procedure TCustomNumEdit.SetMinValue(const AValue: Extended);
+begin
+  if FMinValue=AValue then exit;
+  FMinValue:=AValue;
+  if Value < AValue then
+    Value:=AValue;
+end;
+
+procedure TCustomNumEdit.SetText(const AValue: string);
+begin
+  if not (csReading in ComponentState) then
+  begin
+    FValue := CheckValue(StrToFloat(TextToValText(AValue)), False);
+    DataChanged;
+    Invalidate;
+  end;
+end;
+
+procedure TCustomNumEdit.SetValue(const AValue: Extended);
+begin
+  FValue := CheckValue(AValue, False);
+  DataChanged;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.SetZeroEmpty(const AValue: Boolean);
+begin
+  if FZeroEmpty=AValue then exit;
+  FZeroEmpty:=AValue;
+  DataChanged;
+end;
+
+function TCustomNumEdit.TextToValText(const AValue: string): string;
+begin
+  Result := Trim(AValue);
+  if DefaultFormatSettings.DecimalSeparator <> DefaultFormatSettings.ThousandSeparator then begin
+    Result := DelChars(Result, ThousandSeparator);
+  end;
+  if (DefaultFormatSettings.DecimalSeparator <> '.') and (DefaultFormatSettings.ThousandSeparator <> '.') then
+    Result := StringReplace(Result, '.', DefaultFormatSettings.DecimalSeparator, [rfReplaceAll]);
+  if (DefaultFormatSettings.DecimalSeparator <> ',') and (DefaultFormatSettings.ThousandSeparator <> ',') then
+    Result := StringReplace(Result, ',', DefaultFormatSettings.DecimalSeparator, [rfReplaceAll]);
+  if Result = '' then Result := '0'
+  else if Result = '-' then Result := '-0';
+end;
+
+function TCustomNumEdit.CheckValue(NewValue: Extended; RaiseOnError: Boolean
+  ): Extended;
+begin
+  Result := NewValue;
+  if (FMaxValue <> FMinValue) then begin
+    if (FMaxValue > FMinValue) then begin
+      if NewValue < FMinValue then Result := FMinValue
+      else if NewValue > FMaxValue then Result := FMaxValue;
+    end
+    else begin
+      if FMaxValue = 0 then begin
+        if NewValue < FMinValue then Result := FMinValue;
+      end
+      else if FMinValue = 0 then begin
+        if NewValue > FMaxValue then Result := FMaxValue;
+      end;
+    end;
+    if RaiseOnError and (Result <> NewValue) then
+      raise ERangeError.CreateFmt(StringReplace(SOutOfRange, '%d', '%.*f', [rfReplaceAll]),
+        [DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
+  end;
+end;
+{
+procedure TCustomNumEdit.SetFocused(Value: Boolean);
+begin
+  if FFocused <> Value then
+  begin
+    FFocused := Value;
+    Invalidate;
+    FFormatting := True;
+    try
+      DataChanged;
+    finally
+      FFormatting := False;
+    end;
+  end;
+end;
+}
+procedure TCustomNumEdit.WMSetFocus(var Message: TLMSetFocus);
+begin
+  inherited WMSetFocus(Message);
+  // some widgetsets do not notify clipboard actions properly. Put at edit state at entry
+  if FFocusedDisplay then
+    exit;
+  FFocusedDisplay := true;
+  Reset;
+end;
+
+procedure TCustomNumEdit.WMKillFocus(var Message: TLMKillFocus);
+begin
+  inherited WMKillFocus(Message);
+  FFocusedDisplay := False;
+  UpdateData;
+  if not Focused then
+      DisableMask(GetDisplayText);
+end;
+
+{
+procedure TCustomNumEdit.CMEnabledChanged(var Message: TLMessage);
+begin
+  inherited;
+  if NewStyleControls and not FFocused then Invalidate;
+end;
+
+procedure TCustomNumEdit.CMEnter(var Message: TLMEnter);
+begin
+  SetFocused(True);
+  if FFormatOnEditing then ReformatEditText;
+  inherited;
+end;
+
+procedure TCustomNumEdit.WMExit(var Message: TLMExit);
+begin
+  inherited;
+  try
+    CheckRange;
+    UpdateData;
+  except
+    SelectAll;
+    if CanFocus then SetFocus;
+    raise;
+  end;
+  SetFocused(False);
+  Cursor:=0;
+  DoExit;
+end;
+
+procedure TCustomNumEdit.CMFontChanged(var Message: TLMessage);
+begin
+  inherited;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.WMPaint(var Message: TLMPaint);
+var
+  S: string;
+begin
+  S := GetDisplayText;
+//  if not FFocused then
+//  else
+//  if not PaintComboEdit(Self, S, FAlignment, FFocused {and not PopupVisible}, FCanvas, Message) then
+  inherited WMPaint(Message);
+end;
+}
+procedure TCustomNumEdit.WMPaste(var Message: TLMessage);
+var
+  S: string;
+begin
+  S := EditText;
+  try
+    inherited;
+    UpdateData;
+  except
+    EditText := S;
+    SelectAll;
+    if CanFocus then SetFocus;
+//    if BeepOnError then MessageBeep(0);
+  end;
+end;
+{
+procedure TCustomNumEdit.GetSel(var ASelStart: Integer; var SelStop: Integer);
+begin
+  ASelStart:=SelStart;
+  SelStop:=SelStart + SelLength;
+end;
+
+
+procedure TCustomNumEdit.DoEnter;
+begin
+  SetFocused(True);
+  if FFormatOnEditing then ReformatEditText;
+  inherited DoEnter;
+end;
+
+procedure TCustomNumEdit.DoExit;
+begin
+  try
+    CheckRange;
+    UpdateData;
+  except
+    SelectAll;
+    if CanFocus then SetFocus;
+    raise;
+  end;
+  SetFocused(False);
+  Cursor:=0;
+
+  inherited DoExit;
+  Invalidate;
+end;
+
+procedure TCustomNumEdit.AcceptValue(const Value: Variant);
+begin
+  inherited AcceptValue(Value);
+end;
+
+procedure TCustomNumEdit.Change;
+begin
+  if not FFormatting then
+  begin
+    if FFormatOnEditing and FFocused then ReformatEditText;
+    inherited Change;
+  end;
+end;
+
+procedure TCustomNumEdit.ReformatEditText;
+var
+  S: string;
+  IsEmpty: Boolean;
+  OldLen, ASelStart, SelStop: Integer;
+begin
+  FFormatting := True;
+  try
+    S := inherited Text;
+    OldLen := Length(S);
+    IsEmpty := (OldLen = 0) or (S = '-');
+    if HandleAllocated then GetSel(ASelStart, SelStop);
+    if not IsEmpty then S := TextToValText(S);
+    S := FormatFloatStr(S, Pos(',', DisplayFormat) > 0);
+    inherited Text := S;
+{    if HandleAllocated and (GetFocus = Handle) and not
+      (csDesigning in ComponentState) then
+    begin
+      Inc(ASelStart, Length(S) - OldLen);
+      SetCursor(ASelStart);
+    end;}
+  finally
+    FFormatting := False;
+  end;
+end;
+}
+procedure TCustomNumEdit.DataChanged;
+begin
+  if FFocusedDisplay then
+    RestoreMask(GetText)
+  else
+    DisableMask(GetDisplayText)
+end;
+
+procedure TCustomNumEdit.KeyPress(var Key: Char);
+begin
+  if Key in ['.', ','] - [DefaultFormatSettings.ThousandSeparator] then
+    Key := DefaultFormatSettings.DecimalSeparator;
+  inherited KeyPress(Key);
+  if (Key in [#32..#255]) and not IsValidChar(Key) then
+  begin
+//    if BeepOnError then MessageBeep(0);
+    Key := #0;
+  end
+  else
+  if Key = #27 then
+  begin
+    Reset;
+    Key := #0;
+  end;
+end;
+
+function TCustomNumEdit.IsValidChar(Key: Char): Boolean;
+var
+  S: string;
+  ASelStart, SelStop, DecPos: Integer;
+  RetValue: Extended;
+begin
+  Result := False;
+  S := EditText;
+  GetSel(ASelStart, SelStop);
+  System.Delete(S, ASelStart + 1, SelStop - ASelStart);
+  System.Insert(Key, S, ASelStart + 1);
+  S := TextToValText(S);
+  DecPos := Pos(DefaultFormatSettings.DecimalSeparator, S);
+  if (DecPos > 0) then
+  begin
+    ASelStart := Pos('E', UpperCase(S));
+    if (ASelStart > DecPos) then
+      DecPos := ASelStart - DecPos
+    else
+      DecPos := Length(S) - DecPos;
+    if DecPos > Integer(FDecimalPlaces) then
+      Exit;
+
+    if S[1] = DefaultFormatSettings.DecimalSeparator then
+      s := '0' + s;
+  end;
+  Result := IsValidFloat(S, RetValue);
+  if Result and (FMinValue >= 0) and (FMaxValue > 0) and (RetValue < 0) then
+    Result := False;
+end;
+
+function TCustomNumEdit.FormatDisplayText(Value: Extended): string;
+var
+  Digits : integer;
+begin
+  if FZeroEmpty and (Value = 0) then
+    Result:=''
+  else
+  if DisplayFormat <> '' then
+    Result:=FormatFloat(DisplayFormat, Value)
+  else
+  begin
+    Digits := DefaultFormatSettings.CurrencyDecimals;
+    Result:=FloatToStrF(Value, ffCurrency, DecimalPlaces, Digits);
+  end;
+end;
+
+procedure TCustomNumEdit.Clear;
+begin
+  Text:='';
+end;
+
+initialization
+  RegisterPropertyToSkip( TCustomNumEdit, 'FormatOnEditing', 'This property depricated', '');
+end.

RXLib/rxcontrols/rxdaterangeeditunit.pas

@@ -0,0 +1,585 @@
+{ rxDateRangeEditUnit 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 rxDateRangeEditUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, types, Controls, Buttons, StdCtrls, Spin;
+
+type
+  TRxDateRangeEditOption = (reoMonth, reoQuarter, reoHalfYear);
+  TRxDateRangeEditOptions = set of TRxDateRangeEditOption;
+
+type
+
+  { TRxCustomDateRangeEdit }
+
+  TRxCustomDateRangeEdit = class(TCustomControl)
+  private
+    FFlat: Boolean;
+    FLockCount:integer;
+    FOnEditChange: TNotifyEvent;
+    FOnEditClick: TNotifyEvent;
+    FOnEditEnter: TNotifyEvent;
+    FOnEditExit: TNotifyEvent;
+    FOptions: TRxDateRangeEditOptions;
+    FsbDecYear: TSpeedButton;
+    FsbDecMonth: TSpeedButton;
+    FsbIncYear: TSpeedButton;
+    FsbIncMonth: TSpeedButton;
+    FEditYear: TSpinEdit;
+    FEditMonth: TComboBox;
+    procedure DoIncMonth(Sender: TObject);
+    procedure DoIncYear(Sender: TObject);
+    procedure DoDecMonth(Sender: TObject);
+    procedure DoDecYear(Sender: TObject);
+    function GetHalfYear: word;
+    function GetMonth: word;
+    function GetPeriod: TDateTime;
+    function GetPeriodEnd: TDateTime;
+    function GetQuarter: word;
+    function GetYear: word;
+    procedure SetFlat(AValue: Boolean);
+    procedure SetHalfYear(AValue: word);
+    procedure SetMonth(AValue: word);
+    procedure SetOptions(AValue: TRxDateRangeEditOptions);
+    procedure SetPeriod(AValue: TDateTime);
+    procedure SetQuarter(AValue: word);
+    procedure SetYear(AValue: word);
+    procedure InternalOnEditChange(Sender: TObject);
+    procedure InternalOnEditClick(Sender: TObject);
+    procedure InternalOnEditEnter(Sender: TObject);
+    procedure InternalOnEditExit(Sender: TObject);
+    procedure Lock;
+    procedure UnLock;
+  protected
+    class function GetControlClassDefaultSize: TSize; override;
+    procedure FillMonthNames;
+    procedure SetAutoSize(AValue: Boolean); override;
+    procedure EditChange; virtual;
+    procedure EditClick; virtual;
+    procedure EditEnter; virtual;
+    procedure EditExit; virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    property Quarter:word read GetQuarter write SetQuarter;
+    property HalfYear:word read GetHalfYear write SetHalfYear;
+    property Flat: Boolean read FFlat write SetFlat default False;
+    property Year:word read GetYear write SetYear;
+    property Month:word read GetMonth write SetMonth;
+    property Period:TDateTime read GetPeriod write SetPeriod;
+    property PeriodEnd:TDateTime read GetPeriodEnd;
+    property Options:TRxDateRangeEditOptions read FOptions write SetOptions default [reoMonth];
+    property OnChange: TNotifyEvent read FOnEditChange write FOnEditChange;
+    property OnClick: TNotifyEvent read FOnEditClick write FOnEditClick;
+    property OnEnter: TNotifyEvent read FOnEditEnter write FOnEditEnter;
+    property OnExit: TNotifyEvent read FOnEditExit write FOnEditExit;
+  end;
+
+type
+  TRxDateRangeEdit = class(TRxCustomDateRangeEdit)
+  published
+    property Align;
+    property Anchors;
+    property Autosize default True;
+    property BiDiMode;
+    property BorderSpacing;
+    property BorderStyle default bsNone;
+    property Color;
+    property Constraints;
+    property Cursor;
+    property Enabled;
+    property Flat;
+    property Hint;
+    property Month;
+    property Options;
+    property ParentBiDiMode;
+    property ParentColor;
+    property ParentFont;
+    property PopupMenu;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    property Year;
+
+    property OnChange;
+    property OnClick;
+    property OnEnter;
+    property OnExit;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+  end;
+
+implementation
+uses rxdateutil, rxconst;
+
+{ TRxCustomDateRangeEdit }
+
+procedure TRxCustomDateRangeEdit.DoIncMonth(Sender: TObject);
+var
+  i:integer;
+begin
+  if FEditMonth.ItemIndex>=0 then
+  begin
+    i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+
+    if I in [17, 18] then
+    begin
+      if i = 18 then
+      begin
+        i:=17;
+        Year:=Year + 1;
+      end
+      else
+        i:=18;
+    end
+    else
+    if i in [13..16] then
+    begin
+      inc(i);
+      if i> 16 then
+      begin
+        i:=13;
+        Year:=Year + 1;
+      end;
+    end
+    else
+    begin
+      inc(i);
+      if i > 12 then
+      begin
+        i:=1;
+        Year:=Year + 1;
+      end;
+    end;
+    FEditMonth.ItemIndex := i - 1;
+  end
+  else
+    FEditMonth.ItemIndex := 0;
+  InternalOnEditChange(Self);
+end;
+
+procedure TRxCustomDateRangeEdit.DoIncYear(Sender: TObject);
+begin
+  FEditYear.Value:=FEditYear.Value + 1;
+end;
+
+procedure TRxCustomDateRangeEdit.DoDecMonth(Sender: TObject);
+var
+  i:integer;
+begin
+  if FEditMonth.ItemIndex>=0 then
+  begin
+    i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+
+    if I in [17, 18] then
+    begin
+      if i = 18 then
+      begin
+        i:=17;
+        Year:=Year - 1;
+      end
+      else
+        i:=18;
+    end
+    else
+    if i in [13..16] then
+    begin
+      Dec(i);
+      if i> 13 then
+      begin
+        i:=16;
+        Year:=Year - 1;
+      end;
+    end
+    else
+    begin
+      Dec(i);
+      if i < 1 then
+      begin
+        i:=12;
+        Year:=Year - 1;
+      end;
+    end;
+    FEditMonth.ItemIndex := i - 1;
+  end
+  else
+    FEditMonth.ItemIndex := 0;
+  InternalOnEditChange(Self);
+end;
+
+procedure TRxCustomDateRangeEdit.DoDecYear(Sender: TObject);
+begin
+  FEditYear.Value:=FEditYear.Value - 1;
+end;
+
+function TRxCustomDateRangeEdit.GetHalfYear: word;
+var
+  i:integer;
+begin
+  Result:=0;
+  if reoHalfYear in FOptions then
+  begin
+    i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+    if i in [17..18] then
+      Result:=i - 16;
+  end
+end;
+
+function TRxCustomDateRangeEdit.GetMonth: word;
+var
+  i:integer;
+begin
+  Result:=0;
+  if (reoMonth in FOptions) or (FOptions = []) then
+  begin
+    i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+    if i in [1..12] then
+      Result:=i;
+  end
+end;
+
+function TRxCustomDateRangeEdit.GetPeriod: TDateTime;
+var
+  i: PtrInt;
+  M: Word;
+begin
+  i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+
+  if I < 13 then
+    M:=Month
+  else
+  if i in [13..16] then
+    M:= (I - 13) * 3 + 1
+  else
+  if i in [17..18] then
+    M:= (I - 17) * 6 + 1;
+
+  Result:=EncodeDate(Year, M, 1);
+end;
+
+function TRxCustomDateRangeEdit.GetPeriodEnd: TDateTime;
+var
+  i: PtrInt;
+  M: Integer;
+begin
+  i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+  if I < 13 then
+    M:=Month
+  else
+  if i in [13..16] then
+    M:= (I - 12) * 3
+  else
+  if i in [17..18] then
+    M:= (I - 16) * 6;
+
+  Result:=EncodeDate(Year, M, DaysPerMonth(Year, M))
+end;
+
+function TRxCustomDateRangeEdit.GetQuarter: word;
+var
+  i:integer;
+begin
+  Result:=0;
+  if reoQuarter in FOptions then
+  begin
+    i:=PtrInt(FEditMonth.Items.Objects[FEditMonth.ItemIndex]);
+    if i in [13..16] then
+      Result:=i - 12;
+  end
+end;
+
+function TRxCustomDateRangeEdit.GetYear: word;
+begin
+  Result:=FEditYear.Value;
+end;
+
+procedure TRxCustomDateRangeEdit.SetFlat(AValue: Boolean);
+begin
+  if FFlat=AValue then Exit;
+  FFlat:=AValue;
+  FsbDecMonth.Flat:=FFlat;
+  FsbDecYear.Flat:=FFlat;
+  FsbIncMonth.Flat:=FFlat;
+  FsbIncYear.Flat:=FFlat;
+end;
+
+procedure TRxCustomDateRangeEdit.SetHalfYear(AValue: word);
+begin
+
+end;
+
+procedure TRxCustomDateRangeEdit.SetMonth(AValue: word);
+begin
+  if (AValue>0) and (AValue < 13) then
+    FEditMonth.ItemIndex:=AValue-1;
+end;
+
+procedure TRxCustomDateRangeEdit.SetOptions(AValue: TRxDateRangeEditOptions);
+begin
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
+  FillMonthNames;
+end;
+
+procedure TRxCustomDateRangeEdit.SetPeriod(AValue: TDateTime);
+var
+  Y, M, D, Q: word;
+  I: Integer;
+begin
+  DecodeDate(AValue, Y, M, D);
+  FEditYear.Value:=Y;
+
+  if reoMonth in FOptions then
+    FEditMonth.ItemIndex:=M-1
+  else
+  if reoQuarter in FOptions then
+  begin
+    Q:=M div 4;
+    for I:=0 to FEditMonth.Items.Count - 1 do
+      if FEditMonth.Items.Objects[i] = TObject(Pointer(Q + 13)) then
+      begin
+        FEditMonth.ItemIndex:=i;
+        break;
+      end;
+  end
+  else
+  if reoHalfYear in FOptions then
+  begin
+    Q:=M div 6;
+    for I:=0 to FEditMonth.Items.Count - 1 do
+      if FEditMonth.Items.Objects[i] = TObject(Pointer(Q + 17)) then
+      begin
+        FEditMonth.ItemIndex:=i;
+        break;
+      end;
+  end;
+end;
+
+procedure TRxCustomDateRangeEdit.SetQuarter(AValue: word);
+begin
+
+end;
+
+procedure TRxCustomDateRangeEdit.SetYear(AValue: word);
+begin
+  FEditYear.Value:=AValue;
+end;
+
+procedure TRxCustomDateRangeEdit.InternalOnEditChange(Sender: TObject);
+begin
+  if FLockCount = 0 then
+    EditChange;
+end;
+
+procedure TRxCustomDateRangeEdit.InternalOnEditClick(Sender: TObject);
+begin
+  EditClick;
+end;
+
+procedure TRxCustomDateRangeEdit.InternalOnEditEnter(Sender: TObject);
+begin
+  EditEnter;
+end;
+
+procedure TRxCustomDateRangeEdit.InternalOnEditExit(Sender: TObject);
+begin
+  EditExit;
+end;
+
+procedure TRxCustomDateRangeEdit.Lock;
+begin
+  Inc(FLockCount);
+end;
+
+procedure TRxCustomDateRangeEdit.UnLock;
+begin
+  if FLockCount > 0 then
+    Dec(FLockCount)
+  else
+    InternalOnEditChange(Self);
+end;
+
+class function TRxCustomDateRangeEdit.GetControlClassDefaultSize: TSize;
+begin
+  Result.CX := 80 + 70 + 23 * 4;
+  Result.CY := 23;
+end;
+
+procedure TRxCustomDateRangeEdit.FillMonthNames;
+var
+  i: Integer;
+begin
+  FEditMonth.Items.BeginUpdate;
+  FEditMonth.Items.Clear;
+  if (reoMonth in FOptions) or (FOptions = []) then
+  begin
+    for i:=1 to 12 do
+      FEditMonth.Items.AddObject(DefaultFormatSettings.LongMonthNames[i], TObject(Pointer(i)));
+  end;
+
+  if (reoQuarter in FOptions) or (FOptions = []) then
+  begin
+    FEditMonth.Items.AddObject(sFirstQuarter, TObject(Pointer(13)));
+    FEditMonth.Items.AddObject(sSecondQuarter, TObject(Pointer(14)));
+    FEditMonth.Items.AddObject(sThirdQuarter, TObject(Pointer(15)));
+    FEditMonth.Items.AddObject(sFourthQuarter, TObject(Pointer(16)));
+  end;
+
+  if (reoHalfYear in FOptions) or (FOptions = []) then
+  begin
+    FEditMonth.Items.AddObject(sFirstHalfOfYear, TObject(Pointer(17)));
+    FEditMonth.Items.AddObject(sSecondHalfOfYear, TObject(Pointer(18)));
+  end;
+  FEditMonth.ItemIndex:=0;
+  FEditMonth.Items.EndUpdate;
+end;
+
+procedure TRxCustomDateRangeEdit.SetAutoSize(AValue: Boolean);
+begin
+  if AutoSize = AValue then
+    Exit;
+  inherited SetAutosize(AValue);
+  FEditMonth.AutoSize := AValue;
+  FEditYear.AutoSize := AValue;
+end;
+
+procedure TRxCustomDateRangeEdit.EditChange;
+begin
+  if Assigned(FOnEditChange) then FOnEditChange(Self);
+end;
+
+procedure TRxCustomDateRangeEdit.EditClick;
+begin
+  if Assigned(FOnEditClick) then FOnEditClick(Self);
+end;
+
+procedure TRxCustomDateRangeEdit.EditEnter;
+begin
+  if Assigned(FOnEditEnter) then FOnEditEnter(Self);
+end;
+
+procedure TRxCustomDateRangeEdit.EditExit;
+begin
+  if Assigned(FOnEditExit) then FOnEditExit(Self);
+end;
+
+constructor TRxCustomDateRangeEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FLockCount:=0;
+  FOptions:=[reoMonth];
+
+  FEditYear:=TSpinEdit.Create(Self);
+  FEditMonth:=TComboBox.Create(Self);
+  FEditMonth.Style:=csDropDownList;
+  FEditMonth.DropDownCount:=12;
+  FEditYear.Width:=70;
+  FEditMonth.Width:=100;
+
+  FsbDecYear:=TSpeedButton.Create(Self);
+  FsbDecMonth:=TSpeedButton.Create(Self);
+  FsbIncYear:=TSpeedButton.Create(Self);
+  FsbIncMonth:=TSpeedButton.Create(Self);
+
+  FsbDecYear.OnClick:=@DoDecYear;
+  FsbDecMonth.OnClick:=@DoDecMonth;
+  FsbIncYear.OnClick:=@DoIncYear;
+  FsbIncMonth.OnClick:=@DoIncMonth;
+
+
+  FEditYear.Parent:=Self;
+  FsbDecYear.Parent:=Self;
+  FsbDecMonth.Parent:=Self;
+  FsbIncYear.Parent:=Self;
+  FsbIncMonth.Parent:=Self;
+  FEditMonth.Parent:=Self;
+
+  FsbDecYear.Caption:='<<';
+  FsbDecMonth.Caption:='<';
+  FsbIncYear.Caption:='>>';
+  FsbIncMonth.Caption:='>';
+
+  FsbDecYear.Left:=0;
+  FsbDecMonth.Left:=23;
+  FEditMonth.Left:=46;
+  FEditYear.Left:=126;
+  FsbIncMonth.Left:=206;
+  FsbIncYear.Left:=229;
+
+
+  ControlStyle := ControlStyle + [csNoFocus];
+
+
+  FsbDecYear.Align:=alLeft;
+  FsbDecMonth.Align:=alLeft;
+  FsbIncYear.Align:=alRight;
+  FsbIncMonth.Align:=alRight;
+
+  FEditYear.Align:=alRight;
+  FEditMonth.Align:=alClient;
+
+  FEditYear.MaxValue:=9999;
+  with GetControlClassDefaultSize do
+    SetInitialBounds(0, 0, CX, CY);
+  FillMonthNames;
+
+  SetPeriod(Now);
+  AutoSize := True;
+
+  FEditMonth.OnChange:=@InternalOnEditChange;
+  FEditYear.OnChange:=@InternalOnEditChange;
+
+  FEditMonth.OnClick:=@InternalOnEditClick;
+  FEditYear.OnClick:=@InternalOnEditClick;
+
+  FEditMonth.OnEnter:=@InternalOnEditEnter;
+  FEditYear.OnEnter:=@InternalOnEditEnter;
+
+  FEditMonth.OnExit:=@InternalOnEditExit;
+  FEditYear.OnExit:=@InternalOnEditExit;
+end;
+
+destructor TRxCustomDateRangeEdit.Destroy;
+begin
+  inherited Destroy;
+end;
+
+end.
+

RXLib/rxcontrols/rxdice.inc

@@ -0,0 +1,431 @@
+type
+  TRxDiceBitmap  = array [0..68] of PChar;
+
+const
+  DICE1 : TRxDiceBitmap = (
+'64 64 4 1',
+'. c None',
+'# c #000000',
+'b c #c0c0c0',
+'a c #ffffff',
+'................................................................',
+'.............................######.............................',
+'...........................##########...........................',
+'.........................####aaaaaa####.........................',
+'.......................####aaaaaaaaaa####.......................',
+'.....................####aaaaaaaaaaaaaa####.....................',
+'...................####aaaaaaaaaaaaaaaaaa####...................',
+'.................####aaaaaaaaaaaaaaaaaaaaaa####.................',
+'...............####aaaaaaaaaaaaaaaaaaaaaaaaaa####...............',
+'.............####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.............',
+'...........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####...........',
+'.........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........',
+'.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.......',
+'.....####aaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaa####.....',
+'...####aaaaaaaaaaaaaaaaaaaaa########aaaaaaaaaaaaaaaaaaaaa####...',
+'.####aaaaaaaaaaaaaaaaaaaaaa##########aaaaaaaaaaaaaaaaaaaaaa####.',
+'#####aaaaaaaaaaaaaaaaaaaaaa##########aaaaaaaaaaaaaaaaaaaaaa#####',
+'##b####aaaaaaaaaaaaaaaaaaaaa########aaaaaaaaaaaaaaaaaaaaa####a##',
+'##bbb####aaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaa####aaa##',
+'##bbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaa##',
+'##bbbbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaa##',
+'##bbbbbbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaa###aaaa##',
+'##bbbbbbbbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaa####aaaa######aaa##',
+'##bbbbbbbbbbbbbbb####aaaaaaaaaaaaaaaaaaaaaa####aaaaaa######aaa##',
+'##bbbbbbbbbbbbbbbbb####aaaaaaaaaaaaaaaaaa####aaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbb####aaaaaaaaaaaaaa####aaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbb####aaaaaaaaaa####aaaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbb####aaaaaa####aaaaaaaaaaaaa######aaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbb####aa####aaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb###bbbb######aaaa###aaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaa#######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaa#######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbb###bbbb#######bbb##aaa#######aaaa###aaaaaaaaaaaa##',
+'##bbbbbbbbbbb######bbb######bbb##aaa######aaa######aaaaaaaaaaa##',
+'##bbbbbbbbbbb######bbbb####bbbb##aaaa####aaaa######aaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbbb###bbbb#######bbbbbbbbbbb##aaaaaaaaaaa#######aaaa###aaaa##',
+'##bbb######bbb######bbbbbbbbbbb##aaaaaaaaaaa######aaa######aaa##',
+'##bbb######bbbb####bbbbbbbbbbbb##aaaaaaaaaaaa####aaaa######aaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa#######aaa##',
+'##bbbb######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa######aaaa##',
+'###bbbb####bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaa####aaaa###',
+'.####bbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaa###aaaaaaaaaaaaaaaaa####.',
+'...####bbbbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaaaa####...',
+'.....####bbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaa####.....',
+'.......####bbbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaaa####.......',
+'.........####bbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaa####.........',
+'...........####bbbbbbbbbbbbbbbb##aaa#######aaaaaa####...........',
+'.............####bbbbbbbbbbbbbb##aaa######aaaaa####.............',
+'...............####bbbbbbbbbbbb##aaaa####aaaa####...............',
+'.................####bbbbbbbbbb##aaaaaaaaaa####.................',
+'...................####bbbbbbbb##aaaaaaaa####...................',
+'.....................####bbbbbb##aaaaaa####.....................',
+'.......................####bbbb##aaaa####.......................',
+'.........................####bb##aa####.........................',
+'...........................##########...........................',
+'..............................####..............................',
+'................................................................');
+
+
+  DICE2 : TRxDiceBitmap = (
+'64 64 4 1',
+'. c None',
+'# c #000000',
+'b c #c0c0c0',
+'a c #ffffff',
+'................................................................',
+'.............................######.............................',
+'...........................##########...........................',
+'.........................####aaaaaa####.........................',
+'.......................####aaaaaaaaaa####.......................',
+'.....................####aaaaa####aaaaa####.....................',
+'...................####aaaaa########aaaaa####...................',
+'.................####aaaaaa##########aaaaaa####.................',
+'...............####aaaaaaaa##########aaaaaaaa####...............',
+'.............####aaaaaaaaaaa########aaaaaaaaaaa####.............',
+'...........####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####...........',
+'.........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........',
+'.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.......',
+'.....####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.....',
+'...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####...',
+'.####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.',
+'#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####',
+'##b####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####a##',
+'##bbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaa##',
+'##bbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaa##',
+'##bbbbbbbbb####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####aaaaaaaaa##',
+'##bbbbbbbbbbb####aaaaaaaaaaa########aaaaaaaaaaa####aaaa###aaaa##',
+'##bbbbbbbbbbbbb####aaaaaaaa##########aaaaaaaa####aaaa######aaa##',
+'##bbbbbbbbbbbbbbb####aaaaaa##########aaaaaa####aaaaaa######aaa##',
+'##bbbbbbbbbbbbbbbbb####aaaaa########aaaaa####aaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbb####aaaaa####aaaaa####aaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbb####aaaaaaaaaa####aaaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbb####aaaaaa####aaaaaaaaaaaaa######aaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbb####aa####aaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbb######aaaa###aaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbb###bbbbbbbbbbbbbb##aaa#######aaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbb######bbbbbbbbbbbb##aaa######aaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbb######bbbbbbbbbbbb##aaaa####aaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaa###aaaa##',
+'##bbbbbbbbbbbb######bbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaa######aaa##',
+'##bbbbbbbbbbbbb####bbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaa######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaa######aaaa##',
+'###bbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaa####aaaa###',
+'.####bbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaa###aaaaaaaaaaaaaaaaa####.',
+'...####bbbbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaaaa####...',
+'.....####bbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaa####.....',
+'.......####bbbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaaa####.......',
+'.........####bbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaa####.........',
+'...........####bbbbbbbbbbbbbbbb##aaa#######aaaaaa####...........',
+'.............####bbbbbbbbbbbbbb##aaa######aaaaa####.............',
+'...............####bbbbbbbbbbbb##aaaa####aaaa####...............',
+'.................####bbbbbbbbbb##aaaaaaaaaa####.................',
+'...................####bbbbbbbb##aaaaaaaa####...................',
+'.....................####bbbbbb##aaaaaa####.....................',
+'.......................####bbbb##aaaa####.......................',
+'.........................####bb##aa####.........................',
+'...........................##########...........................',
+'..............................####..............................',
+'................................................................');
+
+  DICE3 : TRxDiceBitmap = (
+'64 64 4 1',
+'. c None',
+'# c #000000',
+'b c #c0c0c0',
+'a c #ffffff',
+'................................................................',
+'.............................######.............................',
+'...........................##########...........................',
+'.........................####aaaaaa####.........................',
+'.......................####aaaaaaaaaa####.......................',
+'.....................####aaaaa####aaaaa####.....................',
+'...................####aaaaa########aaaaa####...................',
+'.................####aaaaaa##########aaaaaa####.................',
+'...............####aaaaaaaa##########aaaaaaaa####...............',
+'.............####aaaaaaaaaaa########aaaaaaaaaaa####.............',
+'...........####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####...........',
+'.........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........',
+'.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.......',
+'.....####aaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaa####.....',
+'...####aaaaaaaaaaaaaaaaaaaaa########aaaaaaaaaaaaaaaaaaaaa####...',
+'.####aaaaaaaaaaaaaaaaaaaaaa##########aaaaaaaaaaaaaaaaaaaaaa####.',
+'#####aaaaaaaaaaaaaaaaaaaaaa##########aaaaaaaaaaaaaaaaaaaaaa#####',
+'##b####aaaaaaaaaaaaaaaaaaaaa########aaaaaaaaaaaaaaaaaaaaa####a##',
+'##bbb####aaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaa####aaa##',
+'##bbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaa##',
+'##bbbbbbbbb####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####aaaaaaaaa##',
+'##bbbbbbbbbbb####aaaaaaaaaaa########aaaaaaaaaaa####aaaa###aaaa##',
+'##bbbbbbbbbbbbb####aaaaaaaa##########aaaaaaaa####aaaa######aaa##',
+'##bbbbbbbbbbbbbbb####aaaaaa##########aaaaaa####aaaaaa######aaa##',
+'##bbbbbbbbbbbbbbbbb####aaaaa########aaaaa####aaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbb####aaaaa####aaaaa####aaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbb####aaaaaaaaaa####aaaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbb####aaaaaa####aaaaaaaaaaaaa######aaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbb####aa####aaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb###bbbb######aaaa###aaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaa###aaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaa######aaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaa#######aaaaaaaaaa######aaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaa#######aaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaa#######aaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbb######bbb##aaa######aaaaaaaaaa#######aaa##',
+'##bbbbbbbbbbbbbbbbbbbbb####bbbb##aaaa####aaaaaaaaaaa######aaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaa###aaaaaaaaaaaaaaaaaaaa##',
+'##bbbb###bbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaa###aaaa##',
+'##bbb######bbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaa######aaa##',
+'##bbb######bbbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaaa######aaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaa######aaaaaaaaaa#######aaa##',
+'##bbbb######bbbbbbbbbbbbbbbbbbb##aaaa####aaaaaaaaaaa######aaaa##',
+'###bbbb####bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaa####aaaa###',
+'.####bbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaa###aaaaaaaaaaaaaaaaa####.',
+'...####bbbbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaaaa####...',
+'.....####bbbbbbbbbbbbbbbbbbbbbb##aaaa######aaaaaaaaaaaa####.....',
+'.......####bbbbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaaaa####.......',
+'.........####bbbbbbbbbbbbbbbbbb##aaa#######aaaaaaaa####.........',
+'...........####bbbbbbbbbbbbbbbb##aaa#######aaaaaa####...........',
+'.............####bbbbbbbbbbbbbb##aaa######aaaaa####.............',
+'...............####bbbbbbbbbbbb##aaaa####aaaa####...............',
+'.................####bbbbbbbbbb##aaaaaaaaaa####.................',
+'...................####bbbbbbbb##aaaaaaaa####...................',
+'.....................####bbbbbb##aaaaaa####.....................',
+'.......................####bbbb##aaaa####.......................',
+'.........................####bb##aa####.........................',
+'...........................##########...........................',
+'..............................####..............................',
+'................................................................');
+
+
+  DICE4 : TRxDiceBitmap = (
+'64 64 4 1',
+'. c None',
+'# c #000000',
+'b c #c0c0c0',
+'a c #ffffff',
+'................................................................',
+'.............................######.............................',
+'...........................##########...........................',
+'.........................####aaaaaa####.........................',
+'.......................####aaaaaaaaaa####.......................',
+'.....................####aaaaa####aaaaa####.....................',
+'...................####aaaaa########aaaaa####...................',
+'.................####aaaaaa##########aaaaaa####.................',
+'...............####aaaaaaaa##########aaaaaaaa####...............',
+'.............####aaaaaaaaaaa########aaaaaaaaaaa####.............',
+'...........####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####...........',
+'.........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........',
+'.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.......',
+'.....####aaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa####.....',
+'...####aaaaa########aaaaaaaaaaaaaaaaaaaaaaaa########aaaaa####...',
+'.####aaaaaa##########aaaaaaaaaaaaaaaaaaaaaa##########aaaaaa####.',
+'#####aaaaaa##########aaaaaaaaaaaaaaaaaaaaaa##########aaaaaa#####',
+'##b####aaaaa########aaaaaaaaaaaaaaaaaaaaaaaa########aaaaa####a##',
+'##bbb####aaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa####aaa##',
+'##bbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaa##',
+'##bbbbbbbbb####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####aaaaaaaaa##',
+'##bbbb###bbbb####aaaaaaaaaaa########aaaaaaaaaaa####aaaa###aaaa##',
+'##bbb######bbbb####aaaaaaaa##########aaaaaaaa####aaaa######aaa##',
+'##bbb######bbbbbb####aaaaaa##########aaaaaa####aaaaaa######aaa##',
+'##bbb#######bbbbbbb####aaaaa########aaaaa####aaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbb####aaaaa####aaaaa####aaaaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbbbb####aaaaaaaaaa####aaaaaaaaaaa#######aaa##',
+'##bbbb######bbbbbbbbbbbbb####aaaaaa####aaaaaaaaaaaaa######aaaa##',
+'##bbbbb####bbbbbbbbbbbbbbbb####aa####aaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb###bbbb######aaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb###bbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb######bbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb######bbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbb######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb######bbbbbbbbbbb####bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbb####bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb###bbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb###bbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb######bbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb######bbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbb######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb######bbbbbbbbbbb####bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'###bbbb####bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaa###',
+'.####bbbbbbbbbbbbbbbbb###bbbbbb##aaaaaa###aaaaaaaaaaaaaaaaa####.',
+'...####bbbbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaaaa####...',
+'.....####bbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaa####.....',
+'.......####bbbbbbbbbb#######bbb##aaa#######aaaaaaaaaa####.......',
+'.........####bbbbbbbb#######bbb##aaa#######aaaaaaaa####.........',
+'...........####bbbbbb#######bbb##aaa#######aaaaaa####...........',
+'.............####bbbbb######bbb##aaa######aaaaa####.............',
+'...............####bbbb####bbbb##aaaa####aaaa####...............',
+'.................####bbbbbbbbbb##aaaaaaaaaa####.................',
+'...................####bbbbbbbb##aaaaaaaa####...................',
+'.....................####bbbbbb##aaaaaa####.....................',
+'.......................####bbbb##aaaa####.......................',
+'.........................####bb##aa####.........................',
+'...........................##########...........................',
+'..............................####..............................',
+'................................................................');
+
+  DICE5 : TRxDiceBitmap = (
+'64 64 4 1',
+'. c None',
+'# c #000000',
+'b c #c0c0c0',
+'a c #ffffff',
+'................................................................',
+'.............................######.............................',
+'...........................##########...........................',
+'.........................####aaaaaa####.........................',
+'.......................####aaaaaaaaaa####.......................',
+'.....................####aaaaa####aaaaa####.....................',
+'...................####aaaaa########aaaaa####...................',
+'.................####aaaaaa##########aaaaaa####.................',
+'...............####aaaaaaaa##########aaaaaaaa####...............',
+'.............####aaaaaaaaaaa########aaaaaaaaaaa####.............',
+'...........####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####...........',
+'.........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........',
+'.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.......',
+'.....####aaaaa####aaaaaaaaaaaa####aaaaaaaaaaaa####aaaaa####.....',
+'...####aaaaa########aaaaaaaa########aaaaaaaa########aaaaa####...',
+'.####aaaaaa##########aaaaaa##########aaaaaa##########aaaaaa####.',
+'#####aaaaaa##########aaaaaa##########aaaaaa##########aaaaaa#####',
+'##b####aaaaa########aaaaaaaa########aaaaaaaa########aaaaa####a##',
+'##bbb####aaaaa####aaaaaaaaaaaa####aaaaaaaaaaaa####aaaaa####aaa##',
+'##bbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbb####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaa##',
+'##bbbbbbbbb####aaaaaaaaaaaaaaa####aaaaaaaaaaaaaaa####aaaaaaaaa##',
+'##bbbb###bbbb####aaaaaaaaaaa########aaaaaaaaaaa####aaaaaaaaaaa##',
+'##bbb######bbbb####aaaaaaaa##########aaaaaaaa####aaaaaaaaaaaaa##',
+'##bbb######bbbbbb####aaaaaa##########aaaaaa####aaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbb####aaaaa########aaaaa####aaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbb####aaaaa####aaaaa####aaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbb####aaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb######bbbbbbbbbbbbb####aaaaaa####aaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbb####bbbbbbbbbbbbbbbb####aa####aaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb###bbbb######aaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaaaaaaaaaaaaa###aaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb######bbb##aaaaaaaaaaaa######aaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbb####bbbb##aaaaaaaaaaaa######aaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbbb###bbbbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbb######bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaa######aaaaaaaaaaaa##',
+'##bbb######bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaa####aaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'###bbbb####bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaa###',
+'.####bbbbbbbbbbbbbbbbb###bbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaa####.',
+'...####bbbbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaa####...',
+'.....####bbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaa####.....',
+'.......####bbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaa####.......',
+'.........####bbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaa####.........',
+'...........####bbbbbb#######bbb##aaaaaaaaaaaaaaaa####...........',
+'.............####bbbbb######bbb##aaaaaaaaaaaaaa####.............',
+'...............####bbbb####bbbb##aaaaaaaaaaaa####...............',
+'.................####bbbbbbbbbb##aaaaaaaaaa####.................',
+'...................####bbbbbbbb##aaaaaaaa####...................',
+'.....................####bbbbbb##aaaaaa####.....................',
+'.......................####bbbb##aaaa####.......................',
+'.........................####bb##aa####.........................',
+'...........................##########...........................',
+'..............................####..............................',
+'................................................................');
+
+  DICE6 : TRxDiceBitmap = (
+'64 64 4 1',
+'. c None',
+'# c #000000',
+'b c #c0c0c0',
+'a c #ffffff',
+'................................................................',
+'.............................######.............................',
+'...........................##########...........................',
+'.........................####aaaaaa####.........................',
+'.......................####aaaaaaaaaa####.......................',
+'.....................####aaaaa####aaaaa####.....................',
+'...................####aaaaa########aaaaa####...................',
+'.................####aaaaaa##########aaaaaa####.................',
+'...............####aaaaaaaa##########aaaaaaaa####...............',
+'.............####aaaaaaaaaaa########aa####aaaaa####.............',
+'...........####aaaaaaaaaaaaaaa####aa########aaaaa####...........',
+'.........####aaaaaaaaaaaaaaaaaaaaaa##########aaaaaa####.........',
+'.......####aaaaaaaaaaaaaaaaaaaaaaaa##########aaaaaaaa####.......',
+'.....####aaaaa####aaaaaaaaaaaaaaaaaa########aa####aaaaa####.....',
+'...####aaaaa########aaaaaaaaaaaaaaaaaa####aa########aaaaa####...',
+'.####aaaaaa##########aaaaaaaaaaaaaaaaaaaaaa##########aaaaaa####.',
+'#####aaaaaa##########aaaaaaaaaaaaaaaaaaaaaa##########aaaaaa#####',
+'##b####aaaaa########aa####aaaaaaaaaaaaaaaaaa########aaaaa####a##',
+'##bbb####aaaaa####aa########aaaaaaaaaaaaaaaaaa####aaaaa####aaa##',
+'##bbbbb####aaaaaaaa##########aaaaaaaaaaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbb####aaaaaa##########aaaaaaaaaaaaaaaaaaaaaa####aaaaaaa##',
+'##bbbbbbbbb####aaaaa########aa####aaaaaaaaaaaaaaa####aaaaaaaaa##',
+'##bbbb###bbbb####aaaaa####aa########aaaaaaaaaaa####aaaa###aaaa##',
+'##bbb######bbbb####aaaaaaaa##########aaaaaaaa####aaaa######aaa##',
+'##bbb######bbbbbb####aaaaaa##########aaaaaa####aaaaaa######aaa##',
+'##bbb#######bbbbbbb####aaaaa########aaaaa####aaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbb####aaaaa####aaaaa####aaaaaaaaa#######aaa##',
+'##bbb#######bbbbbbbbbbb####aaaaaaaaaa####aaaaaaaaaaa#######aaa##',
+'##bbbb######bbbbbbbbbbbbb####aaaaaa####aaaaaaaaaaaaa######aaaa##',
+'##bbbbb####bbbbbbbbbbbbbbbb####aa####aaaaaaaaaaaaaaaa####aaaaa##',
+'##bbbbbbbbbbbbbbbbbbbb###bbbb######aaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb######bbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbbbbbbbbb#######bbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbbbbbbbbbb###bbbb#######bbb##aaaaaaaaaaaaaa###aaaaaaaaaaaa##',
+'##bbbbbbbbbbb######bbb######bbb##aaaaaaaaaaaa######aaaaaaaaaaa##',
+'##bbbbbbbbbbb######bbbb####bbbb##aaaaaaaaaaaa######aaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbbbbbbbbbb#######bbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbbb###bbbb#######bbbbbbbbbbb##aaaaaaaaaaa#######aaaaaaaaaaa##',
+'##bbb######bbb######bbbbbbbbbbb##aaaaaaaaaaa######aaaaaaaaaaaa##',
+'##bbb######bbbb####bbbbbbbbbbbb##aaaaaaaaaaaa####aaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbb#######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'##bbbb######bbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##',
+'###bbbb####bbbbbbbbbbbbbbbbbbbb##aaaaaaaaaaaaaaaaaaaaaaaaaaaa###',
+'.####bbbbbbbbbbbbbbbbb###bbbbbb##aaaaaa###aaaaaaaaaaaaaaaaa####.',
+'...####bbbbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaaaa####...',
+'.....####bbbbbbbbbbbb######bbbb##aaaa######aaaaaaaaaaaa####.....',
+'.......####bbbbbbbbbb#######bbb##aaa#######aaaaaaaaaa####.......',
+'.........####bbbbbbbb#######bbb##aaa#######aaaaaaaa####.........',
+'...........####bbbbbb#######bbb##aaa#######aaaaaa####...........',
+'.............####bbbbb######bbb##aaa######aaaaa####.............',
+'...............####bbbb####bbbb##aaaa####aaaa####...............',
+'.................####bbbbbbbbbb##aaaaaaaaaa####.................',
+'...................####bbbbbbbb##aaaaaaaa####...................',
+'.....................####bbbbbb##aaaaaa####.....................',
+'.......................####bbbb##aaaa####.......................',
+'.........................####bb##aa####.........................',
+'...........................##########...........................',
+'..............................####..............................',
+'................................................................');

RXLib/rxcontrols/rxdice.pas

@@ -0,0 +1,382 @@
+{ rxdice 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 rxdice;
+
+interface
+
+{$I rx.inc}
+
+uses SysUtils, LCLType, LCLProc, LCLIntf, LMessages, Classes, Graphics,
+  Controls, Forms, StdCtrls, ExtCtrls, Menus, rxlclutils;
+
+type
+  TRxDiceValue = 1..6;
+
+{ TRxDice }
+
+  TRxDice = class(TCustomControl)
+  private
+    { Private declarations }
+    FActive: Boolean;
+    FAutoSize: Boolean;
+    FBitmap: TBitmap;
+    FInterval: Cardinal;
+    FAutoStopInterval: Cardinal;
+    FOnChange: TNotifyEvent;
+    FRotate: Boolean;
+    FShowFocus: Boolean;
+    FTimer: TTimer;
+    FTickCount: Longint;
+    FValue: TRxDiceValue;
+    FOnStart: TNotifyEvent;
+    FOnStop: TNotifyEvent;
+    procedure CMFocusChanged(var Message: TLMessage); message CM_FOCUSCHANGED;
+    procedure WMSize(var Message: TLMSize); message LM_SIZE;
+    procedure CreateBitmap;
+    procedure SetAutoSize(Value: Boolean);
+    procedure SetInterval(Value: Cardinal);
+    procedure SetRotate(AValue: Boolean);
+    procedure SetShowFocus(AValue: Boolean);
+    procedure SetValue(Value: TRxDiceValue);
+    procedure TimerExpired(Sender: TObject);
+  protected
+    { Protected declarations }
+    function GetPalette: HPALETTE; override;
+    procedure AdjustSize; override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+      X, Y: Integer); override;
+    procedure Paint; override;
+    procedure Change; dynamic;
+    procedure DoStart; dynamic;
+    procedure DoStop; dynamic;
+  public
+    { Public declarations }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure RandomValue;
+  published
+    { Published declarations }
+    property Align;
+    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
+    property AutoStopInterval: Cardinal read FAutoStopInterval write FAutoStopInterval default 0;
+    property Color;
+    property Cursor;
+    property DragMode;
+    property DragCursor;
+    property Enabled;
+    property Interval: Cardinal read FInterval write SetInterval default 60;
+    property ParentColor;
+    property ParentShowHint;
+    property PopupMenu;
+    property Rotate: Boolean read FRotate write SetRotate;
+    property ShowFocus: Boolean read FShowFocus write SetShowFocus;
+    property ShowHint;
+    property Anchors;
+    property Constraints;
+    property DragKind;
+    property TabOrder;
+    property TabStop;
+    property Value: TRxDiceValue read FValue write SetValue default 1;
+    property Visible;
+    property OnClick;
+    property OnDblClick;
+    property OnEnter;
+    property OnExit;
+    property OnMouseMove;
+    property OnMouseDown;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnKeyDown;
+    property OnKeyUp;
+    property OnKeyPress;
+    property OnDragOver;
+    property OnDragDrop;
+    property OnEndDrag;
+    property OnStartDrag;
+    property OnContextPopup;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnStart: TNotifyEvent read FOnStart write FOnStart;
+    property OnStop: TNotifyEvent read FOnStop write FOnStop;
+    property OnEndDock;
+    property OnStartDock;
+  end;
+
+{$I RXDICE.INC}
+
+implementation
+
+{ TRxDice }
+
+constructor TRxDice.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Randomize;
+  ControlStyle := [csClickEvents, csSetCaption, csCaptureMouse,
+    csOpaque, csDoubleClicks];
+  FValue := 1;
+  FInterval := 60;
+  CreateBitmap;
+  FAutoSize := True;
+  Width := FBitmap.Width + 2;
+  Height := FBitmap.Height + 2;
+end;
+
+destructor TRxDice.Destroy;
+begin
+  FOnChange := nil;
+  if FBitmap <> nil then FBitmap.Free;
+  inherited Destroy;
+end;
+
+function TRxDice.GetPalette: HPALETTE;
+begin
+  if FBitmap <> nil then Result := FBitmap.Palette
+  else Result := 0;
+end;
+
+procedure TRxDice.RandomValue;
+var
+  Val: Byte;
+begin
+  Val := Random(6) + 1;
+  if Val = Byte(FValue) then
+  begin
+    if Val = 1 then Inc(Val)
+    else Dec(Val);
+  end;
+  SetValue(TRxDiceValue(Val));
+end;
+
+procedure TRxDice.DoStart;
+begin
+  if Assigned(FOnStart) then FOnStart(Self);
+end;
+
+procedure TRxDice.DoStop;
+begin
+  if Assigned(FOnStop) then FOnStop(Self);
+end;
+
+procedure TRxDice.CMFocusChanged(var Message: TLMessage);
+var
+  Active: Boolean;
+begin
+{  with Message do Active := (Sender = Self);
+  if Active <> FActive then begin
+    FActive := Active;
+    if FShowFocus then Invalidate;
+  end;}
+  inherited;
+end;
+
+procedure TRxDice.WMSize(var Message: TLMSize);
+begin
+  inherited;
+  AdjustSize;
+end;
+
+procedure TRxDice.CreateBitmap;
+begin
+  if FBitmap = nil then FBitmap := TBitmap.Create;
+  case FValue of
+    1:FBitmap.Handle := CreatePixmapIndirect(@DICE1[0], GetSysColor(COLOR_BTNFACE));
+    2:FBitmap.Handle := CreatePixmapIndirect(@DICE2[0], GetSysColor(COLOR_BTNFACE));
+    3:FBitmap.Handle := CreatePixmapIndirect(@DICE3[0], GetSysColor(COLOR_BTNFACE));
+    4:FBitmap.Handle := CreatePixmapIndirect(@DICE4[0], GetSysColor(COLOR_BTNFACE));
+    5:FBitmap.Handle := CreatePixmapIndirect(@DICE5[0], GetSysColor(COLOR_BTNFACE));
+    6:FBitmap.Handle := CreatePixmapIndirect(@DICE6[0], GetSysColor(COLOR_BTNFACE));
+  end;
+end;
+
+procedure TRxDice.AdjustSize;
+var
+  MinSide: Integer;
+begin
+  if not (csReading in ComponentState) then
+  begin
+    if AutoSize and Assigned(FBitmap) and (FBitmap.Width > 0) and
+      (FBitmap.Height > 0) then
+        SetBounds(Left, Top, FBitmap.Width + 2, FBitmap.Height + 2)
+    else
+    begin
+      { Adjust aspect ratio if control size changed }
+      MinSide := Width;
+      if Height < Width then MinSide := Height;
+      SetBounds(Left, Top, MinSide, MinSide);
+    end;
+  end;
+end;
+
+procedure TRxDice.MouseDown(Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  if (Button = mbLeft) and TabStop and CanFocus then SetFocus;
+  inherited MouseDown(Button, Shift, X, Y);
+end;
+
+procedure TRxDice.Paint;
+var
+  ARect: TRect;
+
+  procedure DrawBitmap;
+  var
+    TmpImage: TBitmap;
+    IWidth, IHeight: Integer;
+    IRect: TRect;
+  begin
+    IWidth := FBitmap.Width;
+    IHeight := FBitmap.Height;
+    IRect := Rect(0, 0, IWidth, IHeight);
+    TmpImage := TBitmap.Create;
+    try
+      TmpImage.Width := IWidth;
+      TmpImage.Height := IHeight;
+      TmpImage.Canvas.Brush.Color := Self.Brush.Color;
+//      TmpImage.Canvas.BrushCopy(IRect, FBitmap, IRect, FBitmap.TransparentColor);
+      InflateRect(ARect, -1, -1);
+//      Canvas.StretchDraw(ARect, TmpImage);
+      Canvas.StretchDraw(ARect, FBitmap);
+
+    finally
+      TmpImage.Free;
+    end;
+  end;
+
+begin
+  ARect := ClientRect;
+  if FBitmap <> nil then DrawBitmap;
+{  if Focused and FShowFocus and TabStop and not (csDesigning in ComponentState) then
+  begin
+    Canvas.DrawFocusRect(ARect);
+  end;}
+end;
+
+procedure TRxDice.TimerExpired(Sender: TObject);
+var
+  ParentForm: TCustomForm;
+  Now: Longint;
+begin
+  RandomValue;
+  if not FRotate then
+  begin
+    FTimer.Free;
+    FTimer := nil;
+    if (csDesigning in ComponentState) then
+    begin
+      ParentForm := GetParentForm(Self);
+      if ParentForm <> nil then ParentForm.Designer.Modified;
+    end;
+    DoStop;
+  end
+  else
+  if AutoStopInterval > 0 then
+  begin
+    Now := GetTickCount;
+    if (Now - FTickCount >= AutoStopInterval) or (Now < FTickCount) then
+      Rotate := False;
+  end;
+end;
+
+procedure TRxDice.Change;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TRxDice.SetValue(Value: TRxDiceValue);
+begin
+  if FValue <> Value then
+  begin
+    FValue := Value;
+    CreateBitmap;
+    Invalidate;
+    Change;
+  end;
+end;
+
+procedure TRxDice.SetAutoSize(Value: Boolean);
+begin
+  if Value <> FAutoSize then
+  begin
+    FAutoSize := Value;
+    AdjustSize;
+    Invalidate;
+  end;
+end;
+
+procedure TRxDice.SetInterval(Value: Cardinal);
+begin
+  if FInterval <> Value then
+  begin
+    FInterval := Value;
+    if FTimer <> nil then FTimer.Interval := FInterval;
+  end;
+end;
+
+procedure TRxDice.SetRotate(AValue: Boolean);
+begin
+  if FRotate <> AValue then
+  begin
+    if AValue then
+    begin
+      if FTimer = nil then FTimer := TTimer.Create(Self);
+      try
+        with FTimer do
+        begin
+          OnTimer := @TimerExpired;
+          Interval := FInterval;
+          Enabled := True;
+        end;
+        FRotate := AValue;
+        FTickCount := GetTickCount;
+        DoStart;
+      except
+        FTimer.Free;
+        FTimer := nil;
+        raise;
+      end;
+    end
+    else
+      FRotate := AValue;
+  end;
+end;
+
+procedure TRxDice.SetShowFocus(AValue: Boolean);
+begin
+  if FShowFocus <> AValue then
+  begin
+    FShowFocus := AValue;
+    if not (csDesigning in ComponentState) then Invalidate;
+  end;
+end;
+
+end.

RXLib/rxcontrols/rxduallist.pas

@@ -0,0 +1,188 @@
+{ duallist 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 rxduallist;
+
+interface
+
+{$I rx.inc}
+
+uses Classes, Controls;
+
+type
+
+{ TDualListDialog }
+
+  TDualListDialog = class(TComponent)
+  private
+    FCtl3D: Boolean;
+    FSorted: Boolean;
+    FTitle:string;
+    FLabel1Caption: TCaption;
+    FLabel2Caption: TCaption;
+    FOkBtnCaption: TCaption;
+    FCancelBtnCaption: TCaption;
+    FHelpBtnCaption: TCaption;
+    FHelpContext: THelpContext;
+    FList1: TStrings;
+    FList2: TStrings;
+    FShowHelp: Boolean;
+    procedure SetList1(Value: TStrings);
+    procedure SetList2(Value: TStrings);
+    function IsLabel1Custom: Boolean;
+    function IsLabel2Custom: Boolean;
+    function IsOkBtnCustom: Boolean;
+    function IsCancelBtnCustom: Boolean;
+    function IsHelpBtnCustom: Boolean;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function Execute: Boolean;
+  published
+    property Ctl3D: Boolean read FCtl3D write FCtl3D default True;
+    property Sorted: Boolean read FSorted write FSorted;
+    property Title: string read FTitle write FTitle;
+    property Label1Caption: TCaption read FLabel1Caption write FLabel1Caption
+      stored IsLabel1Custom;
+    property Label2Caption: TCaption read FLabel2Caption write FLabel2Caption
+      stored IsLabel2Custom;
+    property OkBtnCaption: TCaption read FOkBtnCaption write FOkBtnCaption
+      stored IsOkBtnCustom;
+    property CancelBtnCaption: TCaption read FCancelBtnCaption write FCancelBtnCaption
+      stored IsCancelBtnCustom;
+    property HelpBtnCaption: TCaption read FHelpBtnCaption write FHelpBtnCaption
+      stored IsHelpBtnCustom;
+    property HelpContext: THelpContext read FHelpContext write FHelpContext;
+    property List1: TStrings read FList1 write SetList1;
+    property List2: TStrings read FList2 write SetList2;
+    property ShowHelp: Boolean read FShowHelp write FShowHelp default True;
+  end;
+
+implementation
+
+uses SysUtils, Forms, rxfduallst, LCLStrConsts, rxconst;
+
+{ TDualListDialog }
+
+constructor TDualListDialog.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FCtl3D := True;
+  FShowHelp := True;
+  FList1 := TStringList.Create;
+  FList2 := TStringList.Create;
+  FLabel1Caption := SDualListSrcCaption;
+  FLabel2Caption := SDualListDestCaption;
+  OkBtnCaption := rsmbOK;
+  CancelBtnCaption := rsmbCancel;
+  HelpBtnCaption := rsmbHelp;
+  Title:=SDualListCaption;
+end;
+
+destructor TDualListDialog.Destroy;
+begin
+  List1.Free;
+  List2.Free;
+  inherited Destroy;
+end;
+
+procedure TDualListDialog.SetList1(Value: TStrings);
+begin
+  FList1.Assign(Value);
+end;
+
+procedure TDualListDialog.SetList2(Value: TStrings);
+begin
+  FList2.Assign(Value);
+end;
+
+function TDualListDialog.IsLabel1Custom: Boolean;
+begin
+  Result := CompareStr(Label1Caption, SDualListSrcCaption) <> 0;
+end;
+
+function TDualListDialog.IsLabel2Custom: Boolean;
+begin
+  Result := CompareStr(Label2Caption, SDualListDestCaption) <> 0;
+end;
+
+function TDualListDialog.IsOkBtnCustom: Boolean;
+begin
+  Result := CompareStr(OkBtnCaption, rsmbOK) <> 0;
+end;
+
+function TDualListDialog.IsCancelBtnCustom: Boolean;
+begin
+  Result := CompareStr(CancelBtnCaption, rsmbCancel) <> 0;
+end;
+
+function TDualListDialog.IsHelpBtnCustom: Boolean;
+begin
+  Result := CompareStr(HelpBtnCaption, rsmbHelp) <> 0;
+end;
+
+function TDualListDialog.Execute: Boolean;
+var
+  Form: TDualListForm;
+begin
+  Form := TDualListForm.Create(Application);
+  try
+    with Form do
+    begin
+      Ctl3D := Self.Ctl3D;
+      if NewStyleControls then Font.Style := [];
+      ShowHelp := Self.ShowHelp;
+      SrcList.Sorted := Sorted;
+      DstList.Sorted := Sorted;
+      SrcList.Items := List1;
+      DstList.Items := List2;
+      if Self.Title <> '' then Form.Caption := Self.Title;
+      if Label1Caption <> '' then SrcLabel.Caption := Label1Caption;
+      if Label2Caption <> '' then DstLabel.Caption := Label2Caption;
+      ButtonPanel1.OKButton.Caption := OkBtnCaption;
+      ButtonPanel1.CancelButton.Caption := CancelBtnCaption;
+      ButtonPanel1.HelpButton.Caption := HelpBtnCaption;
+
+      HelpContext := Self.HelpContext;
+      ButtonPanel1.HelpButton.HelpContext := HelpContext;
+    end;
+    Result := (Form.ShowModal = mrOk);
+    if Result then
+    begin
+      List1 := Form.SrcList.Items;
+      List2 := Form.DstList.Items;
+    end;
+  finally
+    Form.Free;
+  end;
+end;
+
+end.

RXLib/rxcontrols/rxfduallst.lfm

@@ -0,0 +1,191 @@
+object DualListForm: TDualListForm
+  Left = 916
+  Height = 344
+  Top = 266
+  Width = 552
+  ActiveControl = IncBtn
+  BorderIcons = []
+  Caption = 'DualListForm'
+  ClientHeight = 344
+  ClientWidth = 552
+  OnActivate = ListClick
+  OnShow = ListClick
+  Position = poScreenCenter
+  LCLVersion = '1.5'
+  object SrcLabel: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    Left = 6
+    Height = 21
+    Top = 6
+    Width = 45
+    BorderSpacing.Left = 6
+    BorderSpacing.Top = 6
+    Caption = 'Source'
+    ParentColor = False
+  end
+  object DstLabel: TLabel
+    AnchorSideLeft.Control = DstList
+    AnchorSideTop.Control = Owner
+    Left = 299
+    Height = 21
+    Top = 6
+    Width = 31
+    BorderSpacing.Top = 6
+    Caption = 'Dest'
+    ParentColor = False
+  end
+  object SrcList: TListBox
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = SrcLabel
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = IncAllBtn
+    AnchorSideBottom.Control = ButtonPanel1
+    Left = 6
+    Height = 257
+    Top = 33
+    Width = 247
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Around = 6
+    DragMode = dmAutomatic
+    ItemHeight = 0
+    MultiSelect = True
+    OnClick = ListClick
+    OnDblClick = IncBtnClick
+    OnDragDrop = SrcListDragDrop
+    OnDragOver = SrcListDragOver
+    OnKeyDown = SrcListKeyDown
+    ParentShowHint = False
+    ScrollWidth = 245
+    ShowHint = True
+    Sorted = True
+    TabOrder = 0
+    TopIndex = -1
+  end
+  object DstList: TListBox
+    AnchorSideLeft.Control = IncAllBtn
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = DstLabel
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = ButtonPanel1
+    Left = 299
+    Height = 257
+    Top = 33
+    Width = 247
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Around = 6
+    DragMode = dmAutomatic
+    ItemHeight = 0
+    MultiSelect = True
+    OnClick = ListClick
+    OnDblClick = ExclBtnClick
+    OnDragDrop = DstListDragDrop
+    OnDragOver = DstListDragOver
+    OnKeyDown = DstListKeyDown
+    ParentShowHint = False
+    ScrollWidth = 245
+    ShowHint = True
+    Sorted = True
+    TabOrder = 5
+    TopIndex = -1
+  end
+  object IncBtn: TButton
+    AnchorSideLeft.Control = IncAllBtn
+    AnchorSideTop.Control = SrcList
+    AnchorSideRight.Control = IncAllBtn
+    AnchorSideRight.Side = asrBottom
+    Left = 259
+    Height = 41
+    Top = 39
+    Width = 34
+    Anchors = [akTop, akLeft, akRight]
+    AutoSize = True
+    BorderSpacing.Top = 6
+    BorderSpacing.InnerBorder = 4
+    Caption = '>'
+    Font.Color = clBlack
+    Font.Style = [fsBold]
+    OnClick = IncBtnClick
+    ParentFont = False
+    TabOrder = 1
+  end
+  object IncAllBtn: TButton
+    AnchorSideLeft.Control = Owner
+    AnchorSideLeft.Side = asrCenter
+    AnchorSideTop.Control = IncBtn
+    AnchorSideTop.Side = asrBottom
+    Left = 259
+    Height = 41
+    Top = 86
+    Width = 34
+    AutoSize = True
+    BorderSpacing.Top = 6
+    BorderSpacing.InnerBorder = 4
+    Caption = '>>'
+    Font.Color = clBlack
+    Font.Style = [fsBold]
+    OnClick = IncAllBtnClick
+    ParentFont = False
+    TabOrder = 2
+  end
+  object ExclBtn: TButton
+    AnchorSideLeft.Control = IncAllBtn
+    AnchorSideTop.Control = IncAllBtn
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = IncAllBtn
+    AnchorSideRight.Side = asrBottom
+    Left = 259
+    Height = 41
+    Top = 133
+    Width = 34
+    Anchors = [akTop, akLeft, akRight]
+    AutoSize = True
+    BorderSpacing.Top = 6
+    BorderSpacing.InnerBorder = 4
+    Caption = '<'
+    Font.Color = clBlack
+    Font.Style = [fsBold]
+    OnClick = ExclBtnClick
+    ParentFont = False
+    TabOrder = 3
+  end
+  object ExclAllBtn: TButton
+    AnchorSideLeft.Control = IncAllBtn
+    AnchorSideTop.Control = ExclBtn
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = IncAllBtn
+    AnchorSideRight.Side = asrBottom
+    Left = 259
+    Height = 41
+    Top = 180
+    Width = 34
+    Anchors = [akTop, akLeft, akRight]
+    AutoSize = True
+    BorderSpacing.Top = 6
+    BorderSpacing.InnerBorder = 4
+    Caption = '<<'
+    Font.Color = clBlack
+    Font.Style = [fsBold]
+    OnClick = ExclAllBtnClick
+    ParentFont = False
+    TabOrder = 4
+  end
+  object ButtonPanel1: TButtonPanel
+    Left = 6
+    Height = 42
+    Top = 296
+    Width = 540
+    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 = 6
+    ShowButtons = [pbOK, pbCancel, pbHelp]
+  end
+end

RXLib/rxcontrols/rxfduallst.pas

@@ -0,0 +1,217 @@
+{ fduallst 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 rxfduallst;
+
+{$I RX.INC}
+
+interface
+
+uses SysUtils, LCLIntf, Messages, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ExtCtrls, Buttons, LResources, LCLType, ButtonPanel;
+
+type
+
+  { TDualListForm }
+
+  TDualListForm = class(TForm)
+    ButtonPanel1: TButtonPanel;
+    SrcList: TListBox;
+    DstList: TListBox;
+    SrcLabel: TLabel;
+    DstLabel: TLabel;
+    IncBtn: TButton;
+    IncAllBtn: TButton;
+    ExclBtn: TButton;
+    ExclAllBtn: TButton;
+    procedure IncBtnClick(Sender: TObject);
+    procedure IncAllBtnClick(Sender: TObject);
+    procedure ExclBtnClick(Sender: TObject);
+    procedure ExclAllBtnClick(Sender: TObject);
+    procedure SrcListDragOver(Sender, Source: TObject; X, Y: Integer;
+      State: TDragState; var Accept: Boolean);
+    procedure DstListDragOver(Sender, Source: TObject; X, Y: Integer;
+      State: TDragState; var Accept: Boolean);
+    procedure SrcListDragDrop(Sender, Source: TObject; X, Y: Integer);
+    procedure DstListDragDrop(Sender, Source: TObject; X, Y: Integer);
+    procedure SrcListKeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure DstListKeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure HelpBtnClick(Sender: TObject);
+    procedure ListClick(Sender: TObject);
+  private
+    { Private declarations }
+    function GetShowHelp: Boolean;
+    procedure SetShowHelp(AValue: Boolean);
+  public
+    { Public declarations }
+    procedure SetButtons;
+    property ShowHelp: Boolean read GetShowHelp write SetShowHelp
+      default True;
+end;
+
+implementation
+
+uses rxlclutils, rxboxprocs;
+
+{$R *.lfm}
+
+{ TDualListForm }
+
+procedure TDualListForm.SetButtons;
+var
+  SrcEmpty, DstEmpty: Boolean;
+begin
+  SrcEmpty := (SrcList.Items.Count = 0);
+  DstEmpty := (DstList.Items.Count = 0);
+  IncBtn.Enabled := not SrcEmpty and (SrcList.SelCount > 0);
+  IncAllBtn.Enabled := not SrcEmpty;
+  ExclBtn.Enabled := not DstEmpty and (DstList.SelCount > 0);
+  ExclAllBtn.Enabled := not DstEmpty;
+end;
+
+function TDualListForm.GetShowHelp: Boolean;
+begin
+  Result := pbHelp in ButtonPanel1.ShowButtons;
+end;
+
+procedure TDualListForm.SetShowHelp(AValue: Boolean);
+begin
+  if AValue then
+    ButtonPanel1.ShowButtons:=ButtonPanel1.ShowButtons + [pbHelp]
+  else
+    ButtonPanel1.ShowButtons:=ButtonPanel1.ShowButtons - [pbHelp];
+end;
+
+procedure TDualListForm.IncBtnClick(Sender: TObject);
+begin
+  BoxMoveSelectedItems(SrcList, DstList);
+  SetButtons;
+end;
+
+procedure TDualListForm.IncAllBtnClick(Sender: TObject);
+begin
+  BoxMoveAllItems(SrcList, DstList);
+  SetButtons;
+end;
+
+procedure TDualListForm.ExclBtnClick(Sender: TObject);
+begin
+  BoxMoveSelectedItems(DstList, SrcList);
+  SetButtons;
+end;
+
+procedure TDualListForm.ExclAllBtnClick(Sender: TObject);
+begin
+  BoxMoveAllItems(DstList, SrcList);
+  SetButtons;
+end;
+
+procedure TDualListForm.SrcListDragOver(Sender, Source: TObject; X,
+  Y: Integer; State: TDragState; var Accept: Boolean);
+begin
+  BoxDragOver(SrcList, Source, X, Y, State, Accept, SrcList.Sorted);
+  if State = dsDragLeave then
+    (Source as TListBox).DragCursor := crDrag;
+  if (State = dsDragEnter) and ((Source as TListBox).SelCount > 1) then
+    (Source as TListBox).DragCursor := crMultiDrag;
+end;
+
+procedure TDualListForm.DstListDragOver(Sender, Source: TObject; X,
+  Y: Integer; State: TDragState; var Accept: Boolean);
+begin
+  BoxDragOver(DstList, Source, X, Y, State, Accept, DstList.Sorted);
+  if State = dsDragLeave then
+    (Source as TListBox).DragCursor := crDrag;
+  if (State = dsDragEnter) and ((Source as TListBox).SelCount > 1) then
+    (Source as TListBox).DragCursor := crMultiDrag;
+end;
+
+procedure TDualListForm.SrcListDragDrop(Sender, Source: TObject; X,
+  Y: Integer);
+begin
+  if Source = DstList then ExclBtnClick(SrcList)
+  else if Source = SrcList then begin
+    BoxMoveFocusedItem(SrcList, SrcList.ItemAtPos(Point(X, Y), True));
+  end;
+end;
+
+procedure TDualListForm.DstListDragDrop(Sender, Source: TObject; X,
+  Y: Integer);
+begin
+  if Source = SrcList then IncBtnClick(DstList)
+  else if Source = DstList then begin
+    BoxMoveFocusedItem(DstList, DstList.ItemAtPos(Point(X, Y), True));
+  end;
+end;
+
+procedure TDualListForm.SrcListKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+var
+  Incr: Integer;
+begin
+  if not SrcList.Sorted then begin
+    if (ssCtrl in Shift) and ((Key = VK_DOWN) or (Key = VK_UP)) then begin
+      if Key = VK_DOWN then Incr := 1
+      else Incr := -1;
+      BoxMoveFocusedItem(SrcList, SrcList.ItemIndex + Incr);
+      Key := 0;
+    end;
+  end;
+end;
+
+procedure TDualListForm.DstListKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+var
+  Incr: Integer;
+begin
+  if not DstList.Sorted then begin
+    if (ssCtrl in Shift) and ((Key = VK_DOWN) or (Key = VK_UP)) then begin
+      if Key = VK_DOWN then Incr := 1
+      else Incr := -1;
+      BoxMoveFocusedItem(DstList, DstList.ItemIndex + Incr);
+      Key := 0;
+    end;
+  end;
+end;
+
+procedure TDualListForm.HelpBtnClick(Sender: TObject);
+begin
+  Application.HelpContext(HelpContext);
+end;
+
+procedure TDualListForm.ListClick(Sender: TObject);
+begin
+  SetButtons;
+end;
+
+end.

RXLib/rxcontrols/rxfolderlister.pas

@@ -0,0 +1,225 @@
+{ folderlister 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 rxfolderlister;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus;
+
+
+type
+  { TCustomFolderLister }
+
+  TCustomFolderLister = class(TComponent)
+  private
+    FDefaultExt: string;
+    FMenuItem: TMenuItem;
+    FOnExecuteItem: TNotifyEvent;
+    FFileFolder: string;
+    FFileList:TStringList;
+    procedure DoFind(S:string; MenuItem:TMenuItem);
+    function GetCount: integer;
+    function GetFiles(Item: integer): string;
+    procedure SetMenuItem(const AValue: TMenuItem);
+    procedure SetFileFolder(const AValue: string);
+  protected
+    property FileFolder:string read FFileFolder write SetFileFolder;
+    property OnExecuteItem:TNotifyEvent read FOnExecuteItem write FOnExecuteItem;
+    property MenuItem:TMenuItem read FMenuItem write SetMenuItem;
+    property DefaultExt:string read FDefaultExt write FDefaultExt;
+    procedure InternalExecute(Sender: TObject);virtual;
+  public
+    procedure Execute;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property Files[Item:integer]:string read GetFiles;
+    property Count:integer read GetCount;
+  published
+  end;
+
+type
+  TFolderLister = class(TCustomFolderLister)
+  published
+    property DefaultExt;
+    property FileFolder;
+    property OnExecuteItem;
+    property MenuItem;
+  end;
+  
+implementation
+uses FileUtil, strutils, RxAppUtils, LazUTF8, LazFileUtils, rxconst;
+
+function MenuItemStr(S:string):string;
+var
+  i:integer;
+begin
+  Result:=Copy2Symb(ExtractFileName(S), '.');
+  if Result='' then exit;
+  for i:=1 to Length(Result) do
+  begin
+    if Result[i]='\' then Result[i]:='/' else
+    if Result[i]='_' then Result[i]:='.';
+  end;
+end;
+
+{ TCustomFolderLister }
+procedure TCustomFolderLister.DoFind(S: string; MenuItem: TMenuItem);
+var
+  Rec:TSearchRec;
+  R:integer;
+  AFileList,
+  AFolderList:TStringList;
+
+procedure CreateItems;
+var
+  i:integer;
+  M:TMenuItem;
+begin
+  for I:=0 to AFileList.Count-1 do
+  begin
+    FFileList.Add(AFileList[i]);
+    M:=TMenuItem.Create(Application.MainForm);
+    M.Caption:=MenuItemStr(AFileList[i]);
+    M.Hint:=MenuItemStr(AFileList[i]);
+    MenuItem.Add(M);
+    M.Tag:=FFileList.Count-1;
+    M.OnClick:=@InternalExecute;
+  end;
+end;
+
+procedure CreateSubItems;
+var
+  i:integer;
+  M:TMenuItem;
+  S:string;
+begin
+  for i:=0 to AFolderList.Count-1 do
+  begin
+    M:=TMenuItem.Create(MenuItem.Owner);//Application.MainForm);
+    S:=AFolderList[i];
+    M.Caption:=MenuItemStr(S);
+    MenuItem.Add(M);
+    DoFind(AFolderList[i]+DirectorySeparator,M);
+  end;
+end;
+
+var
+  SS:string;
+begin
+  AFolderList:=TStringList.Create;
+  AFolderList.Sorted:=true;
+  AFileList:=TStringList.Create;
+  AFolderList.Sorted:=true;
+  try
+    R:=FindFirstUTF8(S+AllMask,faAnyFile, Rec);
+    while R=0 do
+    begin
+      if ((Rec.Attr and faDirectory) <>0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
+      begin
+        SS:=S+Rec.Name;
+        AFolderList.Add(SS)
+      end
+      else
+      begin
+        if UTF8LowerCase(ExtractFileExt(Rec.Name))=UTF8LowerCase(FDefaultExt) then
+        begin
+          SS:=S+Rec.Name;
+          AFileList.Add(SS);
+        end;
+      end;
+      R:=FindNextUTF8(Rec);
+    end;
+    FindCloseUTF8(Rec);
+    CreateSubItems;
+    CreateItems;
+  finally
+    AFolderList.Free;
+    AFileList.Free;
+  end;
+end;
+
+function TCustomFolderLister.GetCount: integer;
+begin
+  Result:=FFileList.Count;
+end;
+
+function TCustomFolderLister.GetFiles(Item: integer): string;
+begin
+  Result:=FFileList[Item];
+end;
+
+procedure TCustomFolderLister.SetMenuItem(const AValue: TMenuItem);
+begin
+  if FMenuItem=AValue then exit;
+  FMenuItem:=AValue;
+end;
+
+procedure TCustomFolderLister.SetFileFolder(const AValue: string);
+begin
+  if FFileFolder=AValue then exit;
+  FFileFolder:=AValue;
+  if FFileFolder<>'' then
+    if FFileFolder[Length(FFileFolder)]<>DirectorySeparator then
+      FFileFolder:=FFileFolder+DirectorySeparator;
+end;
+
+procedure TCustomFolderLister.InternalExecute(Sender: TObject);
+begin
+  if Assigned(FOnExecuteItem) then
+    FOnExecuteItem(Sender)
+end;
+
+procedure TCustomFolderLister.Execute;
+begin
+  if Assigned(FMenuItem) then
+    DoFind(FFileFolder, FMenuItem)
+  else
+    raise Exception.CreateFmt( sFolderListerErr, [Name]);
+end;
+
+constructor TCustomFolderLister.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFileList:=TStringList.Create;
+  FFileList.Sorted:=false;
+end;
+
+destructor TCustomFolderLister.Destroy;
+begin
+  FFileList.Free;
+  inherited Destroy;
+end;
+
+end.

RXLib/rxcontrols/rxhistory.pas

@@ -0,0 +1,222 @@
+{ RXHistory 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 RXHistory;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+  rxtoolbar;
+
+type
+  TToolbarButtonStyleCntrl = (tbrcNotChange, tbrcDropDown, tbrcDropDownExtra);
+
+  PNavigateRec = ^TNavigateRec;
+  TNavigateRec = packed record
+    Name:string;
+    Cond:string;
+    Next:PNavigateRec;
+  end;
+
+  TOnNavigateEvent = procedure(Sender:TObject; const EventName, EventMacro:string) of object;
+  { TRXHistory }
+
+  TRXHistory = class(TComponent)
+  private
+    FButtonNext: string;
+    FButtonPrior: string;
+    FButtonStyle: TToolbarButtonStyleCntrl;
+    FNextButton: TToolbarItem;
+    FNextButtonName: string;
+    FOnNavigateEvent: TOnNavigateEvent;
+    FPriorButton: TToolbarItem;
+    FPriorButtonName: string;
+    FToolPanel: TToolPanel;
+    function GetNextButtonName: string;
+    function GetPriorButtonName: string;
+    procedure SetButtonStyle(const AValue: TToolbarButtonStyleCntrl);
+    procedure SetNextButtonName(const AValue: string);
+    procedure SetPriorButtonName(const AValue: string);
+    procedure SetToolPanel(const AValue: TToolPanel);
+    function SetBtn(const ABtnName: string;var Button:TToolbarItem):boolean;
+  protected
+    procedure Loaded; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property PriorButton:TToolbarItem read FPriorButton;
+    property NextButton:TToolbarItem read FNextButton;
+  published
+    property ToolPanel:TToolPanel read FToolPanel write SetToolPanel;
+    property PriorButtonName:string read GetPriorButtonName write SetPriorButtonName;
+    property NextButtonName:string read GetNextButtonName write SetNextButtonName;
+    property ButtonStyle:TToolbarButtonStyleCntrl read FButtonStyle write SetButtonStyle default tbrcNotChange;
+    property OnNavigateEvent:TOnNavigateEvent read FOnNavigateEvent write FOnNavigateEvent;
+  end;
+
+procedure Register;
+
+implementation
+uses PropEdits, Componenteditors, TypInfo;
+
+type
+
+  { TTRXHistoryBtnNameProperty }
+
+  TTRXHistoryBtnNameProperty = class(TStringPropertyEditor)
+  public
+    function  GetAttributes: TPropertyAttributes; override;
+    procedure GetValues(Proc: TGetStrProc); override;
+  end;
+
+{ TTRXHistoryBtnNameProperty }
+
+function TTRXHistoryBtnNameProperty.GetAttributes: TPropertyAttributes;
+begin
+  Result:=inherited GetAttributes;
+  Result:=Result + [paValueList, paSortList, paMultiSelect];
+end;
+
+procedure TTRXHistoryBtnNameProperty.GetValues(Proc: TGetStrProc);
+var
+  ToolPanel:TToolPanel;
+  i:integer;
+begin
+  ToolPanel := GetObjectProp(GetComponent(0), 'ToolPanel') as TToolPanel;
+  if Assigned(ToolPanel) then
+    for I := 0 to ToolPanel.Items.Count - 1 do
+    begin
+      if Assigned(ToolPanel.Items[i].Action) then
+       Proc(ToolPanel.Items[i].Action.Name);
+    end;
+end;
+
+procedure Register;
+begin
+  RegisterComponents('RX',[TRXHistory]);
+
+  RegisterPropertyEditor(TypeInfo(string), TRXHistory, 'PriorButtonName', TTRXHistoryBtnNameProperty);
+  RegisterPropertyEditor(TypeInfo(string), TRXHistory, 'NextButtonName', TTRXHistoryBtnNameProperty);
+end;
+
+{ TRXHistory }
+
+procedure TRXHistory.SetToolPanel(const AValue: TToolPanel);
+begin
+  if FToolPanel=AValue then exit;
+  FToolPanel:=AValue;
+end;
+
+function TRXHistory.SetBtn(const ABtnName: string;var Button:TToolbarItem):boolean;
+var
+  i:integer;
+begin
+  Result:=false;
+  if not Assigned(FToolPanel) then exit;
+  Button:=FToolPanel.Items.ByActionName[ABtnName];
+  Result:=Assigned(Button);
+  if Result then
+  begin
+    case FButtonStyle of
+      tbrcDropDown:Button.ButtonStyle:=tbrDropDown;
+      tbrcDropDownExtra:Button.ButtonStyle:=tbrDropDownExtra;
+    end;
+  end;
+end;
+
+procedure TRXHistory.Loaded;
+begin
+  inherited Loaded;
+  if not SetBtn(FNextButtonName, FNextButton) then
+    FNextButtonName:='';
+  if not SetBtn(FPriorButtonName, FPriorButton) then
+    FPriorButtonName:='';
+end;
+
+constructor TRXHistory.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FButtonStyle:=tbrcNotChange;
+end;
+
+procedure TRXHistory.SetNextButtonName(const AValue: string);
+begin
+  if FNextButtonName=AValue then exit;
+  if csLoading in ComponentState then
+    FNextButtonName:=AValue
+  else
+  begin
+    if SetBtn(AValue, FNextButton) then
+      FNextButtonName:=AValue
+    else
+      FNextButtonName:='';
+  end;
+end;
+
+procedure TRXHistory.SetButtonStyle(const AValue: TToolbarButtonStyleCntrl);
+begin
+  if FButtonStyle=AValue then exit;
+  FButtonStyle:=AValue;
+end;
+
+function TRXHistory.GetNextButtonName: string;
+begin
+  if Assigned(NextButton) and Assigned(NextButton.Action) then
+    Result:=NextButton.Action.Name
+  else
+    Result:='';
+end;
+
+function TRXHistory.GetPriorButtonName: string;
+begin
+  if Assigned(PriorButton) and Assigned(PriorButton.Action) then
+    Result:=PriorButton.Action.Name
+  else
+    Result:='';
+end;
+
+procedure TRXHistory.SetPriorButtonName(const AValue: string);
+begin
+  if FPriorButtonName=AValue then exit;
+  if csLoading in ComponentState then
+    FPriorButtonName:=AValue
+  else
+  begin
+    if SetBtn(AValue, FPriorButton) then
+      FPriorButtonName:=AValue
+    else
+      FPriorButtonName:='';
+  end;
+end;
+
+end.

RXLib/rxcontrols/rxhistorynavigator.pas

@@ -0,0 +1,463 @@
+{ RxHistoryNavigator 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 RxHistoryNavigator;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, rxtoolbar,
+  Menus;
+
+type
+  PNavigateRec = ^TNavigateRec;
+  TNavigateRec = record
+    Name:string;
+    Cond:string;
+    Next:PNavigateRec;
+  end;
+
+type
+  TRxHistoryNavigator = class;
+  THistoryNavigateEvent = procedure(Sender:TRxHistoryNavigator; AInfo:string; AProcessed:boolean) of object;
+
+  { TRxHistoryNavigator }
+
+  TRxHistoryNavigator = class(TComponent)
+  private
+    FForwardBtnItem:TToolbarItem;
+    FForwardBtn: string;
+
+    FBackBtnItem:TToolbarItem;
+    FBackBtn: string;
+    First:PNavigateRec;
+    Curr:PNavigateRec;
+    FMaxPopupItems: integer;
+
+    FOnHistoryNavigate: THistoryNavigateEvent;
+    FToolPanel: TToolPanel;
+    PMBack:TPopupMenu;
+    PMForw:TPopupMenu;
+    function GetBackBtn: string;
+    function GetForwardBtn: string;
+    procedure SetBackBtn(AValue: string);
+    procedure SetForwardBtn(AValue: string);
+    procedure SetToolPanel(AValue: TToolPanel);
+    procedure ClearFromCurrent(var C:PNavigateRec);
+
+    procedure CreateBackMenu;
+    procedure CreateRetrMenu;
+
+    function Last:PNavigateRec;
+    function Prior(R:PNavigateRec):PNavigateRec;
+    procedure CheckTop;
+    procedure CheckBottom;
+    procedure EnableAction(ActName:byte; Enable:boolean);
+    procedure BackProc(Sender: TObject);
+    procedure ForwardProc(Sender: TObject);
+    procedure DoSetItems;
+  protected
+    function Navigate(ToTop:boolean; Count:integer):boolean;
+    procedure Loaded; override;
+    procedure Notification(AComponent: TComponent;
+      Operation: TOperation); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure ClearHistory;
+    procedure AddToHistory(AHistoryCaption, AInfo:string);
+  published
+    property ToolPanel: TToolPanel read FToolPanel write SetToolPanel;
+    property BackBtn:string read GetBackBtn write SetBackBtn;
+    property ForwardBtn:string read GetForwardBtn write SetForwardBtn;
+    property OnHistoryNavigate:THistoryNavigateEvent read FOnHistoryNavigate write FOnHistoryNavigate;
+    property MaxPopupItems:integer read FMaxPopupItems write FMaxPopupItems default 10;
+  end;
+
+
+implementation
+uses ActnList, rxconst;
+
+  { TRxHistoryNavigator }
+
+procedure TRxHistoryNavigator.SetToolPanel(AValue: TToolPanel);
+begin
+  if FToolPanel=AValue then Exit;
+  FToolPanel:=AValue;
+end;
+
+procedure TRxHistoryNavigator.ClearFromCurrent(var C: PNavigateRec);
+var
+  R:PNavigateRec;
+begin
+  while C<>nil do
+  begin
+    R:=C;
+    C:=C^.Next;
+    Dispose(R);
+  end;
+end;
+
+procedure TRxHistoryNavigator.CreateRetrMenu;
+var i:integer;
+    S:PNavigateRec;
+    Item:TMenuItem;
+begin
+  if Curr=nil then exit;
+  PMForw.Items.Clear;
+  i:=0;
+  S:=Curr^.Next;
+  while (i<FMaxPopupItems) and (S<>nil) do
+  begin
+    Item := TMenuItem.Create(Self);
+    Item.Caption := S^.Name;
+    Item.OnClick := @ForwardProc;
+    Item.Hint:=Format(sHistoryDesc, [S^.Cond]);
+    Item.Tag:=i;
+    PMForw.Items.Add(Item);
+    inc(i);
+    S:=S^.Next;
+  end;
+end;
+
+function TRxHistoryNavigator.Last: PNavigateRec;
+begin
+  if First=nil then Result:=nil
+  else
+  begin
+    Result:=First;
+    while Result^.Next<>nil do Result:=Result^.Next;
+  end;
+end;
+
+function TRxHistoryNavigator.Prior(R: PNavigateRec): PNavigateRec;
+var
+  L:PNavigateRec;
+begin
+  if First=nil then Result:=nil
+  else
+  begin
+    L:=First;
+    while (L^.Next<>nil) and (L^.Next<>R) do
+    begin
+      L:=L^.Next;
+    end;
+    if L^.Next=nil then Result:=nil else Result:=l;
+  end;
+end;
+
+procedure TRxHistoryNavigator.CheckTop;
+begin
+  EnableAction(0, (Curr<>nil) and (Curr<>First));
+end;
+
+
+procedure TRxHistoryNavigator.CheckBottom;
+begin
+  EnableAction(1, (Curr<>nil) and (Curr^.Next<>nil));
+end;
+
+procedure TRxHistoryNavigator.EnableAction(ActName: byte; Enable: boolean);
+begin
+  if First=nil then Enable:=false;
+  if ActName = 0 then
+  begin
+    if Assigned(FBackBtnItem) then
+      (FBackBtnItem.Action as TAction).Enabled:=Enable
+  end
+  else
+    if Assigned(FForwardBtnItem) then
+      (FForwardBtnItem.Action as TAction).Enabled:=Enable
+end;
+
+procedure TRxHistoryNavigator.BackProc(Sender: TObject);
+begin
+  Navigate(true, (Sender as TComponent).Tag);
+end;
+
+procedure TRxHistoryNavigator.ForwardProc(Sender: TObject);
+begin
+  Navigate(false, (Sender as TComponent).Tag);
+end;
+
+procedure TRxHistoryNavigator.DoSetItems;
+begin
+  if Assigned(FToolPanel) then
+  begin
+    FForwardBtnItem:=FToolPanel.Items.ByActionName[FForwardBtn];
+    if Assigned(FForwardBtnItem) then
+    begin
+      FForwardBtnItem.DropDownMenu:=PMForw;
+      FForwardBtnItem.Action.OnExecute:=@ForwardProc;
+    end;
+
+    FBackBtnItem:=FToolPanel.Items.ByActionName[FBackBtn];
+    if Assigned(FBackBtnItem) then
+    begin
+      FBackBtnItem.DropDownMenu:=PMBack;
+      FBackBtnItem.Action.OnExecute:=@BackProc;
+    end;
+  end;
+end;
+
+function TRxHistoryNavigator.Navigate(ToTop: boolean; Count: integer): boolean;
+var
+  F:boolean;
+  Condit: string;
+begin
+  Result:=false;
+  if First=nil then exit;
+  if ToTop then
+  begin
+    inc(Count);
+    repeat
+      Curr:=Prior(Curr);
+      if Curr=nil then Curr:=First;
+      Dec(Count);
+    until (Count=0) or (Curr=First);
+    Result:=true;
+    Condit:=Curr^.Cond;
+    CreateBackMenu;
+    CreateRetrMenu;
+  end
+  else
+  begin
+    inc(Count);
+    repeat
+      if Curr^.Next<>nil then Curr:=Curr^.Next;
+      Dec(Count);
+    until (Count=0) or (Curr^.Next=nil);
+    Result:=true;
+    Condit:=Curr^.Cond;
+    CreateRetrMenu;
+    CreateBackMenu;
+  end;
+  CheckTop;
+  CheckBottom;
+  F:=true;
+  if Assigned(FOnHistoryNavigate) and Assigned(Curr) then
+    FOnHistoryNavigate(Self, Condit, F);
+end;
+
+procedure TRxHistoryNavigator.Loaded;
+begin
+  inherited Loaded;
+  DoSetItems;
+  CheckTop;
+  CheckBottom;
+end;
+
+procedure TRxHistoryNavigator.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation = opRemove then
+  begin
+    if AComponent = FToolPanel then
+    begin
+      if Assigned(FForwardBtnItem) then
+      begin
+        FForwardBtnItem.Action.OnExecute:=nil;
+        FForwardBtnItem:=nil;
+      end;
+
+      if Assigned(FBackBtnItem) then
+      begin
+        FBackBtnItem.Action.OnExecute:=nil;
+        FBackBtnItem:=nil;
+      end;
+    end
+    else
+    if AComponent = Self then
+    begin
+      if Assigned(FForwardBtnItem) then
+      begin
+        FForwardBtnItem.Action.OnExecute:=nil;
+        FForwardBtnItem.DropDownMenu:=nil;
+        FForwardBtnItem:=nil;
+      end;
+
+      if Assigned(FBackBtnItem) then
+      begin
+        FBackBtnItem.Action.OnExecute:=nil;
+        FBackBtnItem.DropDownMenu:=nil;
+        FBackBtnItem:=nil;
+      end;
+    end;
+  end;
+end;
+
+procedure TRxHistoryNavigator.CreateBackMenu;
+var i:integer;
+    S:PNavigateRec;
+    Item:TMenuItem;
+begin
+  if Curr=nil then exit;
+  PMBack.Items.Clear;
+  i:=0;
+  S:=Curr;
+  while (i<FMaxPopupItems) and (S<>First) do
+  begin
+    Item := TMenuItem.Create(Self);
+    Item.Caption := S^.Name;
+    Item.OnClick := @BackProc;
+    Item.Hint:=Format(sHistoryDesc, [S^.Cond]);
+    Item.Tag:=i;
+    PMBack.Items.Add(Item);
+    inc(i);
+    S:=Prior(S);
+  end;
+end;
+
+constructor TRxHistoryNavigator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  PMBack:=TPopupMenu.Create(Self);
+  PMBack.Parent:=Self;
+  PMForw:=TPopupMenu.Create(Self);
+  PMForw.Parent:=Self;
+  FMaxPopupItems:=10;
+end;
+
+destructor TRxHistoryNavigator.Destroy;
+begin
+  Curr:=nil;
+  ClearFromCurrent(First);
+  inherited Destroy;
+end;
+
+procedure TRxHistoryNavigator.ClearHistory;
+begin
+
+end;
+
+procedure TRxHistoryNavigator.AddToHistory(AHistoryCaption, AInfo: string);
+var
+  R, L:PNavigateRec;
+begin
+  New(R);
+  FillChar(R^, SizeOf(TNavigateRec), 0);
+  R^.Name:=AHistoryCaption;
+  R^.Cond:=AInfo;
+  if First<>nil then
+  begin
+    L:=Last;
+    if Curr<>L then ClearFromCurrent(Curr^.Next);
+    Curr^.Next:=R;
+    Curr:=R;
+  end
+  else
+  begin
+    First:=R;
+    Curr:=R;
+  end;
+  CreateBackMenu;
+  CreateRetrMenu;
+  CheckTop;
+  CheckBottom;
+end;
+
+procedure TRxHistoryNavigator.SetBackBtn(AValue: string);
+begin
+  if FBackBtn=AValue then Exit;
+
+  if ForwardBtn = AValue then
+    ForwardBtn:='';
+
+  FBackBtn:=AValue;
+
+  if Assigned(FBackBtnItem) then
+  begin
+    FBackBtnItem.DropDownMenu:=nil;
+    FBackBtnItem.Action.OnExecute:=nil;
+  end;
+
+  if Assigned(FToolPanel) and (FBackBtn<>'') then
+  begin
+    FBackBtnItem:=FToolPanel.Items.ByActionName[FBackBtn];
+    if Assigned(FBackBtnItem) then
+    begin
+      FBackBtnItem.DropDownMenu:=PMBack;
+      FBackBtnItem.Action.OnExecute:=@BackProc;
+    end;
+  end
+  else
+    FBackBtnItem:=nil;
+end;
+
+function TRxHistoryNavigator.GetBackBtn: string;
+begin
+  if Assigned(FBackBtnItem) then
+    Result:=FBackBtnItem.Action.Name
+  else
+    Result:=FBackBtn;
+end;
+
+function TRxHistoryNavigator.GetForwardBtn: string;
+begin
+  if Assigned(FForwardBtnItem) then
+    Result:=FForwardBtnItem.Action.Name
+  else
+    Result:=FForwardBtn;
+end;
+
+procedure TRxHistoryNavigator.SetForwardBtn(AValue: string);
+begin
+  if FForwardBtn=AValue then Exit;
+
+  if BackBtn = AValue then
+    BackBtn:='';
+
+  FForwardBtn:=AValue;
+
+
+  if Assigned(FForwardBtnItem) then
+  begin
+    FForwardBtnItem.DropDownMenu:=nil;
+    FForwardBtnItem.Action.OnExecute:=nil;
+  end;
+
+  if Assigned(FToolPanel) and (AValue <>'') then
+  begin
+    FForwardBtnItem:=FToolPanel.Items.ByActionName[FForwardBtn];
+    if Assigned(FForwardBtnItem) then
+    begin
+      FForwardBtnItem.DropDownMenu:=PMForw;
+      FForwardBtnItem.Action.OnExecute:=@ForwardProc;
+    end;
+  end
+  else
+    FForwardBtnItem:=nil;
+end;
+
+end.

RXLib/rxcontrols/rxinipropstorage.pas

@@ -0,0 +1,119 @@
+{ RxIniPropStorage unit
+
+  Copyright (C) 2005-2018 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 RxIniPropStorage;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, IniPropStorage;
+
+type
+
+  { TRxIniPropStorage }
+
+  TRxIniPropStorage = class(TIniPropStorage)
+  private
+    FSeparateFiles: boolean;
+  protected
+    function GetIniFileName: string; override;
+    procedure FinishPropertyList(List: TStrings); override;
+  public
+    procedure StorageNeeded(ReadOnly: Boolean); override;
+    { Public declarations }
+  published
+    property SeparateFiles:boolean read FSeparateFiles write FSeparateFiles;
+  end;
+
+implementation
+uses rxapputils, LazUTF8, FileUtil, LazFileUtils, IniFiles, StrUtils;
+
+{ TRxIniPropStorage }
+
+function TRxIniPropStorage.GetIniFileName: string;
+var
+  S:string;
+begin
+  if ExtractFileDir(IniFileName) <> '' then
+    Result:=IniFileName
+  else
+  begin
+    S:=GetDefaultIniName;
+    if IniFileName <> '' then
+      Result:=AppendPathDelim(ExtractFileDir(S)) + IniFileName
+    else
+    begin
+      if FSeparateFiles then
+        Result:=AppendPathDelim(ExtractFileDir(S)) + RootSection + '.cfg'
+      else
+        Result:=S;
+    end;
+  end;
+  Result:=UTF8ToSys(Result);
+end;
+
+procedure TRxIniPropStorage.FinishPropertyList(List: TStrings);
+{$IFDEF FIX_WIDTH_WIDE_STRING96}
+var
+  S: String;
+  i: Integer;
+  K: SizeInt;
+{$ENDIF FIX_WIDTH_WIDE_STRING96}
+begin
+  {$IFDEF FIX_WIDTH_WIDE_STRING96}
+  if Screen.PixelsPerInch<>96 then
+    for i:=List.Count-1 downto 0 do
+    begin
+      S:=UpperCase(List[I]);
+      K:=Pos('.', S);
+      if K > 0 then
+        Delete(S, 1, K);
+      if (S = 'WIDTH') or (S='HEIGHT') then
+        List.Delete(i);
+    end;
+  {$ENDIF FIX_WIDTH_WIDE_STRING96}
+  inherited FinishPropertyList(List);
+end;
+
+procedure TRxIniPropStorage.StorageNeeded(ReadOnly: Boolean);
+var
+  F: Boolean;
+begin
+  F:=Assigned(IniFile);
+  inherited StorageNeeded(ReadOnly);
+  if Assigned(IniFile) and (not F) then
+    if IniFile is TIniFile then
+      TIniFile(IniFile).CacheUpdates:=true;
+end;
+
+end.

RXLib/rxcontrols/rxlclconst.pas

@@ -0,0 +1,61 @@
+{ rxlclconst 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 rxlclconst;
+
+interface
+
+{$I RX.INC}
+
+uses LMessages, Controls;
+
+const
+{ Command message for Speedbar editor }
+  CM_SPEEDBARCHANGED = CM_BASE + 80;
+{ Command message for TRxSpeedButton }
+  CM_RXBUTTONPRESSED = CM_BASE + 81;
+{ Command messages for TRxWindowHook }
+  CM_RECREATEWINDOW  = CM_BASE + 82;
+  CM_DESTROYHOOK     = CM_BASE + 83;
+{ Notify message for TRxTrayIcon }
+  CM_TRAYICON        = CM_BASE + 84;
+{
+const
+  crHand     = TCursor(14000);
+  crDragHand = TCursor(14001);
+}
+//const
+//{ TBitmap.GetTransparentColor from GRAPHICS.PAS uses this value }
+//  PaletteMask = $02000000;
+
+implementation
+
+end.

RXLib/rxcontrols/rxlclutils.pas

@@ -0,0 +1,798 @@
+{ lclutils 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 rxlclutils;
+
+{$I rx.inc}
+
+interface
+
+uses
+{$IFDEF WIN32}
+  windows,
+{$ENDIF}
+  Classes, SysUtils, Graphics, Controls, Forms, LResources
+  ;
+
+
+type
+  TTextOrientation = (toHorizontal, toVertical90, toHorizontal180, toVertical270, toHorizontal360);
+
+  { TRxPageMargin }
+
+  TRxPageMargin = class(TPersistent)
+  private
+    FBottom: integer;
+    FLeft: integer;
+    FRight: integer;
+    FTop: integer;
+  protected
+    procedure AssignTo(Dest: TPersistent); override;
+  public
+    constructor Create;
+  published
+    property Left:integer read FLeft write FLeft default 20;
+    property Top:integer read FTop write FTop default 20;
+    property Right:integer read FRight write FRight default 20;
+    property Bottom:integer read FBottom write FBottom default 20;
+  end;
+
+function WidthOf(R: TRect): Integer; inline;
+function HeightOf(R: TRect): Integer; inline;
+
+procedure RxFrame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor;
+  Width: Integer);
+function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
+  IsDown, IsFlat: Boolean): TRect;
+function DrawButtonFrameXP(Canvas: TCanvas; const Client: TRect;
+  IsDown, IsFlat: Boolean): TRect;
+
+//Code from TAChartUtils
+procedure RotateLabel(Canvas: TCanvas; x, y: Integer; const St: String; RotDegree: Integer);
+procedure OutTextXY90(Canvas:TCanvas; X,Y:integer; Text:string; Orientation:TTextOrientation);
+
+function IsForegroundTask: Boolean;
+function ValidParentForm(Control: TControl): TCustomForm;
+function CreateArrowBitmap:TBitmap;
+function CreateResBitmap(const AResName:string):TBitmap;
+function  LoadLazResBitmapImage(const ResName: string): TBitmap;
+
+{functions from DBGrid}
+function  GetWorkingCanvas(const Canvas: TCanvas): TCanvas;
+procedure FreeWorkingCanvas(canvas: TCanvas);
+
+{
+function AllocMemo(Size: Longint): Pointer;
+function ReallocMemo(fpBlock: Pointer; Size: Longint): Pointer;
+procedure FreeMemo(var fpBlock: Pointer);
+}
+
+procedure RaiseIndexOutOfBounds(Control: TControl; Items:TStrings; Index: integer);
+
+procedure WriteTextHeader(ACanvas: TCanvas; ARect: TRect; const Text: string; Alignment: TAlignment);
+
+{$IFDEF WIN32}
+type
+  PCursorOrIcon = ^TCursorOrIcon;
+  TCursorOrIcon = packed record
+    Reserved: Word;
+    wType: Word;
+    Count: Word;
+  end;
+
+  PIconRec = ^TIconRec;
+  TIconRec = packed record
+    Width: Byte;
+    Height: Byte;
+    Colors: Word;
+    Reserved1: Word;
+    Reserved2: Word;
+    DIBSize: Longint;
+    DIBOffset: Longint;
+  end;
+
+procedure ReadIcon(Stream: TStream; var Icon: HICON; ImageCount: Integer;
+  StartOffset: Integer; const RequestedSize: TPoint; var IconSize: TPoint);
+procedure OutOfResources;
+{$ENDIF}
+
+implementation
+uses LCLProc, LCLIntf, LCLType, LCLStrConsts, Grids, math;
+
+{$IFNDEF RX_USE_LAZARUS_RESOURCE}
+{$R rx_lcl.res}
+{$ENDIF}
+
+{ TRxPageMargin }
+
+procedure TRxPageMargin.AssignTo(Dest: TPersistent);
+begin
+  if (Dest is TRxPageMargin) then
+  begin
+    TRxPageMargin(Dest).FBottom:=FBottom;
+    TRxPageMargin(Dest).FLeft:=FLeft;
+    TRxPageMargin(Dest).FRight:=FRight;
+    TRxPageMargin(Dest).FTop:=FTop;
+  end
+  else
+    inherited AssignTo(Dest);
+end;
+
+constructor TRxPageMargin.Create;
+begin
+  inherited Create;
+  FBottom:=20;
+  FLeft:=20;
+  FRight:=20;
+  FTop:=20;
+end;
+
+function WidthOf(R: TRect): Integer;
+begin
+  Result := R.Right - R.Left;
+end;
+
+function HeightOf(R: TRect): Integer;
+begin
+  Result := R.Bottom - R.Top;
+end;
+
+procedure RxFrame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor;
+  Width: Integer);
+
+procedure DoRect;
+var
+  TopRight, BottomLeft: TPoint;
+begin
+  TopRight.X := Rect.Right;
+  TopRight.Y := Rect.Top;
+  BottomLeft.X := Rect.Left;
+  BottomLeft.Y := Rect.Bottom;
+  Canvas.Pen.Color := TopColor;
+  Canvas.PolyLine([BottomLeft, Rect.TopLeft, TopRight]);
+  Canvas.Pen.Color := BottomColor;
+  Dec(BottomLeft.X);
+  Canvas.PolyLine([TopRight, Rect.BottomRight, BottomLeft]);
+end;
+
+begin
+  Canvas.Pen.Width := 1;
+  Dec(Rect.Bottom); Dec(Rect.Right);
+  while Width > 0 do
+  begin
+    Dec(Width);
+    DoRect;
+    InflateRect(Rect, -1, -1);
+  end;
+  Inc(Rect.Bottom); Inc(Rect.Right);
+end;
+
+function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
+  IsDown, IsFlat: Boolean): TRect;
+begin
+  Result := Client;
+  if IsDown then
+  begin
+    RxFrame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1);
+    if not IsFlat then
+      RxFrame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
+  end
+  else
+  begin
+    if IsFlat then
+      RxFrame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1)
+    else
+    begin
+      RxFrame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1);
+      RxFrame3D(Canvas, Result, clBtnFace, clBtnShadow, 1);
+    end;
+  end;
+  InflateRect(Result, -1, -1);
+end;
+
+function DrawButtonFrameXP(Canvas: TCanvas; const Client: TRect; IsDown,
+  IsFlat: Boolean): TRect;
+begin
+  Result := Client;
+  Canvas.Brush.Color := $00EFD3C6;
+  Canvas.FillRect(Client);
+  RxFrame3D(Canvas, Result, $00C66931, $00C66931, 1);
+end;
+
+{$IFDEF WIN32}
+type
+  PCheckTaskInfo = ^TCheckTaskInfo;
+  TCheckTaskInfo = packed record
+    FocusWnd: HWnd;
+    Found: Boolean;
+  end;
+//function CheckTaskWindow(Window: HWnd; Data: Longint): WordBool; stdcall;
+function CheckTaskWindow(Window:HWND; Data:LPARAM):WINBOOL;stdcall;
+begin
+  Result := True;
+  if PCheckTaskInfo(Data)^.FocusWnd = Window then begin
+    Result := False;
+    PCheckTaskInfo(Data)^.Found := True;
+  end;
+end;
+{$ENDIF}
+
+function IsForegroundTask: Boolean;
+{$IFDEF WIN32}
+var
+  Info: TCheckTaskInfo;
+{$ENDIF}
+begin
+{$IFDEF WIN32}
+  Info.FocusWnd := GetActiveWindow;
+  Info.Found := False;
+  EnumThreadWindows(GetCurrentThreadID, @CheckTaskWindow, Longint(@Info));
+  Result := Info.Found;
+{$ELSE}
+  Result:=true;
+{$ENDIF}
+end;
+
+function ValidParentForm(Control: TControl): TCustomForm;
+begin
+  Result := GetParentForm(Control);
+  if Result = nil then
+    raise EInvalidOperation.CreateFmt('ParentRequired %s', [Control.Name]);
+end;
+
+procedure RotateLabel(Canvas: TCanvas; x, y: Integer; const St: String; RotDegree: Integer);
+var
+  L:integer;
+begin
+  L:=Canvas.Font.Orientation;
+
+  SetBkMode(Canvas.Handle, TRANSPARENT);
+
+  Canvas.Font.Orientation:=RotDegree * 10;
+  Canvas.TextOut(X, Y, St);
+
+{  DrawText(ACanvas.Handle, PChar(Text), Length(Text), DrawRect,
+    ALIGN_FLAGS_HEADER[Alignment]  or DT_WORDBREAK
+    );}
+
+  Canvas.Font.Orientation:=L;
+end;
+
+
+procedure OutTextXY90(Canvas:TCanvas; X,Y:integer; Text:string; Orientation:TTextOrientation);
+{$IFDEF OLD_STYLE_TEXT_ROTATE}
+var
+  W,H, i,j:integer;
+  Bmp:TBitmap;
+begin
+  if Orientation = toHorizontal then
+    Canvas.TextOut(X, Y, Text)
+  else
+  begin
+    W:=Canvas.TextWidth(Text);
+    H:=Canvas.TextHeight(Text);
+    Bmp:=TBitMap.Create;
+    try
+      Bmp.Width:=W;
+      Bmp.Height:=H;
+      Bmp.Canvas.Brush.Style:=bsSolid;
+      Bmp.Canvas.Brush.Color:=clWhite;
+      Bmp.Canvas.FillRect(Rect(0,0,W,H));
+      Bmp.Canvas.Font:=Canvas.Font;
+      Bmp.Canvas.TextOut(0, 0, Text);
+      Canvas.Lock;
+      if Orientation = toVertical90 then
+      begin
+        for i:=0 to W-1 do
+          for j:=0 to H-1 do
+            if Bmp.Canvas.Pixels[i,j]<>clWhite then
+              Canvas.Pixels[(H-j)+X,i+Y]:=Bmp.Canvas.Pixels[i,j];
+      end
+      else
+      if Orientation = toVertical270 then
+      begin
+        for i:=0 to W-1 do
+          for j:=0 to H-1 do
+            if Bmp.Canvas.Pixels[i,j]<>clWhite then
+              Canvas.Pixels[j+X,(W-i)+Y]:=Bmp.Canvas.Pixels[i,j];
+      end
+      else
+      if Orientation = toHorizontal180 then
+      begin
+        for i:=0 to W-1 do
+          for j:=0 to H-1 do
+            if Bmp.Canvas.Pixels[i,j]<>clWhite then
+              Canvas.Pixels[i+X,(H-j)+Y]:=Bmp.Canvas.Pixels[i,j];
+      end
+      else
+      if Orientation = toHorizontal360 then
+      begin
+        for i:=0 to W-1 do
+          for j:=0 to H-1 do
+            if Bmp.Canvas.Pixels[i,j]<>clWhite then
+              Canvas.Pixels[(W-i)+X,j+Y]:=Bmp.Canvas.Pixels[i,j];
+      end;
+      Canvas.Unlock;
+    finally
+      Bmp.Free;
+    end;
+  end;
+end;
+{$ELSE}
+const
+  TextAngle: array [TTextOrientation] of integer =
+      (0 {toHorizontal}, 90 {toVertical90},
+       180 {toHorizontal180}, 270 {toVertical270}, 0 {toHorizontal360});
+var
+  W, H:integer;
+begin
+  W:=0;
+  H:=0;
+  case Orientation of
+    toVertical90:
+       begin
+         H:=Canvas.TextWidth(Text);
+       end;
+    toVertical270:
+       begin
+         W:=Canvas.TextHeight(Text);
+       end;
+    toHorizontal180:
+       begin
+         H:=Canvas.TextHeight(Text);
+         W:=Canvas.TextWidth(Text);
+       end;
+  end;
+  RotateLabel(Canvas, X+W, Y+H, Text, TextAngle[Orientation]);
+end;
+{$ENDIF}
+
+{
+function AllocMemo(Size: Longint): Pointer;
+begin
+  if Size > 0 then
+    Result := GlobalAllocPtr(HeapAllocFlags or GMEM_ZEROINIT, Size)
+  else Result := nil;
+end;
+
+function ReallocMemo(fpBlock: Pointer; Size: Longint): Pointer;
+begin
+  Result := GlobalReallocPtr(fpBlock, Size,
+    HeapAllocFlags or GMEM_ZEROINIT);
+end;
+
+procedure FreeMemo(var fpBlock: Pointer);
+begin
+  if fpBlock <> nil then begin
+    GlobalFreePtr(fpBlock);
+    fpBlock := nil;
+  end;
+end;
+}
+{$IFDEF WIN32}
+function CreateIcon(hInstance: HINST; nWidth, nHeight: Integer;
+  cPlanes, cBitsPixel: Byte; lpbANDbits, lpbXORbits: Pointer): HICON; stdcall; external user32 name 'CreateIcon';
+
+procedure GDIError;
+var
+  ErrorCode: Integer;
+  Buf: array [Byte] of Char;
+begin
+  ErrorCode := GetLastError;
+  if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil,
+    ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then
+    raise EOutOfResources.Create(Buf)
+  else
+    OutOfResources;
+end;
+
+function DupBits(Src: HBITMAP; Size: TPoint; Mono: Boolean): HBITMAP;
+var
+  DC, Mem1, Mem2: HDC;
+  Old1, Old2: HBITMAP;
+  Bitmap: Windows.TBitmap;
+begin
+  Mem1 := CreateCompatibleDC(0);
+  Mem2 := CreateCompatibleDC(0);
+
+  try
+    GetObject(Src, SizeOf(Bitmap), @Bitmap);
+    if Mono then
+      Result := CreateBitmap(Size.X, Size.Y, 1, 1, nil)
+    else
+    begin
+      DC := GetDC(0);
+      if DC = 0 then GDIError;
+      try
+        Result := CreateCompatibleBitmap(DC, Size.X, Size.Y);
+        if Result = 0 then GDIError;
+      finally
+        ReleaseDC(0, DC);
+      end;
+    end;
+
+    if Result <> 0 then
+    begin
+      Old1 := SelectObject(Mem1, Src);
+      Old2 := SelectObject(Mem2, Result);
+
+      StretchBlt(Mem2, 0, 0, Size.X, Size.Y, Mem1, 0, 0, Bitmap.bmWidth,
+        Bitmap.bmHeight, SrcCopy);
+      if Old1 <> 0 then SelectObject(Mem1, Old1);
+      if Old2 <> 0 then SelectObject(Mem2, Old2);
+    end;
+  finally
+    DeleteDC(Mem1);
+    DeleteDC(Mem2);
+  end;
+end;
+
+function GDICheck(Value: Integer): Integer;
+begin
+  if Value = 0 then GDIError;
+  Result := Value;
+end;
+
+function GetDInColors(BitCount: Word): Integer;
+begin
+  case BitCount of
+    1, 4, 8: Result := 1 shl BitCount;
+  else
+    Result := 0;
+  end;
+end;
+
+function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
+begin
+  Dec(Alignment);
+  Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
+  Result := Result div 8;
+end;
+
+procedure TwoBitsFromDIB(var BI: TBitmapInfoHeader; var XorBits, AndBits: HBITMAP;
+  const IconSize: TPoint);
+type
+  PLongArray = ^TLongArray;
+  TLongArray = array[0..1] of Longint;
+var
+  Temp: HBITMAP;
+  NumColors: Integer;
+  DC: HDC;
+  Bits: Pointer;
+  Colors: PLongArray;
+begin
+  with BI do
+  begin
+    biHeight := biHeight shr 1; { Size in record is doubled }
+    biSizeImage := BytesPerScanline(biWidth, biBitCount, 32) * biHeight;
+    NumColors := GetDInColors(biBitCount);
+  end;
+  DC := GetDC(0);
+  if DC = 0 then OutOfResources;
+  try
+    Bits := Pointer(Longint(@BI) + SizeOf(BI) + NumColors * SizeOf(TRGBQuad));
+    Temp := GDICheck(CreateDIBitmap(DC, BI, CBM_INIT, Bits, PBitmapInfo(@BI)^, DIB_RGB_COLORS));
+    try
+      XorBits := DupBits(Temp, IconSize, False);
+    finally
+      DeleteObject(Temp);
+    end;
+    with BI do
+    begin
+      Inc(Longint(Bits), biSizeImage);
+      biBitCount := 1;
+      biSizeImage := BytesPerScanline(biWidth, biBitCount, 32) * biHeight;
+      biClrUsed := 2;
+      biClrImportant := 2;
+    end;
+    Colors := Pointer(Longint(@BI) + SizeOf(BI));
+    Colors^[0] := 0;
+    Colors^[1] := $FFFFFF;
+    Temp := GDICheck(CreateDIBitmap(DC, BI, CBM_INIT, Bits, PBitmapInfo(@BI)^, DIB_RGB_COLORS));
+    try
+      AndBits := DupBits(Temp, IconSize, True);
+    finally
+      DeleteObject(Temp);
+    end;
+  finally
+    ReleaseDC(0, DC);
+  end;
+end;
+
+procedure ReadIcon(Stream: TStream; var Icon: HICON; ImageCount: Integer;
+  StartOffset: Integer; const RequestedSize: TPoint; var IconSize: TPoint);
+type
+  PIconRecArray = ^TIconRecArray;
+  TIconRecArray = array[0..300] of TIconRec;
+var
+  List: PIconRecArray;
+  HeaderLen, Length: Integer;
+  BitsPerPixel: Word;
+  Colors, BestColor, C1, N, Index: Integer;
+  DC: HDC;
+  BI: PBitmapInfoHeader;
+  ResData: Pointer;
+  XorBits, AndBits: HBITMAP;
+  XorInfo, AndInfo: Windows.TBitmap;
+  XorMem, AndMem: Pointer;
+  XorLen, AndLen: Integer;
+
+  function AdjustColor(I: Integer): Integer;
+  begin
+    if I = 0 then
+      Result := MaxInt
+    else
+      Result := I;
+  end;
+
+  function BetterSize(const Old, New: TIconRec): Boolean;
+  var
+    NewX, NewY, OldX, OldY: Integer;
+  begin
+    NewX := New.Width - IconSize.X;
+    NewY := New.Height - IconSize.Y;
+    OldX := Old.Width - IconSize.X;
+    OldY := Old.Height - IconSize.Y;
+    Result := (Abs(NewX) <= Abs(OldX)) and ((NewX <= 0) or (NewX <= OldX)) and
+       (Abs(NewY) <= Abs(OldY)) and ((NewY <= 0) or (NewY <= OldY));
+  end;
+
+begin
+  HeaderLen := SizeOf(TIconRec) * ImageCount;
+  List := AllocMem(HeaderLen);
+  try
+    Stream.Read(List^, HeaderLen);
+    if (RequestedSize.X or RequestedSize.Y) = 0 then
+    begin
+      IconSize.X := GetSystemMetrics(SM_CXICON);
+      IconSize.Y := GetSystemMetrics(SM_CYICON);
+    end
+    else
+      IconSize := RequestedSize;
+    DC := GetDC(0);
+    if DC = 0 then OutOfResources;
+    try
+      BitsPerPixel := GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL);
+      if BitsPerPixel > 8 then
+        Colors := MaxInt
+      else
+        Colors := 1 shl BitsPerPixel;
+    finally
+      ReleaseDC(0, DC);
+    end;
+
+    { Find the image that most closely matches (<=) the current screen color
+      depth and the requested image size.  }
+    Index := 0;
+    BestColor := AdjustColor(List^[0].Colors);
+    for N := 1 to ImageCount-1 do
+    begin
+      C1 := AdjustColor(List^[N].Colors);
+      if (C1 <= Colors) and (C1 >= BestColor) and
+        BetterSize(List^[Index], List^[N]) then
+      begin
+        Index := N;
+        BestColor := C1;
+      end;
+    end;
+
+    with List^[Index] do
+    begin
+      IconSize.X := Width;
+      IconSize.Y := Height;
+      BI := AllocMem(DIBSize);
+      try
+        Stream.Seek(DIBOffset  - (HeaderLen + StartOffset), 1);
+        Stream.Read(BI^, DIBSize);
+        TwoBitsFromDIB(BI^, XorBits, AndBits, IconSize);
+        GetObject(AndBits, SizeOf(Windows.TBitmap), @AndInfo);
+        GetObject(XorBits, SizeOf(Windows.TBitmap), @XorInfo);
+        with AndInfo do
+          AndLen := bmWidthBytes * bmHeight * bmPlanes;
+        with XorInfo do
+          XorLen :=  bmWidthBytes * bmHeight * bmPlanes;
+        Length := AndLen + XorLen;
+        ResData := AllocMem(Length);
+        try
+          AndMem := ResData;
+          with AndInfo do
+            XorMem := Pointer(Longint(ResData) + AndLen);
+          GetBitmapBits(AndBits, AndLen, AndMem);
+          GetBitmapBits(XorBits, XorLen, XorMem);
+          DeleteObject(XorBits);
+          DeleteObject(AndBits);
+          Icon := CreateIcon(HInstance, IconSize.X, IconSize.Y,
+            XorInfo.bmPlanes, XorInfo.bmBitsPixel, AndMem, XorMem);
+          if Icon = 0 then GDIError;
+        finally
+          FreeMem(ResData, Length);
+        end;
+      finally
+        FreeMem(BI, DIBSize);
+      end;
+    end;
+  finally
+    FreeMem(List, HeaderLen);
+  end;
+end;
+
+procedure OutOfResources;
+begin
+  raise Exception.Create('SOutOfResources');
+end;
+{$ENDIF}
+
+function CreateArrowBitmap:TBitmap;
+begin
+  {$IFNDEF RX_USE_LAZARUS_RESOURCE}
+  Result:=CreateResBitmap('rxbtn_downarrow');
+(*  Result := TBitmap.Create;
+  try
+    try
+      C := TPortableNetworkGraphic.Create;
+      C.LoadFromResourceName(hInstance, 'rxbtn_downarrow');
+      Result.Assign(C);
+    finally
+      C.Free;
+    end;
+  except
+    Result.Free;
+    raise;
+  end; *)
+  {$ELSE}
+  Result:=LoadLazResBitmapImage('rxbtn_downarrow')
+  {$ENDIF}
+end;
+
+function CreateResBitmap(const AResName: string): TBitmap;
+var
+  C : TCustomBitmap;
+begin
+  Result := TBitmap.Create;
+  try
+    try
+      C := TPortableNetworkGraphic.Create;
+      C.LoadFromResourceName(hInstance, AResName);
+      Result.Assign(C);
+    finally
+      C.Free;
+    end;
+  except
+    Result.Free;
+    raise;
+  end;
+end;
+
+//Code from DBGrid
+function LoadLazResBitmapImage(const ResName: string): TBitmap;
+var
+  C: TCustomBitmap;
+begin
+  C := CreateBitmapFromLazarusResource(ResName);
+  if C<>nil then
+  begin
+    Result := TBitmap.Create;
+    Result.Assign(C);
+    C.Free;
+  end
+  else
+    Result:=nil;
+end;
+
+function GetWorkingCanvas(const Canvas: TCanvas): TCanvas;
+var
+  DC: HDC;
+begin
+  if (Canvas=nil) or (not Canvas.HandleAllocated) then
+  begin
+    DC := GetDC(0);
+    Result := TCanvas.Create;
+    Result.Handle := DC;
+  end
+  else
+    Result := Canvas;
+end;
+
+
+procedure FreeWorkingCanvas(canvas: TCanvas);
+begin
+  ReleaseDC(0, Canvas.Handle);
+  Canvas.Free;
+end;
+
+procedure RaiseIndexOutOfBounds(Control: TControl; Items:TStrings; Index: integer);
+begin
+  raise Exception.CreateFmt(rsIndexOutOfBounds,
+                            [Control.Name, Index, Items.Count - 1]);
+end;
+
+const
+  ALIGN_FLAGS_HEADER: array[TAlignment] of integer =
+    (DT_LEFT or {DT_EXPANDTABS or} DT_NOPREFIX,
+    DT_RIGHT or {DT_EXPANDTABS or }DT_NOPREFIX,
+    DT_CENTER or {DT_EXPANDTABS or }DT_NOPREFIX);
+
+procedure WriteTextHeader(ACanvas: TCanvas; ARect: TRect; const Text: string; Alignment: TAlignment);
+var
+  DrawRect: TRect;
+  W, CnvW: integer;
+begin
+(*
+dec(ARect.Right, constCellPadding);
+case Canvas.TextStyle.Alignment of
+  Classes.taLeftJustify: Inc(ARect.Left, constCellPadding);
+  Classes.taRightJustify: Dec(ARect.Right, 1);
+end;
+case Canvas.TextStyle.Layout of
+  tlTop: Inc(ARect.Top, constCellPadding);
+  tlBottom: Dec(ARect.Bottom, constCellPadding);
+end;
+
+if ARect.Right<ARect.Left then
+  ARect.Right:=ARect.Left;
+if ARect.Left>ARect.Right then
+  ARect.Left:=ARect.Right;
+if ARect.Bottom<ARect.Top then
+  ARect.Bottom:=ARect.Top;
+if ARect.Top>ARect.Bottom then
+  ARect.Top:=ARect.Bottom;
+
+if (ARect.Left<>ARect.Right) and (ARect.Top<>ARect.Bottom) then
+*)
+
+
+  DrawRect := Rect(ARect.Left + constCellPadding, ARect.Top + constCellPadding, ARect.Right - constCellPadding, ARect.Bottom - constCellPadding);
+
+  CnvW := Max(DrawRect.Right - DrawRect.Left, 1);
+  W := (ACanvas.TextWidth(Text) div CnvW) + 1;
+
+  DrawRect.Top := ((ARect.Top + ARect.Bottom) div 2) - W * ACanvas.TextHeight('Wg') div 2;
+  if DrawRect.Top < ARect.Top + 1 then
+    DrawRect.Top := ARect.Top + 1;
+
+  SetBkMode(ACanvas.Handle, TRANSPARENT);
+  DrawText(ACanvas.Handle, PChar(Text), Length(Text), DrawRect,
+    //    DT_VCENTER or  DT_WORDBREAK or DT_CENTER
+    ALIGN_FLAGS_HEADER[Alignment] {or DT_VCENTER or  DT_END_ELLIPSIS } or DT_WORDBREAK
+    );
+end;
+
+initialization
+{$IFDEF RX_USE_LAZARUS_RESOURCE}
+  LazarusResources.Add('rxbtn_downarrow','XPM',[
+  '/* XPM */'#13#10'static char * btn_downarrow_xpm[] = {'#13#10'"5 3 2 1",'#13
+  +#10'" '#9'c None",'#13#10'".'#9'c #000000",'#13#10'".....",'#13#10'" ... ",'
+  +#13#10'"  .  "};'#13#10]);
+{$ENDIF}
+
+end.
+
+

RXLib/rxcontrols/rxlogin.lfm

@@ -0,0 +1,376 @@
+object RxLoginForm: TRxLoginForm
+  Cursor = crArrow
+  Left = 458
+  Height = 203
+  Top = 193
+  Width = 455
+  ActiveControl = UserNameEdit
+  BorderIcons = [biSystemMenu, biHelp]
+  Caption = 'RxLoginForm'
+  ClientHeight = 203
+  ClientWidth = 455
+  FormStyle = fsStayOnTop
+  OnCreate = FormCreate
+  OnShow = FormShow
+  Position = poScreenCenter
+  LCLVersion = '0.9.29'
+  object AppIcon: TImage
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    Left = 6
+    Height = 32
+    Top = 6
+    Width = 32
+    AutoSize = True
+    BorderSpacing.Around = 6
+  end
+  object KeyImage: TImage
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    Left = 6
+    Height = 32
+    Top = 6
+    Width = 32
+    AutoSize = True
+    BorderSpacing.Around = 6
+    Picture.Data = {
+      055449636F6EBE1000000000010001002020000001002000A810000016000000
+      2800000020000000400000000100200000000000001000006400000064000000
+      0000000000000000000000FF000000FF000000FF000000FF000000FF000000FF
+      000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF
+      000000FF000000FF000000FF000000FF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FFFFFFFFFF
+      000000FF000000FFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFFFFFFFFFF808080FF000000FF000000FF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FFFFFFFFFF
+      000000FF000000FFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFF808080FF000000FF808080FF000000FF
+      000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000FFFFFFFFFF
+      000000FF000000FFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFF000000FF000000FFFFFFFFFFFFFFFFFF
+      000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF
+      000000FF000000FF000000FFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFF000000FF000000FFFFFFFFFFFFFFFFFF
+      000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF
+      000000FF000000FF000000FFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFF808080FF000000FF808080FF000000FF
+      000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFFFFFFFFFF808080FF000000FF000000FF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000808080FF808080FF808080FF808080FF808080FF808080FF
+      808080FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF
+      808080FF808080FF808080FF808080FF000000FF000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000000000000000000000000000000000000000000000000000
+      0000000000000000
+    }
+  end
+  object HintLabel: TLabel
+    AnchorSideLeft.Control = AppIcon
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = Owner
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 44
+    Height = 18
+    Top = 6
+    Width = 405
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Around = 6
+    Caption = 'HintLabel'
+    ParentColor = False
+    ShowAccelChar = False
+  end
+  object UserNameLabel: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideBottom.Control = UserNameEdit
+    AnchorSideBottom.Side = asrBottom
+    Left = 6
+    Height = 18
+    Top = 65
+    Width = 73
+    Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 6
+    Caption = 'UserName'
+    FocusControl = UserNameEdit
+    ParentColor = False
+  end
+  object PasswordLabel: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideBottom.Control = PasswordEdit
+    AnchorSideBottom.Side = asrBottom
+    Left = 6
+    Height = 18
+    Top = 100
+    Width = 67
+    Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 6
+    Caption = 'Password'
+    FocusControl = PasswordEdit
+    ParentColor = False
+  end
+  object AppTitleLabel: TLabel
+    AnchorSideLeft.Control = AppIcon
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = HintLabel
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 44
+    Height = 18
+    Top = 30
+    Width = 405
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Around = 6
+    Caption = 'AppTitleLabel'
+    ParentColor = False
+    ShowAccelChar = False
+  end
+  object DataBaseLabel: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideBottom.Control = CustomCombo
+    AnchorSideBottom.Side = asrBottom
+    Left = 6
+    Height = 18
+    Top = 137
+    Width = 67
+    Anchors = [akLeft, akBottom]
+    BorderSpacing.Left = 6
+    Caption = 'Database'
+    FocusControl = CustomCombo
+    ParentColor = False
+  end
+  object UserNameEdit: TEdit
+    AnchorSideLeft.Control = UserNameLabel
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = AppTitleLabel
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Cursor = crIBeam
+    Left = 97
+    Height = 29
+    Top = 54
+    Width = 352
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Left = 12
+    BorderSpacing.Around = 6
+    TabOrder = 0
+  end
+  object PasswordEdit: TEdit
+    AnchorSideLeft.Control = UserNameEdit
+    AnchorSideTop.Control = UserNameEdit
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = UserNameEdit
+    AnchorSideRight.Side = asrBottom
+    Cursor = crIBeam
+    Left = 97
+    Height = 29
+    Top = 89
+    Width = 352
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 6
+    EchoMode = emPassword
+    PasswordChar = '*'
+    TabOrder = 1
+  end
+  object CustomCombo: TComboBox
+    AnchorSideLeft.Control = UserNameEdit
+    AnchorSideTop.Control = PasswordEdit
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = UserNameEdit
+    AnchorSideRight.Side = asrBottom
+    Left = 97
+    Height = 31
+    Top = 124
+    Width = 352
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 6
+    ItemHeight = 0
+    Style = csDropDownList
+    TabOrder = 2
+  end
+  object btnOK: TBitBtn
+    AnchorSideLeft.Control = PasswordEdit
+    AnchorSideTop.Control = btnCancel
+    AnchorSideRight.Control = btnCancel
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 187
+    Height = 36
+    Top = 161
+    Width = 60
+    Anchors = [akTop, akRight, akBottom]
+    AutoSize = True
+    BorderSpacing.Right = 6
+    BorderSpacing.Bottom = 6
+    BorderSpacing.InnerBorder = 2
+    Caption = '&ОК'
+    Default = True
+    Kind = bkOK
+    ModalResult = 1
+    OnClick = btnOKClick
+    TabOrder = 3
+  end
+  object btnCancel: TBitBtn
+    AnchorSideTop.Control = CustomCombo
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = btnHelp
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 253
+    Height = 36
+    Top = 161
+    Width = 95
+    Anchors = [akRight, akBottom]
+    AutoSize = True
+    BorderSpacing.Around = 6
+    BorderSpacing.InnerBorder = 2
+    Cancel = True
+    Caption = 'Отмена'
+    Kind = bkCancel
+    ModalResult = 2
+    TabOrder = 4
+  end
+  object btnHelp: TBitBtn
+    AnchorSideTop.Control = btnCancel
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 354
+    Height = 36
+    Top = 161
+    Width = 95
+    Anchors = [akTop, akRight, akBottom]
+    AutoSize = True
+    BorderSpacing.Right = 6
+    BorderSpacing.Bottom = 6
+    Caption = '&Справка'
+    Kind = bkHelp
+    TabOrder = 5
+  end
+  object btnMore: TBitBtn
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = btnCancel
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 6
+    Height = 36
+    Top = 161
+    Width = 78
+    Anchors = [akTop, akLeft, akBottom]
+    AutoSize = True
+    BorderSpacing.Left = 6
+    BorderSpacing.Bottom = 6
+    Caption = 'More >>'
+    OnClick = btnMoreClick
+    TabOrder = 6
+  end
+end

RXLib/rxcontrols/rxlogin.pas

@@ -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.

RXLib/rxcontrols/rxmdi.pas

@@ -0,0 +1,915 @@
+{ RxMDI 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 RxMDI;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Buttons, Menus, ExtCtrls, Graphics, Controls;
+
+type
+  TRxMDITaskOption = (rxtoMidleClickClose);
+  TRxMDITaskOptions = set of TRxMDITaskOption;
+
+  TRxMDIPanel = class;
+  TRxMDITasks = class;
+
+  TRxMDIPanelChangeCurrentChild = procedure (Sender:TRxMDIPanel; AForm:TForm) of object;
+
+  { TRxMDIButton }
+
+  TRxMDIButton = class(TSpeedButton)
+  private
+    FNavForm: TForm;
+    FActiveControl:TWinControl;
+    FNavPanel:TRxMDITasks;
+    procedure SetRxMDIForm(AValue: TForm);
+    procedure DoCreateMenuItems;
+
+    procedure DoCloseMenu(Sender: TObject);
+    procedure DoCloseAllMenu(Sender: TObject);
+    procedure DoCloseAllExcepThisMenu(Sender: TObject);
+    procedure DoActivateMenu(Sender: TObject);
+    procedure DoCreateButtonImage;
+  private
+    FMenu:TPopupMenu;
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+  protected
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  public
+    constructor CreateButton(AOwner:TRxMDITasks; AForm:TForm);
+    procedure Click; override; // make Click public
+    procedure UpdateCaption;
+    property NavForm:TForm read FNavForm write SeTRxMDIForm;
+  end;
+
+  { TRxMDITasks }
+
+  TRxMDITasks = class(TCustomPanel)
+  private
+    FBtnScrollLeft:TSpeedButton;
+    FBtnScrollRigth:TSpeedButton;
+    FMainPanel: TRxMDIPanel;
+    FOptions: TRxMDITaskOptions;
+    function GetFlatButton: boolean;
+    procedure SetFlatButton(AValue: boolean);
+    procedure UpdateScrollBtnStatus;
+    procedure ScrollLeftExecute(Sender: TObject);
+    procedure ScrollRigthExecute(Sender: TObject);
+    procedure ShowHiddenBtnOnResize;
+    procedure ChildWindowsShowLast;
+    procedure DoCloseAll(AIgnoreBtn:TRxMDIButton);
+  protected
+    procedure Paint; override;
+    procedure Resize; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure AddButton(Btn:TRxMDIButton);
+    procedure ShowWindow(F:TForm);
+    property MainPanel:TRxMDIPanel read FMainPanel write FMainPanel;
+  published
+    property Align;
+    property ShowHint;
+    property Color;
+    property ParentShowHint;
+    property FlatButton:boolean read GetFlatButton write SetFlatButton;
+    property Options:TRxMDITaskOptions read FOptions write FOptions;
+  end;
+
+  { TRxMDICloseButton }
+
+  TRxMDICloseButton = class(TCustomSpeedButton)
+  private
+    FInfoLabel:TBoundLabel;
+    FLabelSpacing:integer;
+    FMDIPanel:TRxMDIPanel;
+    FShowInfoLabel: boolean;
+    procedure SetShowInfoLabel(AValue: boolean);
+  protected
+    procedure SetParent(AParent: TWinControl); override;
+    procedure Loaded; override;
+    procedure DoPositionLabel;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure CreateInternalLabel;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Align;
+    property Anchors;
+    property Glyph;
+    property Flat;
+    property ShowInfoLabel:boolean read FShowInfoLabel write SetShowInfoLabel default true;
+  end;
+
+  { TRxMDIPanel }
+
+  TRxMDIPanel = class(TCustomPanel)
+  private
+    FCurrentChildWindow: TForm;
+    FCloseButton: TRxMDICloseButton;
+    FHideCloseButton: boolean;
+    FOnChangeCurrentChild: TRxMDIPanelChangeCurrentChild;
+    FTaskPanel: TRxMDITasks;
+    procedure SetCurrentChildWindow(AValue: TForm);
+    procedure navCloseButtonClick(Sender: TObject);
+    procedure SetHideCloseButton(AValue: boolean);
+    procedure SetRxMDICloseButton(AValue: TRxMDICloseButton);
+    procedure SetTaskPanel(AValue: TRxMDITasks);
+    function MDIButtonByForm(AForm:TForm):TRxMDIButton;
+    procedure HideCurrentWindow;
+    procedure ScreenEventRemoveForm(Sender: TObject; Form: TCustomForm);
+    procedure DoOnChangeCurrentChild(AForm:TForm);
+  protected
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure Loaded; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure ShowWindow(F:TForm);
+
+    procedure ChildWindowsAdd(F:TForm);
+    procedure ChildWindowsCreate(var AForm; FC:TFormClass);
+    procedure ChildWindowsUpdateCaption(F:TForm);
+    procedure CloseAll;
+
+    property CurrentChildWindow:TForm read FCurrentChildWindow write SetCurrentChildWindow;
+  published
+    property CloseButton:TRxMDICloseButton read FCloseButton write SetRxMDICloseButton;
+    property TaskPanel:TRxMDITasks read FTaskPanel write SetTaskPanel;
+
+    property Align;
+    property BevelInner;
+    property BevelOuter;
+    property ShowHint;
+    property ParentShowHint;
+    property HideCloseButton:boolean read FHideCloseButton write SetHideCloseButton;
+    property OnChangeCurrentChild:TRxMDIPanelChangeCurrentChild read FOnChangeCurrentChild write FOnChangeCurrentChild;
+  end;
+
+implementation
+uses LResources, rxlclutils, rxconst;
+
+
+{ TRxMDICloseButton }
+
+procedure TRxMDICloseButton.SetShowInfoLabel(AValue: boolean);
+begin
+  if FShowInfoLabel=AValue then Exit;
+  FShowInfoLabel:=AValue;
+  if Assigned(FInfoLabel) then
+    FInfoLabel.Visible:=FShowInfoLabel;
+end;
+
+procedure TRxMDICloseButton.SetParent(AParent: TWinControl);
+begin
+  inherited SetParent(AParent);
+  DoPositionLabel;
+end;
+
+procedure TRxMDICloseButton.Loaded;
+begin
+  inherited Loaded;
+  DoPositionLabel;
+end;
+
+procedure TRxMDICloseButton.DoPositionLabel;
+begin
+  if FInfoLabel = nil then exit;
+  if Parent<>nil then
+    Parent.DisableAlign;
+  //DebugLn(['TCustomLabeledEdit.DoPositionLabel ']);
+  FInfoLabel.Parent := Parent;
+  FInfoLabel.Visible := Visible and FShowInfoLabel;
+{  case FLabelPosition of
+    lpAbove:
+      begin
+        FInfoLabel.AnchorParallel(akLeft,0,Self);
+        FInfoLabel.AnchorToCompanion(akBottom,FLabelSpacing,Self);
+      end;
+    lpBelow:
+      begin
+        FInfoLabel.AnchorParallel(akLeft,0,Self);
+        FInfoLabel.AnchorToCompanion(akTop,FLabelSpacing,Self);
+      end;
+    lpLeft :
+      begin}
+        FInfoLabel.AnchorToCompanion(akRight,FLabelSpacing,Self);
+        FInfoLabel.AnchorVerticalCenterTo(Self);
+{      end;
+    lpRight:
+      begin
+        FInfoLabel.AnchorToCompanion(akLeft,FLabelSpacing,Self);
+        FInfoLabel.AnchorVerticalCenterTo(Self);
+      end;
+  end;}
+  if Parent<>nil then
+    Parent.EnableAlign;
+end;
+
+procedure TRxMDICloseButton.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (AComponent = FInfoLabel) and (Operation = opRemove) then
+    FInfoLabel := nil
+  else
+  if (AComponent = FMDIPanel) and (Operation = opRemove) then
+  begin
+    FMDIPanel:=nil;
+    OnClick:=nil;
+  end
+end;
+
+procedure TRxMDICloseButton.CreateInternalLabel;
+begin
+  if FInfoLabel<>nil then exit;
+  FInfoLabel := TBoundLabel.Create(Self);
+  FInfoLabel.ControlStyle := FInfoLabel.ControlStyle + [csNoDesignSelectable];
+  FInfoLabel.Visible:=FShowInfoLabel;
+end;
+
+constructor TRxMDICloseButton.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+//  FLabelPosition := lpAbove;
+  FLabelSpacing := 6;
+  FShowInfoLabel:=true;
+  CreateInternalLabel;
+  Glyph:=LoadLazResBitmapImage('RxMDICloseIcon');
+end;
+
+{ TRxMDIPanel }
+
+procedure TRxMDIPanel.SetCurrentChildWindow(AValue: TForm);
+begin
+  FCurrentChildWindow:=AValue;
+  if Assigned(FCloseButton) then
+  begin
+    FCloseButton.Enabled:=Assigned(FCurrentChildWindow);
+    if FHideCloseButton then
+      FCloseButton.Visible:=FCloseButton.Enabled;
+
+    if FCloseButton.Enabled then
+      FCloseButton.FInfoLabel.Caption:=FCurrentChildWindow.Caption
+    else
+      FCloseButton.FInfoLabel.Caption:='';
+  end;
+
+  if Assigned(TaskPanel) then
+    TaskPanel.Visible:=Assigned(FCurrentChildWindow);
+end;
+
+procedure TRxMDIPanel.navCloseButtonClick(Sender: TObject);
+begin
+  if Assigned(FCurrentChildWindow) then
+  begin
+    if not (csDestroying in FCurrentChildWindow.ComponentState) then
+      FCurrentChildWindow.Close
+  end;
+end;
+
+procedure TRxMDIPanel.SetHideCloseButton(AValue: boolean);
+begin
+  if FHideCloseButton=AValue then Exit;
+  FHideCloseButton:=AValue;
+
+  if Assigned(FCloseButton) then
+    if FHideCloseButton then
+      FCloseButton.Visible:=FCloseButton.Enabled
+    else
+      FCloseButton.Visible:=true;
+
+end;
+
+procedure TRxMDIPanel.SetRxMDICloseButton(AValue: TRxMDICloseButton);
+begin
+  if FCloseButton=AValue then Exit;
+  if Assigned(FCloseButton) then
+  begin
+    FCloseButton.OnClick:=nil;
+    FCloseButton.FMDIPanel:=nil;
+  end;
+
+  FCloseButton:=AValue;
+
+  if Assigned(FCloseButton) then
+  begin
+    FCloseButton.OnClick:=@navCloseButtonClick;
+    FCloseButton.FMDIPanel:=Self;
+  end;
+end;
+
+procedure TRxMDIPanel.SetTaskPanel(AValue: TRxMDITasks);
+begin
+  if FTaskPanel=AValue then Exit;
+  FTaskPanel:=AValue;
+  if Assigned(FTaskPanel) then
+    FTaskPanel.FMainPanel:=Self;
+end;
+
+function TRxMDIPanel.MDIButtonByForm(AForm: TForm): TRxMDIButton;
+var
+  i:integer;
+begin
+  Result:=nil;
+  if not Assigned(FTaskPanel) then
+    exit;
+  for i:=0 to FTaskPanel.ComponentCount -1 do
+  begin
+    if (FTaskPanel.Components[i] is TRxMDIButton) and (TRxMDIButton(FTaskPanel.Components[i]).NavForm = AForm) then
+    begin
+      Result:=TRxMDIButton(FTaskPanel.Components[i]);
+      exit;
+    end;
+  end;
+end;
+
+procedure TRxMDIPanel.HideCurrentWindow;
+var
+  MB:TRxMDIButton;
+begin
+  if Assigned(FCurrentChildWindow) and (FCurrentChildWindow.Visible) then
+  begin
+    MB:=MDIButtonByForm(FCurrentChildWindow);
+    if Assigned(MB) then
+      MB.FActiveControl:=Application.MainForm.ActiveControl;
+    FCurrentChildWindow.Hide;
+  end;
+end;
+
+procedure TRxMDIPanel.ScreenEventRemoveForm(Sender: TObject; Form: TCustomForm);
+var
+  i: Integer;
+begin
+  if Assigned(FTaskPanel) then
+  begin
+    for i:=0 to FTaskPanel.ComponentCount-1 do
+    begin;
+      if (FTaskPanel.Components[i] is TRxMDIButton) and (TRxMDIButton(FTaskPanel.Components[i]).NavForm = Form) then
+        TRxMDIButton(FTaskPanel.Components[i]).FActiveControl:=nil;
+    end;
+  end;
+end;
+
+procedure TRxMDIPanel.DoOnChangeCurrentChild(AForm: TForm);
+begin
+  if Assigned(FOnChangeCurrentChild) then
+    FOnChangeCurrentChild(Self, AForm);
+end;
+
+procedure TRxMDIPanel.Notification(AComponent: TComponent; Operation: TOperation
+  );
+begin
+  inherited Notification(AComponent, Operation);
+  if (AComponent = FCloseButton) and (Operation = opRemove) then
+    FCloseButton := nil
+  else
+  if (AComponent = FTaskPanel) and (Operation = opRemove) then
+    FTaskPanel:=nil;
+end;
+
+procedure TRxMDIPanel.Loaded;
+begin
+  inherited Loaded;
+  CurrentChildWindow:=nil;
+end;
+
+constructor TRxMDIPanel.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  Caption:='';
+  Align:=alClient;
+  BevelOuter:=bvLowered;
+
+  Screen.AddHandlerRemoveForm(@ScreenEventRemoveForm);
+end;
+
+destructor TRxMDIPanel.Destroy;
+begin
+  Screen.RemoveHandlerRemoveForm(@ScreenEventRemoveForm);
+  inherited Destroy;
+end;
+
+procedure TRxMDIPanel.ShowWindow(F: TForm);
+begin
+  TaskPanel.ShowWindow(F);
+end;
+
+procedure TRxMDIPanel.ChildWindowsAdd(F: TForm);
+var
+  B:TRxMDIButton;
+begin
+  Assert(Assigned(TaskPanel), sErrorLinkedTaskPanel);
+  HideCurrentWindow;
+  F.BorderStyle:=bsNone;
+  F.Align:=alClient;
+  F.Parent:=Self;
+  F.Visible:=true;
+  F.BringToFront;
+  if Assigned(Application) and Assigned(Application.MainForm) then
+    Application.MainForm.ActiveControl:=F;
+
+  B:=TRxMDIButton.CreateButton(TaskPanel, F);
+  DoOnChangeCurrentChild(F);
+end;
+
+procedure TRxMDIPanel.ChildWindowsCreate(var AForm; FC: TFormClass);
+var
+  FForm:TForm absolute AForm;
+begin
+  if not Assigned(FForm) then
+  begin
+    HideCurrentWindow;
+    FForm:=FC.Create(Self);
+    ChildWindowsAdd(FForm);
+  end
+  else
+  begin
+    ShowWindow(FForm);
+    DoOnChangeCurrentChild(FForm);
+  end;
+
+end;
+
+procedure TRxMDIPanel.ChildWindowsUpdateCaption(F: TForm);
+var
+  i:integer;
+  B:TRxMDIButton;
+begin
+  if (FCurrentChildWindow = F) and Assigned(FCloseButton) and FCloseButton.Enabled then
+    FCloseButton.FInfoLabel.Caption:=F.Caption;
+
+  for i:=0 to TaskPanel.ComponentCount -1 do
+  begin
+    if TRxMDIButton(TaskPanel.Components[i]).NavForm = F then
+    begin
+      TRxMDIButton(TaskPanel.Components[i]).UpdateCaption;
+      exit;
+    end;
+  end;
+end;
+
+procedure TRxMDIPanel.CloseAll;
+begin
+  if Assigned(FTaskPanel) then
+    FTaskPanel.DoCloseAll(nil);
+end;
+
+
+{ TRxMDITasks }
+
+procedure TRxMDITasks.UpdateScrollBtnStatus;
+var
+  i, W:Integer;
+  B:TRxMDIButton;
+begin
+  W:=FBtnScrollLeft.Width + FBtnScrollRigth.Width;
+  FBtnScrollLeft.Enabled:=false;
+  for i:=0 to ComponentCount-1 do
+  begin
+    B:=TRxMDIButton(Components[i]);
+    if not B.Visible then
+      FBtnScrollLeft.Enabled:=true
+    else
+      W:=W+B.Width + 2;
+  end;
+
+  FBtnScrollRigth.Enabled:=W > Width;
+end;
+
+function TRxMDITasks.GetFlatButton: boolean;
+begin
+  Result:=FBtnScrollLeft.Flat;
+end;
+
+procedure TRxMDITasks.SetFlatButton(AValue: boolean);
+var
+  B: TComponent;
+begin
+  FBtnScrollLeft.Flat:=AValue;
+  FBtnScrollRigth.Flat:=AValue;
+
+  for B in Self do
+    if (B is TRxMDIButton) then
+      TRxMDIButton(B).Flat:=AValue;
+end;
+
+procedure TRxMDITasks.ScrollLeftExecute(Sender: TObject);
+var
+  i:Integer;
+  B:TRxMDIButton;
+begin
+  for i:=0 to ComponentCount-1 do
+  begin
+    if (Components[i] is TRxMDIButton) then
+    begin
+      B:=TRxMDIButton(Components[i]);
+      if not B.Visible then
+      begin
+        B.Visible:=true;
+        B.Left:=FBtnScrollLeft.Width;
+        break;
+      end;
+    end;
+  end;
+
+  UpdateScrollBtnStatus;
+  Invalidate;
+end;
+
+procedure TRxMDITasks.ScrollRigthExecute(Sender: TObject);
+var
+  i:Integer;
+  B:TRxMDIButton;
+begin
+  for i:=0 to ComponentCount - 1 do
+  begin
+    if (Components[i] is TRxMDIButton) then
+    begin
+      B:=TRxMDIButton(Components[i]);
+      if B.Visible then
+      begin
+        B.Visible:=false;
+        break;
+      end;
+    end;
+  end;
+
+  UpdateScrollBtnStatus;
+  Invalidate;
+end;
+
+procedure TRxMDITasks.ShowHiddenBtnOnResize;
+begin
+
+end;
+
+procedure TRxMDITasks.ChildWindowsShowLast;
+var
+  CC:TControl;
+  i:integer;
+begin
+  if (FMainPanel.ControlCount>1) and (not Application.Terminated) then
+  begin
+    CC:=FMainPanel.Controls[FMainPanel.ControlCount-2];
+    if Assigned(CC) then
+      ShowWindow(CC as TForm)
+  end
+  else
+  begin
+    FMainPanel.CurrentChildWindow:=nil;
+    if not Application.Terminated then
+      if Assigned(FMainPanel) then
+        FMainPanel.DoOnChangeCurrentChild(nil);
+
+  end;
+//  Invalidate;
+end;
+
+procedure TRxMDITasks.DoCloseAll(AIgnoreBtn: TRxMDIButton);
+var
+  i:integer;
+begin
+  for i:=ComponentCount-1 downto 0 do
+  begin
+    if (Components[i] is TRxMDIButton) and (TRxMDIButton(Components[i]) <> AIgnoreBtn) then
+      TRxMDIButton(Components[i]).DoCloseMenu(nil);
+  end;
+  if Assigned(AIgnoreBtn) then
+    FMainPanel.CurrentChildWindow:=AIgnoreBtn.FNavForm;
+end;
+
+procedure TRxMDITasks.Paint;
+var
+  i:integer;
+  H:integer;
+  B:TRxMDIButton;
+begin
+  inherited Paint;
+  Canvas.Pen.Color:=clBlack;
+  H:=Height - 2;
+  for i:=0 to ComponentCount - 1 do
+  begin
+    if (Components[i] is TRxMDIButton) then
+    begin
+      B:=TRxMDIButton(Components[i]);
+      if (B.Visible) and (B.Left > B.Width) then
+      begin
+        Canvas.Pen.Color:=clBtnShadow;
+        Canvas.Line(B.Left - 2, 2, B.Left - 2, H);
+        Canvas.Pen.Color:=clWindow;
+        Canvas.Line(B.Left - 1, 2, B.Left - 1, H);
+      end;
+    end;
+  end;
+end;
+
+procedure TRxMDITasks.Resize;
+begin
+  inherited Resize;
+  if Assigned(FBtnScrollLeft) and Assigned(FBtnScrollRigth) then
+    UpdateScrollBtnStatus;
+end;
+
+procedure TRxMDITasks.Notification(AComponent: TComponent; Operation: TOperation
+  );
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation = opRemove) then
+  begin
+    if (AComponent = FMainPanel) then
+      FMainPanel := nil
+    else
+    if (AComponent is TRxMDIButton) then
+      Invalidate;
+  end;
+end;
+
+constructor TRxMDITasks.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  Caption:='';
+
+  FBtnScrollLeft:=TSpeedButton.Create(Self);
+  FBtnScrollLeft.Parent:=Self;
+  FBtnScrollLeft.Align:=alLeft;
+  FBtnScrollLeft.AnchorSide[akLeft].Control:=Self;
+  FBtnScrollLeft.Anchors:=[akLeft, akTop, akBottom];
+  FBtnScrollLeft.OnClick:=@ScrollLeftExecute;
+  FBtnScrollLeft.Caption:='<';
+  FBtnScrollLeft.ShowCaption:=true;
+  FBtnScrollLeft.AutoSize:=true;
+  FBtnScrollLeft.Flat:=true;
+  FBtnScrollLeft.Transparent:=false;
+
+  FBtnScrollRigth:=TSpeedButton.Create(Self);
+  FBtnScrollRigth.Parent:=Self;
+  FBtnScrollRigth.Align:=alRight;
+  FBtnScrollRigth.Anchors:=[akRight, akTop, akBottom];
+  FBtnScrollRigth.AnchorSide[akRight].Control:=Self;
+  FBtnScrollRigth.OnClick:=@ScrollRigthExecute;
+  FBtnScrollRigth.Caption:='>';
+  FBtnScrollRigth.ShowCaption:=true;
+  FBtnScrollRigth.AutoSize:=true;
+  FBtnScrollRigth.Flat:=true;
+  FBtnScrollRigth.Transparent:=false;
+
+  Align:=alBottom;
+  Height:=25;
+end;
+
+destructor TRxMDITasks.Destroy;
+begin
+  FBtnScrollRigth:=nil;
+  FBtnScrollLeft:=nil;
+  inherited Destroy;
+end;
+
+procedure TRxMDITasks.AddButton(Btn: TRxMDIButton);
+begin
+  Btn.Parent:=Self;
+  Btn.Left:=Width-1;
+  Btn.Down:=true;
+  Btn.BorderSpacing.Left:=3;
+  Btn.BorderSpacing.Right:=3;
+  Btn.Flat:=FlatButton;
+
+  FBtnScrollRigth.BringToFront;
+  FBtnScrollLeft.BringToFront;
+
+  UpdateScrollBtnStatus;
+end;
+
+procedure TRxMDITasks.ShowWindow(F: TForm);
+var
+  i:integer;
+begin
+  for i:=0 to ComponentCount -1 do
+  begin
+    if (Components[i] is TRxMDIButton) and (TRxMDIButton(Components[i]).NavForm = F) then
+    begin
+      TRxMDIButton(Components[i]).Click;
+      TRxMDIButton(Components[i]).Visible:=true;
+      exit;
+    end;
+  end;
+end;
+
+
+{ TRxMDIButton }
+
+procedure TRxMDIButton.SetRxMDIForm(AValue: TForm);
+var
+  FImageIndex:integer;
+  B:TBitmap;
+begin
+  if FNavForm=AValue then Exit;
+  FNavForm:=AValue;
+  if Assigned(FNavForm) then
+  begin
+    FNavForm.AddHandlerClose(@FormClose);
+
+    Caption:=' '+FNavForm.Caption+' ';
+    DoCreateButtonImage;
+
+    if Assigned(FNavPanel) then
+      FNavPanel.FMainPanel.CurrentChildWindow:=NavForm;
+  end;
+end;
+
+procedure TRxMDIButton.DoCreateMenuItems;
+var
+  Item: TMenuItem;
+begin
+  Item:=TMenuItem.Create(Self);
+  Item.Caption:=Caption;
+  Item.OnClick:=@DoActivateMenu;
+  FMenu.Items.Add(Item);
+
+  Item:=TMenuItem.Create(Self);
+  Item.Caption:='-';
+  FMenu.Items.Add(Item);
+
+  Item:=TMenuItem.Create(Self);
+  Item.Caption:=sCloseWindows;
+  Item.OnClick:=@DoCloseMenu;
+  FMenu.Items.Add(Item);
+
+  Item:=TMenuItem.Create(Self);
+  Item.Caption:='-';
+  FMenu.Items.Add(Item);
+
+
+  Item:=TMenuItem.Create(Self);
+  Item.Caption:=sCloseAllExceptThis;
+  Item.OnClick:=@DoCloseAllExcepThisMenu;
+  FMenu.Items.Add(Item);
+
+  Item:=TMenuItem.Create(Self);
+  Item.Caption:=sCloseAllWindows;
+  Item.OnClick:=@DoCloseAllMenu;
+  FMenu.Items.Add(Item);
+end;
+
+procedure TRxMDIButton.DoCloseMenu(Sender: TObject);
+begin
+  if Assigned(FNavForm) then
+    FNavForm.Close;
+end;
+
+procedure TRxMDIButton.DoCloseAllMenu(Sender: TObject);
+begin
+  FNavPanel.DoCloseAll(nil);
+end;
+
+procedure TRxMDIButton.DoCloseAllExcepThisMenu(Sender: TObject);
+begin
+  FNavPanel.DoCloseAll(Self);
+end;
+
+procedure TRxMDIButton.DoActivateMenu(Sender: TObject);
+begin
+  Click;
+end;
+
+procedure TRxMDIButton.DoCreateButtonImage;
+var
+  FImageIndex:integer;
+  B:TBitmap;
+begin
+  if Assigned(NavForm.Icon) and (NavForm.Icon.Count>0) then
+  begin
+    B:=TBitmap.Create;
+    try
+      B.Width:=NavForm.Icon.Width;
+      B.Height:=NavForm.Icon.Height;
+
+      B.Canvas.Brush.Color:=Color;
+      B.Canvas.FillRect(0,0, B.Width, B.Height);
+      B.Canvas.Draw(0, 0, NavForm.Icon);
+
+      Glyph.Assign(B);
+    finally
+      B.Free;
+    end;
+  end;
+end;
+
+procedure TRxMDIButton.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  if (not Assigned(FNavPanel)) or (not Assigned(FNavPanel.FMainPanel)) then
+    exit;
+
+  if FNavPanel.FMainPanel.FCurrentChildWindow = Sender then
+    FNavPanel.ChildWindowsShowLast;
+  FNavPanel.ShowHiddenBtnOnResize;
+  CloseAction:=caFree;
+  if Assigned(Owner) then
+    Owner.RemoveComponent(Self);
+  FNavPanel.FMainPanel.RemoveControl(Sender as TCustomForm);
+  Application.ReleaseComponent(Self);
+end;
+
+procedure TRxMDIButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  if Button = mbMiddle then
+  begin
+    if Assigned(Owner) then
+    begin
+      if rxtoMidleClickClose in (Owner as TRxMDITasks).Options then
+        DoCloseMenu(Self);
+    end;
+  end;
+end;
+
+procedure TRxMDIButton.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (AComponent = FActiveControl) and (Operation = opRemove) then
+    FActiveControl := nil
+end;
+
+constructor TRxMDIButton.CreateButton(AOwner: TRxMDITasks; AForm: TForm);
+begin
+  inherited Create(AOwner);
+  FNavPanel:=AOwner;
+  Align:=alLeft;
+  NavForm:=AForm;
+  AutoSize:=true;
+  Flat:=true;
+  GroupIndex:=1;
+
+  FMenu:=TPopupMenu.Create(Self);
+  FMenu.Parent:=Self;
+  PopupMenu:=FMenu;
+  DoCreateMenuItems;
+
+  AOwner.AddButton(Self);
+end;
+
+procedure TRxMDIButton.Click;
+begin
+  inherited Click;
+  if Assigned(FNavForm) then
+  begin
+    FNavPanel.FMainPanel.HideCurrentWindow;
+    FNavForm.Show;
+    FNavPanel.FMainPanel.CurrentChildWindow:=NavForm;
+    if Assigned(FActiveControl) and FActiveControl.HandleObjectShouldBeVisible then
+      FActiveControl.SetFocus;
+
+    if Assigned(FNavPanel.FMainPanel) then
+      FNavPanel.FMainPanel.DoOnChangeCurrentChild(FNavForm);
+  end;
+  Down:=true;
+end;
+
+procedure TRxMDIButton.UpdateCaption;
+begin
+  if Assigned(FNavForm) then
+    Caption:=' '+FNavForm.Caption+' '
+  else
+    Caption:='---';
+  AdjustSize;
+end;
+
+initialization
+  {$I RxMDICloseIcon.lrs}
+end.
+

RXLib/rxcontrols/rxpagemngr.pas

@@ -0,0 +1,350 @@
+{ pagemngr 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 rxpagemngr;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls;
+
+const
+  pageNull = -1;
+  DefStatusMessage = 'Step %d from %d';
+  
+type
+  TPageOwner = TPageControl;
+  TCheckPageEnabled = function (APageIndex:integer): Boolean of object;
+  TPageManagerOption = (pmoSetFormCaption, pmoSetInfoControl);
+  TPageManagerOptions = set of TPageManagerOption;
+  { TPageManager }
+
+  TPageManager = class(TComponent)
+  private
+    FNextBtn: TControl;
+    FOnCheckPageEnabled: TCheckPageEnabled;
+    FOnPageChanged: TNotifyEvent;
+    FOptions: TPageManagerOptions;
+    FPageOwner: TPageOwner;
+    FPriorBtn: TControl;
+    FSaveBtnNextClick: TNotifyEvent;
+    FSaveBtnPriorClick: TNotifyEvent;
+    FStatusControl: TControl;
+    FStatusMessage: string;
+    function GetPageCount: Integer;
+    function GetPageIndex: Integer;
+    procedure SetNextBtn(const AValue: TControl);
+    procedure SetOnCheckPageEnabled(const AValue: TCheckPageEnabled);
+    procedure SetOptions(const AValue: TPageManagerOptions);
+    procedure SetPageIndex(const AValue: Integer);
+    procedure SetPageOwner(const AValue: TPageOwner);
+    procedure SetPriorBtn(const AValue: TControl);
+    procedure BtnClickNext(Sender: TObject);
+    procedure BtnClickPrior(Sender: TObject);
+    procedure SetStatusControl(const AValue: TControl);
+    procedure SetStatusMessage(const AValue: string);
+    procedure SyncBtnNextClick(Sync: Boolean);
+    procedure SyncBtnPriorClick(Sync: Boolean);
+  protected
+    function GetPriorPageIndex(Page: Integer): Integer; virtual;
+    function GetNextPageIndex(Page: Integer): Integer; virtual;
+    procedure Loaded; override;
+    procedure Notification(AComponent: TComponent;
+      Operation: TOperation); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure CheckBtnEnabled;
+    procedure NextPage;
+    procedure PriorPage;
+    procedure PageChanged;virtual;
+    property PageCount: Integer read GetPageCount;
+    property PageIndex: Integer read GetPageIndex write SetPageIndex;
+  published
+    property PageOwner: TPageOwner read FPageOwner write SetPageOwner;
+    property NextBtn: TControl read FNextBtn write SetNextBtn;
+    property PriorBtn: TControl read FPriorBtn write SetPriorBtn;
+    property OnCheckPageEnabled:TCheckPageEnabled read FOnCheckPageEnabled write SetOnCheckPageEnabled;
+    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
+    property Options:TPageManagerOptions read FOptions write SetOptions default [];
+    property StatusControl:TControl read FStatusControl write SetStatusControl;
+    property StatusMessage:string read FStatusMessage write SetStatusMessage;
+  end;
+
+implementation
+
+{ TPageManager }
+
+procedure TPageManager.SetNextBtn(const AValue: TControl);
+begin
+  if FNextBtn=AValue then exit;
+  SyncBtnNextClick(false);
+  FNextBtn:=AValue;
+  SyncBtnNextClick(true);
+end;
+
+function TPageManager.GetPageCount: Integer;
+begin
+  if Assigned(FPageOwner) then
+    Result := FPageOwner.PageCount
+  else
+    Result := 0;
+end;
+
+function TPageManager.GetPageIndex: Integer;
+begin
+  if Assigned(PageOwner) then Result := PageOwner.ActivePageIndex
+  else Result := pageNull;
+end;
+
+procedure TPageManager.SetOnCheckPageEnabled(const AValue: TCheckPageEnabled);
+begin
+  if FOnCheckPageEnabled=AValue then exit;
+  FOnCheckPageEnabled:=AValue;
+end;
+
+procedure TPageManager.SetOptions(const AValue: TPageManagerOptions);
+begin
+  if FOptions=AValue then exit;
+  FOptions:=AValue;
+end;
+
+procedure TPageManager.SetPageIndex(const AValue: Integer);
+begin
+  if Assigned(FPageOwner) and (FPageOwner.ActivePageIndex <> AValue) then
+  begin
+    FPageOwner.ActivePageIndex:=AValue;
+    PageChanged;
+  end;
+end;
+
+procedure TPageManager.SetPageOwner(const AValue: TPageOwner);
+begin
+  if FPageOwner=AValue then exit;
+  FPageOwner:=AValue;
+end;
+
+procedure TPageManager.SetPriorBtn(const AValue: TControl);
+begin
+  if FPriorBtn=AValue then exit;
+  SyncBtnPriorClick(false);
+  FPriorBtn:=AValue;
+  SyncBtnPriorClick(true);
+end;
+
+procedure TPageManager.BtnClickNext(Sender: TObject);
+begin
+  if Assigned(FPageOwner) then
+  begin
+    FPageOwner.ActivePageIndex:=GetNextPageIndex(FPageOwner.ActivePageIndex);
+    PageChanged;
+  end;
+end;
+
+procedure TPageManager.BtnClickPrior(Sender: TObject);
+begin
+  if Assigned(FPageOwner) then
+  begin
+    FPageOwner.ActivePageIndex:=GetPriorPageIndex(FPageOwner.ActivePageIndex);
+    PageChanged;
+  end;
+end;
+
+procedure TPageManager.SetStatusControl(const AValue: TControl);
+begin
+  if FStatusControl=AValue then exit;
+  FStatusControl:=AValue;
+end;
+
+procedure TPageManager.SetStatusMessage(const AValue: string);
+begin
+  if FStatusMessage=AValue then exit;
+  FStatusMessage:=AValue;
+end;
+
+procedure TPageManager.SyncBtnNextClick(Sync: Boolean);
+begin
+  if Assigned(FNextBtn) and not (csDesigning in ComponentState) then
+  begin
+    if Sync then
+    begin
+      FSaveBtnNextClick := FNextBtn.OnClick;
+      FNextBtn.OnClick := @BtnClickNext;
+    end
+    else
+    begin
+      FNextBtn.OnClick := FSaveBtnNextClick;
+      FSaveBtnNextClick := nil;
+    end;
+  end;
+end;
+
+procedure TPageManager.SyncBtnPriorClick(Sync: Boolean);
+begin
+  if Assigned(FPriorBtn) and not (csDesigning in ComponentState) then
+  begin
+    if Sync then
+    begin
+      FSaveBtnPriorClick := FPriorBtn.OnClick;
+      FPriorBtn.OnClick := @BtnClickPrior;
+    end
+    else
+    begin
+      FPriorBtn.OnClick := FSaveBtnPriorClick;
+      FSaveBtnPriorClick := nil;
+    end;
+  end;
+end;
+
+function TPageManager.GetPriorPageIndex(Page: Integer): Integer;
+begin
+  Result:=Page;
+  while Page > 0 do
+  begin
+    Dec(Page);
+    if Assigned(FOnCheckPageEnabled) then
+    begin
+      if FOnCheckPageEnabled(Page) then
+        break
+      else
+      if Page = 0 then
+        exit;
+    end
+    else
+      break;
+  end;
+  Result:=Page;
+end;
+
+function TPageManager.GetNextPageIndex(Page: Integer): Integer;
+begin
+  Result:=Page;
+  if not Assigned(FPageOwner) then exit;
+  while Page < FPageOwner.PageCount-1  do
+  begin
+    Inc(Page);
+    if Assigned(FOnCheckPageEnabled) then
+    begin
+      if FOnCheckPageEnabled(Page) then
+        break
+      else
+      if Page = FPageOwner.PageCount then
+        exit;
+    end
+    else
+      break;
+  end;
+  Result:=Page;
+end;
+
+procedure TPageManager.PageChanged;
+var
+  S:string;
+begin
+  if Assigned(OnPageChanged) then
+    OnPageChanged(Self);
+  if FStatusMessage <> '' then
+  begin
+    S:=Format(FStatusMessage, [PageIndex+1, PageCount]);
+    if (pmoSetFormCaption in Options) and Assigned(Owner) and (Owner is TCustomForm) then
+      TCustomForm(Owner).Caption:=S;
+    if (pmoSetInfoControl in Options) and Assigned(FStatusControl) then
+      FStatusControl.Caption:=S;
+  end;
+  CheckBtnEnabled;
+end;
+
+procedure TPageManager.Loaded;
+begin
+  inherited Loaded;
+  if not (csDesigning in ComponentState) then
+  begin
+    SyncBtnNextClick(true);
+    SyncBtnPriorClick(true);
+    PageChanged;
+  end;
+end;
+
+procedure TPageManager.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation = opRemove then
+  begin
+    if AComponent = FNextBtn then
+    begin
+      FNextBtn:=nil;
+      FSaveBtnNextClick:=nil;
+    end
+    else
+    if AComponent = FPriorBtn then
+    begin
+      FPriorBtn:=nil;
+      FSaveBtnPriorClick:=nil;
+    end
+    else
+    if AComponent = FPageOwner then
+      FPageOwner:=nil
+    else
+    if AComponent = FStatusControl then
+      FStatusControl:=nil;
+  end;
+end;
+
+constructor TPageManager.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FStatusMessage:=DefStatusMessage;
+end;
+
+procedure TPageManager.CheckBtnEnabled;
+var
+  P:integer;
+begin
+  P:=PageIndex;
+  if Assigned(FNextBtn) then
+    FNextBtn.Enabled:=GetNextPageIndex(P)>P;
+  if Assigned(FPriorBtn) then
+    FPriorBtn.Enabled:=GetPriorPageIndex(P)<P;
+end;
+
+procedure TPageManager.NextPage;
+begin
+  BtnClickNext(nil);
+end;
+
+procedure TPageManager.PriorPage;
+begin
+  BtnClickPrior(nil);
+end;
+
+end.

RXLib/rxcontrols/rxpopupnotifier.pas

@@ -0,0 +1,636 @@
+{ rxPopupNotifier unit
+
+  Copyright (C) 2005-2018 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 RxPopupNotifier;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ExtCtrls, Forms, Graphics, Controls, StdCtrls, Buttons;
+
+type
+  TRxPopupNotifierItem = class;
+  TRxPopupNotifier = class;
+  TRxPopupNotifierState = (rpsInactive, rpsMaximazed, rpsShowing, rpsMinimized);
+  TRxPopupNotifierCorner = (rpcTopLeft, rpcTopRight, rpcBootomLeft, rpcBottomRight);
+
+  TRxPopupNotifierEvent = procedure(Sender:TRxPopupNotifier; AItem:TRxPopupNotifierItem) of object;
+
+  { TRxNotifierForm }
+
+  TRxNotifierForm = class(TCustomForm)
+  private
+    //FCloseButton:TSpeedButton;
+    FCloseButton:TButton;
+    FCaptionLabel:TLabel;
+    FMessageLabel:TLabel;
+    FTimerLabel:TLabel;
+    FOwnerItem:TRxPopupNotifierItem;
+    procedure CreateCloseButton;
+    procedure CreateCaption(ACaption:string);
+    procedure CreateMessage(AMessage:string);
+    procedure CreateTimerLabel;
+    procedure ButtonCloseClick(Sender: TObject);
+  protected
+    //procedure DoShowWindow; override;
+  public
+    constructor CreateNotifierForm(AOwnerItem:TRxPopupNotifierItem);
+  end;
+
+  { TRxPopupNotifierItem }
+
+  TRxPopupNotifierItem = class(TCollectionItem)
+  private
+    FActive: boolean;
+    FAutoClose: boolean;
+    FCaption: string;
+    FColor: TColor;
+    FMessage: string;
+    FNotifyForm:TRxNotifierForm;
+    FShowCloseButton: boolean;
+    FShowCloseTimer: boolean;
+    FCloseTime:TDateTime;
+    FState: TRxPopupNotifierState;
+    procedure OnNotifyFormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure SetActive(AValue: boolean);
+    procedure SetColor(AValue: TColor);
+    procedure UpdateCloseLabel;
+    procedure CreateNotifierForm;
+    procedure UpdateFormSizes(var ATop:integer);
+    procedure UpdateFormPosition(var ATop:integer);
+    procedure NotifierClick(Sender: TObject);
+  protected
+    procedure AssignTo(Dest: TPersistent); override;
+  public
+    constructor Create(ACollection: TCollection); override;
+    property State:TRxPopupNotifierState read FState;
+  published
+    property Active:boolean read FActive write SetActive;
+    property Color:TColor read FColor write SetColor default clYellow;
+    property AutoClose:boolean read FAutoClose write FAutoClose default true;
+    property ShowCloseTimer:boolean read FShowCloseTimer write FShowCloseTimer default true;
+    property ShowCloseButton:boolean read FShowCloseButton write FShowCloseButton default true;
+    property Caption:string read FCaption write FCaption;
+    property Message:string read FMessage write FMessage;
+  end;
+
+  { TNotifierCollection }
+
+  TNotifierCollection = class(TOwnedCollection)
+  private
+    function GetItems(AIndex: Integer): TRxPopupNotifierItem;
+  protected
+    procedure Update(Item: TCollectionItem); override;
+  public
+    constructor Create(AOwner: TPersistent);
+    property Items[AIndex:Integer]:TRxPopupNotifierItem read GetItems; default;
+  end;
+
+  { TRxPopupNotifier }
+
+  TRxPopupNotifier = class(TComponent)
+  private
+    FActive: boolean;
+    FCloseInterval: Cardinal;
+    FDefaultColor: TColor;
+    FDefNotifierFormHeight: Cardinal;
+    FDefNotifierFormWidth: Cardinal;
+    FItems: TNotifierCollection;
+    FMessageCorner: TRxPopupNotifierCorner;
+    FOnNotifiClick: TRxPopupNotifierEvent;
+    FTimer:TTimer;
+    procedure SetActive(AValue: boolean);
+    procedure SetItems(AValue: TNotifierCollection);
+    procedure UpdateNotifyFormsPositoon;
+    procedure UpdateTimeState;
+    procedure UpdateClosed;
+    procedure NotifyTimerEvent(Sender: TObject);
+    procedure DoNotifiClick(AItem:TRxPopupNotifierItem);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function AddNotifyItem(ACaption, AMessage:string):TRxPopupNotifierItem;
+    procedure Clear;
+    function NotifierFormWidth:Cardinal;
+    function NotifierFormHeight:Cardinal;
+  published
+    property Active:boolean read FActive write SetActive default True;
+    property Items:TNotifierCollection read FItems write SetItems;
+    property MessageCorner:TRxPopupNotifierCorner read FMessageCorner write FMessageCorner default rpcBottomRight;
+    property DefaultColor:TColor read FDefaultColor write FDefaultColor default clYellow;
+    property DefNotifierFormWidth:Cardinal read FDefNotifierFormWidth write FDefNotifierFormWidth default 0;
+    property DefNotifierFormHeight:Cardinal read FDefNotifierFormHeight write FDefNotifierFormHeight default 0;
+    property CloseInterval:Cardinal read FCloseInterval write FCloseInterval default 5;
+    property OnNotifiClick:TRxPopupNotifierEvent read FOnNotifiClick write FOnNotifiClick;
+  end;
+
+implementation
+uses rxconst, LCLType;
+
+{ TRxNotifierForm }
+
+procedure TRxNotifierForm.CreateCloseButton;
+begin
+  begin
+    //FCloseButton:=TSpeedButton.Create(Self);
+    FCloseButton:=TButton.Create(Self);
+    FCloseButton.Parent:=Self;
+    FCloseButton.AutoSize:=true;
+    FCloseButton.Caption:=' X '; //sClose;
+    FCloseButton.Top:=6;
+    //FCloseButton.Flat:=true;
+    //FCloseButton.Left:=Width - Canvas.TextWidth(FCloseButton.Caption) - 6;
+    FCloseButton.Left:=Width - FCloseButton.Width - 6;
+{
+    FCloseButton.BorderSpacing.Around:=6;
+    FCloseButton.AnchorSideLeft.Control:=nil;
+    FCloseButton.AnchorSideRight.Control:=Self;
+    FCloseButton.AnchorSideRight.Side:=asrRight;
+    FCloseButton.AnchorSideTop.Control:=Self;}
+
+    FCloseButton.OnClick:=@ButtonCloseClick;
+  end;
+end;
+
+procedure TRxNotifierForm.CreateCaption(ACaption: string);
+begin
+  FCaptionLabel:=TLabel.Create(Self);
+  FCaptionLabel.Parent:=Self;
+  FCaptionLabel.BorderSpacing.Around:=6;
+  FCaptionLabel.Align:=alTop;
+  FCaptionLabel.Caption:=ACaption;
+  FCaptionLabel.Font.Style:=FCaptionLabel.Font.Style + [fsBold];
+  FCaptionLabel.OnClick:=@FOwnerItem.NotifierClick;
+end;
+
+procedure TRxNotifierForm.CreateMessage(AMessage: string);
+begin
+  FMessageLabel:=TLabel.Create(Self);
+  FMessageLabel.Parent:=Self;
+  FMessageLabel.WordWrap:=true;
+  FMessageLabel.BorderSpacing.Around:=6;
+  FMessageLabel.Align:=alClient;
+  FMessageLabel.Caption:=AMessage;
+  FMessageLabel.OnClick:=@FOwnerItem.NotifierClick;
+end;
+
+procedure TRxNotifierForm.CreateTimerLabel;
+begin
+  FTimerLabel:=TLabel.Create(Self);
+  FTimerLabel.Parent:=Self;
+  FTimerLabel.Top:=FCaptionLabel.Height+1;
+  FTimerLabel.Align:=alTop;
+  FTimerLabel.BorderSpacing.Around:=6;
+  FTimerLabel.Font.Style:=FTimerLabel.Font.Style + [fsItalic];
+  FTimerLabel.Caption:=' ';
+  FTimerLabel.OnClick:=@FOwnerItem.NotifierClick;
+end;
+
+procedure TRxNotifierForm.ButtonCloseClick(Sender: TObject);
+begin
+  Close;
+end;
+(*
+procedure TRxNotifierForm.DoShowWindow;
+begin
+  if (ActiveControl = nil) and (not (csDesigning in ComponentState)) and (Parent=nil) then
+  begin
+    // automatically choose a control to focus
+    {$IFDEF VerboseFocus}
+    DebugLn('THintWindow.WMShowWindow ',DbgSName(Self),' Set ActiveControl := ',DbgSName(FindDefaultForActiveControl));
+    {$ENDIF}
+    ActiveControl := FindNextControl(nil, True, True, False); //FindDefaultForActiveControl;
+  end;
+end;
+*)
+constructor TRxNotifierForm.CreateNotifierForm(AOwnerItem: TRxPopupNotifierItem
+  );
+begin
+  inherited CreateNew(Application);
+  FOwnerItem:=AOwnerItem;
+  //fCompStyle := csHintWindow;
+end;
+
+{ TNotifierCollection }
+
+function TNotifierCollection.GetItems(AIndex: Integer): TRxPopupNotifierItem;
+begin
+  Result:=TRxPopupNotifierItem(GetItem(AIndex));
+end;
+
+procedure TNotifierCollection.Update(Item: TCollectionItem);
+var
+  FActive: Boolean;
+  i: Integer;
+begin
+  inherited Update(Item);
+
+  FActive:=false;
+  for i:=0 to Count-1 do
+    if TRxPopupNotifierItem(Items[i]).Active then
+    begin
+      FActive:=true;
+      Break;
+    end;
+
+  TRxPopupNotifier(Owner).FTimer.Enabled:=TRxPopupNotifier(Owner).FActive and FActive;
+end;
+
+constructor TNotifierCollection.Create(AOwner: TPersistent);
+begin
+  inherited Create(AOwner, TRxPopupNotifierItem);
+end;
+
+{ TRxPopupNotifierItem }
+
+procedure TRxPopupNotifierItem.OnNotifyFormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction:=caFree;
+  FNotifyForm:=nil;
+  FState:=rpsInactive;
+end;
+
+procedure TRxPopupNotifierItem.SetActive(AValue: boolean);
+begin
+  if FActive=AValue then Exit;
+  FActive:=AValue;
+
+  if not AValue then
+  begin
+    FState:=rpsInactive;
+    if Assigned(FNotifyForm) then
+      FNotifyForm.Close;
+  end
+  else
+  begin
+    CreateNotifierForm;
+    FState:=rpsMaximazed;
+  end;
+
+  Changed(false);
+end;
+
+procedure TRxPopupNotifierItem.SetColor(AValue: TColor);
+begin
+  if FColor=AValue then Exit;
+  FColor:=AValue;
+  if Assigned(FNotifyForm) then
+    FNotifyForm.Color:=FColor;
+end;
+
+procedure TRxPopupNotifierItem.UpdateCloseLabel;
+var
+  D, D1: TDateTime;
+  N: Int64;
+begin
+  if Assigned(FNotifyForm) and FShowCloseTimer then
+  begin
+    D:=Now;
+    if FCloseTime < D then
+      FState:=rpsMinimized
+    else
+    begin
+//      D1:=;
+      N:=Trunc((FCloseTime - D) * SecsPerDay);
+      FNotifyForm.FTimerLabel.Caption:=Format( sCloseAfterSec, [N]);
+    end;
+  end;
+end;
+
+procedure TRxPopupNotifierItem.CreateNotifierForm;
+var
+  FSaveActiveForm: TForm;
+begin
+  if Assigned(FNotifyForm) then exit;
+  FSaveActiveForm:=Screen.ActiveForm;
+  FNotifyForm:=TRxNotifierForm.CreateNotifierForm(Self);
+  FNotifyForm.Width:=TRxPopupNotifier(Collection.Owner).NotifierFormWidth;
+  FNotifyForm.Height:=1;
+
+  case TRxPopupNotifier(Collection.Owner).FMessageCorner of
+    rpcTopLeft:
+      begin
+        //TODO : доделать
+        FNotifyForm.Left := 2;
+        FNotifyForm.Top := 2;
+      end;
+    rpcTopRight:
+      begin
+        //TODO : доделать
+        FNotifyForm.Left := Screen.Width - FNotifyForm.Width - 2;
+        FNotifyForm.Top := 2;
+      end;
+    rpcBootomLeft:
+      begin
+        //TODO : доделать
+        FNotifyForm.Left := 2;
+        FNotifyForm.Top := Screen.Height - FNotifyForm.Height - 2;
+      end;
+    rpcBottomRight:
+      begin
+        FNotifyForm.Left:=Screen.Width - FNotifyForm.Width - 2;
+        FNotifyForm.Top:=Screen.Height - FNotifyForm.Height - 2;
+      end;
+  end;
+
+  FNotifyForm.BorderStyle:=bsNone;
+  FNotifyForm.FormStyle:=fsStayOnTop;
+  FNotifyForm.ShowInTaskBar:=stNever;
+  FNotifyForm.Color:=FColor;
+
+  if FShowCloseButton then
+    FNotifyForm.CreateCloseButton;
+
+  FNotifyForm.CreateCaption(FCaption);
+  if FShowCloseTimer then
+    FNotifyForm.CreateTimerLabel;
+  FNotifyForm.CreateMessage(FMessage);
+
+  FNotifyForm.OnClose:=@OnNotifyFormClose;
+  FNotifyForm.Show;
+
+  if Assigned(FSaveActiveForm) then
+    FSaveActiveForm.BringToFront;
+end;
+
+procedure TRxPopupNotifierItem.UpdateFormSizes(var ATop: integer);
+begin
+  if Assigned(FNotifyForm) then
+  begin
+    if (FState = rpsMaximazed) then
+    begin
+      if (TRxPopupNotifier(Collection.Owner).NotifierFormHeight > FNotifyForm.Height) then
+      begin
+        FNotifyForm.Height:=FNotifyForm.Height + 1;
+        case TRxPopupNotifier(Collection.Owner).FMessageCorner of
+          //rpcTopLeft:;
+          //rpcTopRight:;
+          rpcBootomLeft:FNotifyForm.Top:=ATop - FNotifyForm.Height;
+          rpcBottomRight:FNotifyForm.Top:=ATop - FNotifyForm.Height;
+        end;
+      end
+      else
+      begin
+        FState:=rpsShowing;
+        FCloseTime:=Now + TRxPopupNotifier(Collection.Owner).FCloseInterval / SecsPerDay;
+      end;
+    end
+    else
+    if (FState = rpsMinimized) then
+    begin
+      if (FNotifyForm.Height > 1) then
+      begin
+        FNotifyForm.Height:=FNotifyForm.Height - 1;
+        case TRxPopupNotifier(Collection.Owner).FMessageCorner of
+          //rpcTopLeft:;
+          //rpcTopRight:;
+          rpcBootomLeft:FNotifyForm.Top:=ATop - FNotifyForm.Height;
+          rpcBottomRight:FNotifyForm.Top:=ATop - FNotifyForm.Height;
+        end;
+      end
+      else
+        FState:=rpsInactive;
+    end;
+
+    if TRxPopupNotifier(Collection.Owner).FMessageCorner in [rpcTopLeft, rpcTopRight] then
+      ATop:=ATop + FNotifyForm.Height + 2
+    else
+      ATop:=ATop - FNotifyForm.Height - 2;
+  end;
+end;
+
+procedure TRxPopupNotifierItem.UpdateFormPosition(var ATop: integer);
+begin
+  if Assigned(FNotifyForm) then
+  begin
+    case TRxPopupNotifier(Collection.Owner).FMessageCorner of
+      rpcTopLeft,
+      rpcTopRight:
+        begin
+          FNotifyForm.Top:=ATop;
+          ATop:=ATop + FNotifyForm.Height + 2;
+        end;
+      rpcBootomLeft,
+      rpcBottomRight:
+        begin
+          FNotifyForm.Top:=ATop - FNotifyForm.Height;
+          ATop:=ATop - FNotifyForm.Height - 2;
+        end;
+    end;
+  end;
+end;
+
+procedure TRxPopupNotifierItem.NotifierClick(Sender: TObject);
+begin
+  TRxPopupNotifier(Collection.Owner).DoNotifiClick(Self);
+end;
+
+procedure TRxPopupNotifierItem.AssignTo(Dest: TPersistent);
+begin
+  if Dest is TRxPopupNotifierItem then
+  begin
+    TRxPopupNotifierItem(Dest).FColor:=FColor;
+    TRxPopupNotifierItem(Dest).FAutoClose:=FAutoClose;
+    TRxPopupNotifierItem(Dest).FShowCloseTimer:=FShowCloseTimer;
+    TRxPopupNotifierItem(Dest).FCaption:=FCaption;
+    TRxPopupNotifierItem(Dest).FMessage:=FMessage;
+    TRxPopupNotifierItem(Dest).FShowCloseButton:=FShowCloseButton;
+  end
+  else
+  inherited AssignTo(Dest);
+end;
+
+constructor TRxPopupNotifierItem.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FColor:=TRxPopupNotifier(ACollection.Owner).FDefaultColor;
+  FShowCloseButton:=true;
+  FShowCloseTimer:=true;
+end;
+
+{ TRxPopupNotifier }
+
+procedure TRxPopupNotifier.UpdateNotifyFormsPositoon;
+var
+  F: TRxPopupNotifierItem;
+  Y, i: Integer;
+  FReposition: Boolean;
+begin
+  if FMessageCorner in [rpcTopLeft, rpcTopRight] then
+    Y:=2
+  else
+    Y:=Screen.Height - 2;
+
+  FReposition:=false;
+  for i:=FItems.Count - 1 downto 0 do
+  begin
+    F:=FItems.Items[i] as TRxPopupNotifierItem;
+    if F.Active then
+    begin
+      if F.FState in [rpsMaximazed, rpsMinimized] then
+      begin
+        F.UpdateFormSizes(Y);
+        FReposition:=true;
+      end
+      else
+      if F.FState = rpsInactive then
+        FReposition:=true
+      else
+      if FReposition then
+        F.UpdateFormPosition(Y)
+      else
+      begin
+        if FMessageCorner in [rpcTopLeft, rpcTopRight] then
+          Y:=Y + F.FNotifyForm.Height + 2
+        else
+          Y:=Y - F.FNotifyForm.Height - 2;
+      end;
+
+      if Y<0 then
+        Y:=2
+      else
+      if Y>Screen.Height then
+        Y:=Screen.Height - 2;
+    end;
+  end;
+end;
+
+procedure TRxPopupNotifier.UpdateTimeState;
+var
+  i: Integer;
+  F: TRxPopupNotifierItem;
+begin
+  for i:=FItems.Count - 1 downto 0 do
+  begin
+    F:=FItems.Items[i] as TRxPopupNotifierItem;
+    if F.Active and (F.State = rpsShowing) and F.ShowCloseTimer then
+      F.UpdateCloseLabel;
+  end;
+end;
+
+procedure TRxPopupNotifier.UpdateClosed;
+var
+  F: TRxPopupNotifierItem;
+  i: Integer;
+begin
+  for i:=FItems.Count - 1 downto 0 do
+  begin
+    F:=FItems.Items[i] as TRxPopupNotifierItem;
+    if F.FState = rpsInactive then
+      F.Active:=false;
+  end;
+end;
+
+procedure TRxPopupNotifier.SetItems(AValue: TNotifierCollection);
+begin
+  FItems.Assign(AValue);
+end;
+
+procedure TRxPopupNotifier.SetActive(AValue: boolean);
+begin
+  if FActive=AValue then Exit;
+  FActive:=AValue;
+  FTimer.Enabled:=false;
+  if not FActive then
+    Clear;
+end;
+
+procedure TRxPopupNotifier.NotifyTimerEvent(Sender: TObject);
+begin
+  UpdateNotifyFormsPositoon;
+  UpdateClosed;
+  UpdateTimeState;
+end;
+
+procedure TRxPopupNotifier.DoNotifiClick(AItem: TRxPopupNotifierItem);
+begin
+  if Assigned(FOnNotifiClick) then
+    FOnNotifiClick(Self, AItem)
+end;
+
+constructor TRxPopupNotifier.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDefaultColor:=clYellow;
+  FCloseInterval:=5;
+  FMessageCorner:=rpcBottomRight;
+  FActive:=true;
+  FItems:=TNotifierCollection.Create(Self);
+  FTimer:=TTimer.Create(Self);
+  FTimer.Enabled:=False;
+  FTimer.Interval:=10;
+  FTimer.OnTimer:=@NotifyTimerEvent;
+end;
+
+destructor TRxPopupNotifier.Destroy;
+begin
+  FTimer.Enabled:=false;
+  FreeAndNil(FItems);
+  inherited Destroy;
+end;
+
+function TRxPopupNotifier.AddNotifyItem(ACaption, AMessage: string
+  ): TRxPopupNotifierItem;
+begin
+  Result:=FItems.Add as TRxPopupNotifierItem;
+  Result.Caption:=ACaption;
+  Result.Message:=AMessage;
+  Result.FState:=rpsMaximazed;
+  Result.FColor:=FDefaultColor;
+  Result.Active:=true;
+end;
+
+procedure TRxPopupNotifier.Clear;
+begin
+
+end;
+
+function TRxPopupNotifier.NotifierFormWidth: Cardinal;
+begin
+  if FDefNotifierFormWidth > 0 then
+    Result:=FDefNotifierFormWidth
+  else
+    Result:=Screen.Width div 4;
+end;
+
+function TRxPopupNotifier.NotifierFormHeight: Cardinal;
+begin
+  if FDefNotifierFormHeight > 0 then
+    Result:=FDefNotifierFormHeight
+  else
+    Result:=Screen.Height div 8;
+end;
+
+end.
+

RXLib/rxcontrols/rxrangesel.pas

@@ -0,0 +1,718 @@
+{ rxapputils 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 RxRangeSel;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, Types, Controls, LMessages, Graphics, ComCtrls;
+
+type
+  TRxRangeSelectorState =
+      (rssNormal, rssDisabled,
+       rssThumbTopHover, rssThumbTopDown,
+       rssThumbBottomHover, rssThumbBottomDown,
+       rssBlockHover, rssBlockDown);
+
+  TRxRangeSelectorStyle = (rxrsSimple, rxrsLazarus, rxrsNative);
+
+  { TRxCustomRangeSelector }
+
+  TRxCustomRangeSelector = class(TCustomControl)
+  private
+    FBackgroudGlyph: TBitmap;
+    FMax: Double;
+    FMin: Double;
+    FOnChange: TNotifyEvent;
+    FOrientation: TTrackBarOrientation;
+    FSelectedEnd: Double;
+    FSelectedGlyph: TBitmap;
+    FSelectedStart: Double;
+    FState: TRxRangeSelectorState;
+    FStyle: TRxRangeSelectorStyle;
+    FThumbTopGlyph:TBitmap;
+    FThumbBottomGlyph:TBitmap;
+    //
+    FThumbPosTop : TRect;
+    FThumbPosBottom : TRect;
+    FTracerPos : TRect;
+    FSelectedPos : TRect;
+    FThumbSize : TSize;
+
+    FDblClicked : Boolean;
+    FDown : boolean;
+    FPrevX : integer;
+    FPrevY : integer;
+    procedure DoChange;
+    function GetSelectedLength: Double;
+    function GetThumbBottomGlyph: TBitmap;
+    function GetThumbTopGlyph: TBitmap;
+    function IsThumbBottomGlyphStored: Boolean;
+    function IsThumbTopGlyphStored: Boolean;
+    procedure SetBackgroudGlyph(AValue: TBitmap);
+    procedure SetMax(AValue: Double);
+    procedure SetMin(AValue: Double);
+    procedure SetOrientation(AValue: TTrackBarOrientation);
+    procedure SetSelectedEnd(AValue: Double);
+    procedure SetSelectedGlyph(AValue: TBitmap);
+    procedure SetSelectedStart(AValue: Double);
+    procedure SetStyle(AValue: TRxRangeSelectorStyle);
+    procedure SetThumbBottomGlyph(AValue: TBitmap);
+    procedure SetThumbTopGlyph(AValue: TBitmap);
+    procedure InitSizes;
+    procedure UpdateData;
+    function LogicalToScreen(const LogicalPos: double): double;
+    function BarWidth: integer;
+    procedure SetState(AValue: TRxRangeSelectorState);
+    function DeduceState(const AX, AY: integer; const ADown: boolean): TRxRangeSelectorState;
+    procedure InitImages(AOrient:TTrackBarOrientation);
+  protected
+    procedure Paint; override;
+    class function GetControlClassDefaultSize: TSize; override;
+    procedure Loaded; override;
+
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
+    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
+    procedure MouseLeave; override ;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    property SelectedGlyph: TBitmap read FSelectedGlyph write SetSelectedGlyph;
+    property BackgroudGlyph: TBitmap read FBackgroudGlyph write SetBackgroudGlyph;
+
+    procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
+    property Min:Double read FMin write SetMin;
+    property Max:Double read FMax write SetMax;
+    property SelectedStart : Double read FSelectedStart write SetSelectedStart;
+    property SelectedEnd : Double read FSelectedEnd write SetSelectedEnd;
+    property SelectedLength : Double read GetSelectedLength;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Style:TRxRangeSelectorStyle read FStyle write SetStyle;
+    property ThumbTopGlyph: TBitmap read GetThumbTopGlyph write SetThumbTopGlyph stored IsThumbTopGlyphStored;
+    property ThumbBottomGlyph: TBitmap read GetThumbBottomGlyph write SetThumbBottomGlyph stored IsThumbBottomGlyphStored;
+    property State:TRxRangeSelectorState read FState;
+    property Orientation:TTrackBarOrientation read FOrientation write SetOrientation default trHorizontal;
+  end;
+
+  { TRxRangeSelector }
+
+  TRxRangeSelector = class(TRxCustomRangeSelector)
+  published
+    property Anchors;
+    property Enabled;
+    property Visible;
+    property Color ;
+
+    property Min;
+    property Max;
+    property SelectedStart;
+    property SelectedEnd;
+    property Style;
+    property OnChange;
+    property ThumbTopGlyph;
+    property ThumbBottomGlyph;
+    property SelectedGlyph;
+    property Orientation;
+  end;
+
+implementation
+uses rxlclutils, LCLType, LCLIntf, Themes;
+
+const
+  sRX_RANGE_H_BACK = 'RX_RANGE_H_BACK';
+  sRX_RANGE_H_SEL = 'RX_RANGE_H_SEL';
+  sRX_SLADER_BOTTOM = 'RX_SLADER_BOTTOM';
+  sRX_SLADER_TOP = 'RX_SLADER_TOP';
+
+  sRX_RANGE_V_BACK = 'RX_RANGE_V_BACK';
+  sRX_RANGE_V_SEL = 'RX_RANGE_V_SEL';
+  sRX_SLADER_LEFT = 'RX_SLADER_LEFT';
+  sRX_SLADER_RIGHT = 'RX_SLADER_RIGHT';
+
+function IsIntInInterval(x, xmin, xmax: integer): boolean; inline;
+begin
+  IsIntInInterval := (xmin <= x) and (x <= xmax);
+end;
+
+function PointInRect(const X, Y: integer; const Rect: TRect): boolean; inline;
+begin
+  PointInRect := IsIntInInterval(X, Rect.Left, Rect.Right) and
+                 IsIntInInterval(Y, Rect.Top, Rect.Bottom);
+end;
+
+function IsRealInInterval(x, xmin, xmax: extended): boolean; inline;
+begin
+  IsRealInInterval := (xmin <= x) and (x <= xmax);
+end;
+
+{ TRxCustomRangeSelector }
+
+procedure TRxCustomRangeSelector.SetMax(AValue: Double);
+begin
+  if FMax=AValue then Exit;
+  FMax:=AValue;
+
+  if FSelectedEnd > FMax then
+    FSelectedEnd:=FMax;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.DoChange;
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+function TRxCustomRangeSelector.GetSelectedLength: Double;
+begin
+  Result:=FSelectedEnd - FSelectedStart;
+end;
+
+function TRxCustomRangeSelector.GetThumbBottomGlyph: TBitmap;
+begin
+  Result:=FThumbBottomGlyph;
+end;
+
+function TRxCustomRangeSelector.GetThumbTopGlyph: TBitmap;
+begin
+  Result:=FThumbTopGlyph;
+end;
+
+function TRxCustomRangeSelector.IsThumbBottomGlyphStored: Boolean;
+begin
+
+end;
+
+function TRxCustomRangeSelector.IsThumbTopGlyphStored: Boolean;
+begin
+
+end;
+
+procedure TRxCustomRangeSelector.SetBackgroudGlyph(AValue: TBitmap);
+begin
+  InitSizes;
+  FBackgroudGlyph.Assign(AValue);
+end;
+
+procedure TRxCustomRangeSelector.SetMin(AValue: Double);
+begin
+  if FMin=AValue then Exit;
+  FMin:=AValue;
+
+  if FSelectedStart < FMin then
+    FSelectedStart:=FMin;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.SetOrientation(AValue: TTrackBarOrientation);
+begin
+  if FOrientation=AValue then Exit;
+  FOrientation:=AValue;
+
+  InitImages(FOrientation);
+
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.SetSelectedEnd(AValue: Double);
+begin
+  if FSelectedEnd=AValue then Exit;
+  FSelectedEnd:=AValue;
+
+  if FSelectedEnd > FMax then
+    FSelectedEnd:=FMax
+  else
+  if FSelectedEnd < FSelectedStart then
+    FSelectedEnd:=FSelectedStart;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.SetSelectedGlyph(AValue: TBitmap);
+begin
+  InitSizes;
+  FSelectedGlyph.Assign(AValue);
+end;
+
+procedure TRxCustomRangeSelector.SetSelectedStart(AValue: Double);
+begin
+  if FSelectedStart=AValue then Exit;
+  FSelectedStart:=AValue;
+
+  if FSelectedStart < FMin then
+    FSelectedStart:=FMin
+  else
+  if FSelectedStart > FSelectedEnd then
+    FSelectedStart:=FSelectedEnd;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.SetStyle(AValue: TRxRangeSelectorStyle);
+begin
+  if FStyle=AValue then Exit;
+  FStyle:=AValue;
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.SetThumbBottomGlyph(AValue: TBitmap);
+begin
+  FThumbBottomGlyph.Assign(AValue);
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.SetThumbTopGlyph(AValue: TBitmap);
+begin
+  FThumbTopGlyph.Assign(AValue);
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.InitSizes;
+var
+  TD: TThemedElementDetails;
+begin
+  {$IFDEF WINDOWS}
+  if (FStyle = rxrsNative) and ThemeServices.ThemesEnabled then
+  begin
+    if FOrientation = trHorizontal then
+      TD:=ThemeServices.GetElementDetails(ttbThumbBottomPressed)
+    else
+      TD:=ThemeServices.GetElementDetails(ttbThumbRightPressed);
+    FThumbSize:=ThemeServices.GetDetailSize(TD);
+  end
+  else
+  {$ENDIF WINDOWS}
+  if Assigned(FThumbTopGlyph) and (FThumbTopGlyph.Width > 0) then
+  begin
+    FThumbSize.CX:=FThumbTopGlyph.Width;
+    FThumbSize.CY:=FThumbTopGlyph.Height;
+  end
+  else
+  if Assigned(FThumbBottomGlyph) and (FThumbBottomGlyph.Width > 0) then
+  begin
+    FThumbSize.CX:=FThumbBottomGlyph.Width;
+    FThumbSize.CY:=FThumbBottomGlyph.Height;
+  end
+  else
+  begin
+    FThumbSize.CX:=6;
+    FThumbSize.CY:=10;
+  end;
+end;
+
+procedure TRxCustomRangeSelector.UpdateData;
+begin
+  if FOrientation = trHorizontal then
+  begin
+    FTracerPos.Left := FThumbSize.CX div 2;
+    FTracerPos.Right :=Width - FThumbSize.CX div 2;
+    FTracerPos.Top:=FThumbSize.CY + 1;
+    FTracerPos.Bottom:=FThumbPosBottom.Top - 1;
+
+    FSelectedPos.Left := round(LogicalToScreen(FSelectedStart)) - FThumbSize.CX div 2;
+    FSelectedPos.Top := FTracerPos.Top;
+    FSelectedPos.Right := round(LogicalToScreen(FSelectedEnd)) + FThumbSize.CX div 2;
+    FSelectedPos.Bottom := FTracerPos.Bottom;
+
+
+    FThumbPosTop.Top:=0;
+    FThumbPosTop.Left:=FSelectedPos.Left - FThumbSize.CX div 2;
+    FThumbPosTop.Bottom:=FThumbTopGlyph.Height;
+    FThumbPosTop.Right:=FThumbPosTop.Left + FThumbSize.CX;
+
+    FThumbPosBottom.Bottom:=Height;
+    FThumbPosBottom.Right:=FSelectedPos.Right + FThumbSize.CX div 2;
+    FThumbPosBottom.Top:=Height - FThumbBottomGlyph.Height;
+    FThumbPosBottom.Left:=FThumbPosBottom.Right - FThumbSize.CX;
+  end
+  else
+  begin
+    FTracerPos.Top:= FThumbSize.CY div 2;
+    FTracerPos.Bottom:=Height - FThumbSize.CY div 2;
+    FTracerPos.Left := FThumbSize.CX + 1;
+    FTracerPos.Right :=Width - FThumbSize.CX - 1;
+
+    FSelectedPos.Left := FTracerPos.Left;
+    FSelectedPos.Top := round(LogicalToScreen(FSelectedStart)) - FThumbSize.CY div 2;
+    FSelectedPos.Right := FTracerPos.Right;
+    FSelectedPos.Bottom := round(LogicalToScreen(FSelectedEnd)) + FThumbSize.CY div 2;
+
+    FThumbPosTop.Left:=0;
+    FThumbPosTop.Right:=FThumbTopGlyph.Width;
+    FThumbPosTop.Top:=FSelectedPos.Top - FThumbSize.CY div 2;
+    FThumbPosTop.Bottom:=FThumbPosTop.Top + FThumbSize.CY;
+
+    FThumbPosBottom.Right:=Width;
+    FThumbPosBottom.Left:=Width - FThumbSize.CX - 1;
+    FThumbPosBottom.Top:=FSelectedPos.Bottom - FThumbSize.CY div 2;
+    FThumbPosBottom.Bottom:=FThumbPosBottom.Top + FThumbSize.CY;
+  end;
+end;
+
+function TRxCustomRangeSelector.LogicalToScreen(const LogicalPos: double
+  ): double;
+begin
+  if FOrientation = trHorizontal then
+    Result := FThumbSize.CX
+  else
+    Result := FThumbSize.CY;
+
+  if (FMax - FMin) > 0 then
+    Result := Result + BarWidth * (LogicalPos - FMin) / (FMax - FMin)
+end;
+
+function TRxCustomRangeSelector.BarWidth: integer;
+begin
+  if FOrientation = trHorizontal then
+    result := Width - 2 * FThumbSize.CX
+  else
+    result := Height - 2 * FThumbSize.CY;
+end;
+
+procedure TRxCustomRangeSelector.SetState(AValue: TRxRangeSelectorState);
+begin
+  if AValue <> FState then
+  begin
+    FState := AValue;
+    Invalidate;
+  end;
+end;
+
+function TRxCustomRangeSelector.DeduceState(const AX, AY: integer;
+  const ADown: boolean): TRxRangeSelectorState;
+begin
+  Result := rssNormal;
+
+  if not Enabled then
+    Result := rssDisabled
+  else
+  begin
+    if PointInRect(AX, AY, FThumbPosTop) then
+    begin
+      if ADown then
+        Result := rssThumbTopDown
+      else
+        Result := rssThumbTopHover;
+    end
+    else
+    if PointInRect(AX, AY, FThumbPosBottom) then
+    begin
+      if ADown then
+        Result := rssThumbBottomDown
+      else
+        Result := rssThumbBottomHover;
+    end
+    else
+    if PointInRect(AX, AY, FSelectedPos) then
+    begin
+      if ADown then
+        Result := rssBlockDown
+      else
+        Result := rssBlockHover;
+    end;
+  end;
+end;
+
+procedure TRxCustomRangeSelector.InitImages(AOrient: TTrackBarOrientation);
+begin
+  if AOrient = trHorizontal then
+  begin
+    FSelectedGlyph := CreateResBitmap(sRX_RANGE_H_SEL);
+    FBackgroudGlyph := CreateResBitmap(sRX_RANGE_H_BACK);
+
+    FThumbTopGlyph:=CreateResBitmap(sRX_SLADER_TOP);
+    FThumbBottomGlyph:=CreateResBitmap(sRX_SLADER_BOTTOM);
+  end
+  else
+  begin
+    FSelectedGlyph := CreateResBitmap(sRX_RANGE_V_SEL);
+    FBackgroudGlyph := CreateResBitmap(sRX_RANGE_V_BACK);
+
+    FThumbTopGlyph:=CreateResBitmap(sRX_SLADER_LEFT);
+    FThumbBottomGlyph:=CreateResBitmap(sRX_SLADER_RIGHT);
+  end;
+end;
+
+procedure TRxCustomRangeSelector.Paint;
+var
+  DE: TThemedElementDetails;
+begin
+  inherited Paint;
+  Canvas.Brush.Color := Color;
+  Canvas.FillRect(ClientRect);
+
+  {$IFDEF WINDOWS}
+  if (FStyle = rxrsNative) and ThemeServices.ThemesEnabled then
+  begin
+    if FOrientation = trHorizontal then
+      DE:=ThemeServices.GetElementDetails(ttbThumbBottomPressed)
+    else
+      DE:=ThemeServices.GetElementDetails(ttbThumbRightPressed);
+
+    ThemeServices.DrawElement( Canvas.Handle, DE, FThumbPosTop);
+
+    if FOrientation = trHorizontal then
+      DE:=ThemeServices.GetElementDetails(ttbThumbTopPressed)
+    else
+      DE:=ThemeServices.GetElementDetails(ttbThumbLeftPressed);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FThumbPosBottom);
+
+    if FOrientation = trHorizontal then
+      DE:=ThemeServices.GetElementDetails(ttbTrack)
+    else
+      DE:=ThemeServices.GetElementDetails(ttbTrackVert);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FTracerPos);
+
+    if FOrientation = trHorizontal then
+      DE:=ThemeServices.GetElementDetails(ttbThumbNormal)
+    else
+      DE:=ThemeServices.GetElementDetails(ttbThumbVertNormal);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FSelectedPos);
+  end
+  else
+  {$ENDIF WINDOWS}
+  if FStyle = rxrsSimple then
+  begin
+    Canvas.Brush.Color := Color;
+    Canvas.FillRect(ClientRect);
+
+    DrawEdge(Canvas.Handle, FTracerPos, EDGE_SUNKEN, BF_RECT);
+
+    Canvas.Brush.Color := clHighlight;
+    Canvas.FillRect(FSelectedPos);
+
+    case FState of
+        rssDisabled:
+          DrawEdge(Canvas.Handle, FSelectedPos, EDGE_BUMP, BF_RECT or BF_MONO);
+        rssBlockHover:
+          DrawEdge(Canvas.Handle, FSelectedPos, EDGE_RAISED, BF_RECT);
+        rssBlockDown:
+          DrawEdge(Canvas.Handle, FSelectedPos, EDGE_SUNKEN, BF_RECT);
+    else
+        DrawEdge(Canvas.Handle, FSelectedPos, EDGE_ETCHED, BF_RECT);
+    end;
+
+    case FState of
+        rssDisabled:
+          DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_BUMP, BF_RECT or BF_MONO);
+        rssThumbTopHover:
+          DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_RAISED, BF_RECT);
+        rssThumbTopDown:
+          DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_SUNKEN, BF_RECT);
+    else
+        DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_ETCHED, BF_RECT);
+    end;
+
+    case FState of
+        rssDisabled:
+          DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_BUMP, BF_RECT or BF_MONO);
+        rssThumbBottomHover:
+          DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_RAISED, BF_RECT);
+        rssThumbBottomDown:
+          DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_SUNKEN, BF_RECT);
+    else
+        DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_ETCHED, BF_RECT);
+    end;
+  end
+  else
+  begin
+    Canvas.Draw(FThumbPosTop.Left, FThumbPosTop.Top, FThumbTopGlyph);
+    Canvas.Draw(FThumbPosBottom.Left, FThumbPosBottom.Top, FThumbBottomGlyph);
+
+    if (FBackgroudGlyph.Width > 0) and (FBackgroudGlyph.Height>0) then
+    begin
+      Canvas.StretchDraw(FTracerPos, FBackgroudGlyph)
+    end;
+
+    if (FSelectedGlyph.Width > 0) and (FSelectedGlyph.Height > 0) then
+      Canvas.StretchDraw(FSelectedPos, FSelectedGlyph)
+    else
+    begin
+      Canvas.Brush.Color := clBlue;
+      Canvas.FillRect(FSelectedPos);
+    end;
+  end
+end;
+
+class function TRxCustomRangeSelector.GetControlClassDefaultSize: TSize;
+begin
+  Result.CX := 100;
+  Result.CY := 60;
+end;
+
+procedure TRxCustomRangeSelector.Loaded;
+begin
+  inherited Loaded;
+  UpdateData;
+end;
+
+procedure TRxCustomRangeSelector.MouseDown(Button: TMouseButton;
+  Shift: TShiftState; X: Integer; Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+
+  if FDblClicked then
+  begin
+    FDblClicked := false;
+    Exit;
+  end;
+
+  FDown := Button = mbLeft;
+  SetState(DeduceState(X, Y, FDown));
+end;
+
+procedure TRxCustomRangeSelector.MouseMove(Shift: TShiftState; X: Integer;
+  Y: Integer);
+begin
+  inherited MouseMove(Shift, X, Y);
+
+  if FState = rssThumbTopDown then
+  begin
+    if FOrientation = trHorizontal then
+      SetSelectedStart(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth)
+    else
+      SetSelectedStart(FSelectedStart + (Y - FPrevY) * (FMax - FMin) / BarWidth)
+  end
+  else
+  if FState = rssThumbBottomDown then
+  begin
+    if FOrientation = trHorizontal then
+      SetSelectedEnd(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth)
+    else
+      SetSelectedEnd(FSelectedEnd + (Y - FPrevY) * (FMax - FMin) / BarWidth)
+  end
+  else
+  if FState = rssBlockDown then
+  begin
+    if FOrientation = trHorizontal then
+    begin
+      if IsRealInInterval(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth, FMin, FMax) and
+         IsRealInInterval(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth, FMin, FMax) then
+      begin
+        SetSelectedStart(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth);
+        SetSelectedEnd(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth);
+      end;
+    end
+    else
+    begin
+      if IsRealInInterval(FSelectedStart + (Y - FPrevY) * (FMax - FMin) / BarWidth, FMin, FMax) and
+         IsRealInInterval(FSelectedEnd + (Y - FPrevY) * (FMax - FMin) / BarWidth, FMin, FMax) then
+      begin
+        SetSelectedStart(FSelectedStart + (Y - FPrevY) * (FMax - FMin) / BarWidth);
+        SetSelectedEnd(FSelectedEnd + (Y - FPrevY) * (FMax - FMin) / BarWidth);
+      end;
+    end
+  end
+  else
+    SetState(DeduceState(X, Y, FDown));
+
+  FPrevX := X;
+  FPrevY := Y;
+end;
+
+procedure TRxCustomRangeSelector.MouseUp(Button: TMouseButton;
+  Shift: TShiftState; X: Integer; Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  FDown := false;
+  SetState(DeduceState(X, Y, FDown));
+end;
+
+procedure TRxCustomRangeSelector.MouseLeave;
+begin
+  inherited MouseLeave;
+  if Enabled then
+    SetState(rssNormal)
+  else
+    SetState(rssDisabled);
+end;
+
+procedure TRxCustomRangeSelector.SetBounds(aLeft, aTop, aWidth, aHeight: integer
+  );
+begin
+  inherited SetBounds(aLeft, aTop, aWidth, aHeight);
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+constructor TRxCustomRangeSelector.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+//  FThumbTopGlyph:=TBitmap.Create;
+//  FThumbBottomGlyph:=TBitmap.Create;
+
+//  FSelectedGlyph:=TBitmap.Create;
+//  FBackgroudGlyph:=TBitmap.Create;
+  InitImages(trHorizontal);
+
+  with GetControlClassDefaultSize do
+    SetInitialBounds(0, 0, CX, CY);
+
+  FSelectedEnd:=50;
+  FMax:=100;
+  FOrientation:=trHorizontal;
+end;
+
+destructor TRxCustomRangeSelector.Destroy;
+begin
+  FreeAndNil(FThumbTopGlyph);
+  FreeAndNil(FThumbBottomGlyph);
+  FreeAndNil(FSelectedGlyph);
+  FreeAndNil(FBackgroudGlyph);
+  inherited Destroy;
+end;
+
+end.
+

RXLib/rxcontrols/rxshortcutunit.lfm

@@ -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

RXLib/rxcontrols/rxshortcutunit.pas

@@ -0,0 +1,187 @@
+{ rxShortCutUnit 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 rxShortCutUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
+  StdCtrls;
+
+type
+
+  { TrxShortCutForm }
+
+  TrxShortCutForm = class(TForm)
+    Button1: TButton;
+    ButtonPanel1: TButtonPanel;
+    CheckBox1: TCheckBox;
+    CheckBox2: TCheckBox;
+    CheckBox3: TCheckBox;
+    ComboBox1: TComboBox;
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    function GetShortCut: TShortCut;
+    procedure SetShortCut(AValue: TShortCut);
+  public
+    property ShortCut:TShortCut read GetShortCut write SetShortCut;
+  end;
+
+
+function RxSelectShortCut(var AShortCut:TShortCut):boolean;
+
+implementation
+uses LCLProc, LCLType, LCLStrConsts;
+
+{$R *.lfm}
+
+function RxSelectShortCut(var AShortCut: TShortCut): boolean;
+var
+  rxShortCutForm: TrxShortCutForm;
+begin
+  rxShortCutForm:=TrxShortCutForm.Create(Application);
+  rxShortCutForm.ShortCut:=AShortCut;
+  if rxShortCutForm.ShowModal = mrOk then
+    AShortCut:=rxShortCutForm.ShortCut;
+  rxShortCutForm.Free;
+end;
+
+type
+
+  { TGrabForm }
+
+  TGrabForm = class(TForm)
+  private
+    FShortCutEdt:TShortCut;
+  protected
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+  public
+    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
+  end;
+
+
+{ TGrabForm }
+
+procedure TGrabForm.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if (Key = VK_ESCAPE) and (Shift = []) then
+    ModalResult:=mrCancel
+  else
+  if (Key <> VK_CONTROL) and (Key <> VK_SHIFT) and (Key <> VK_MENU) then
+  begin
+    FShortCutEdt:=KeyToShortCut(Key, Shift);
+    ModalResult:=mrOK;
+  end;
+end;
+
+constructor TGrabForm.CreateNew(AOwner: TComponent; Num: Integer);
+var
+  L: TLabel;
+begin
+  inherited CreateNew(AOwner, Num);
+  Position:=poScreenCenter;
+  Width:=200;
+  Height:=80;
+  Caption:='Press the key';
+  BorderStyle:=bsDialog;
+  KeyPreview:=true;
+
+  L:=TLabel.Create(Self);
+  L.Parent:=Self;
+  L.Caption:=Caption;
+  L.AnchorSide[akTop].Control:=Self;
+  L.AnchorSide[akTop].Side:=asrCenter;
+
+  L.AnchorSide[akLeft].Control:=Self;
+  L.AnchorSide[akLeft].Side:=asrCenter;
+end;
+
+{ TrxShortCutForm }
+
+procedure TrxShortCutForm.FormCreate(Sender: TObject);
+var
+  S: String;
+  i:Word;
+begin
+  for i:=0 to $FF do
+  begin
+    S:=ShortCutToText(i);
+    if S<>'' then
+      ComboBox1.Items.Add(S);
+  end;
+end;
+
+procedure TrxShortCutForm.Button1Click(Sender: TObject);
+var
+  F:TGrabForm;
+begin
+  F:=TGrabForm.CreateNew(Self);
+  if F.ShowModal = mrOk then
+    SetShortCut(F.FShortCutEdt);
+  F.Free;
+end;
+
+procedure TrxShortCutForm.SetShortCut(AValue: TShortCut);
+begin
+  ComboBox1.Text:=ShortCutToText(AValue and $FF);
+  CheckBox1.Checked:=AValue and scShift <> 0;
+  CheckBox2.Checked:=AValue and scAlt <> 0;
+  CheckBox3.Checked:=AValue and scCtrl <> 0;
+  ///if ShortCut and scMeta <> 0 then Result := Result + MenuKeyCaps[mkcMeta];
+end;
+
+function TrxShortCutForm.GetShortCut: TShortCut;
+var
+  S: String;
+begin
+  S:='';
+
+  if CheckBox1.Checked then
+    S:=SmkcShift + S;
+
+  if CheckBox2.Checked then
+    S:=SmkcAlt + S;
+
+  if CheckBox3.Checked then
+    S:=SmkcCtrl + S;
+  //SmkcMeta = 'Meta+';
+
+  S:=S + ComboBox1.Text;
+  Result:=TextToShortCut(S);
+end;
+
+end.
+

RXLib/rxcontrols/rxspin.pas

@@ -0,0 +1,976 @@
+{ rxspin 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 rxspin;
+
+interface
+
+{$I rx.inc}
+
+uses ComCtrls, LCLIntf, LCLType, Controls, ExtCtrls, Classes,
+  Graphics, LMessages, Forms, StdCtrls, Menus, SysUtils, Messages;
+
+type
+
+{ TRxSpinButton }
+
+  TSpinButtonState = (sbNotDown, sbTopDown, sbBottomDown);
+
+  TRxSpinButton = class(TGraphicControl)
+  private
+    FDown: TSpinButtonState;
+    FUpBitmap: TBitmap;
+    FDownBitmap: TBitmap;
+    FDragging: Boolean;
+    FInvalidate: Boolean;
+    FTopDownBtn: TBitmap;
+    FBottomDownBtn: TBitmap;
+    FRepeatTimer: TTimer;
+    FNotDownBtn: TBitmap;
+    FLastDown: TSpinButtonState;
+    FFocusControl: TWinControl;
+    FOnTopClick: TNotifyEvent;
+    FOnBottomClick: TNotifyEvent;
+    procedure TopClick;
+    procedure BottomClick;
+    procedure GlyphChanged(Sender: TObject);
+    function GetUpGlyph: TBitmap;
+    function GetDownGlyph: TBitmap;
+    procedure SetUpGlyph(Value: TBitmap);
+    procedure SetDownGlyph(Value: TBitmap);
+    procedure SetDown(Value: TSpinButtonState);
+    procedure SetFocusControl(Value: TWinControl);
+    procedure DrawAllBitmap;
+    procedure DrawBitmap(ABitmap: TBitmap; ADownState: TSpinButtonState);
+    procedure TimerExpired(Sender: TObject);
+    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
+  protected
+    procedure Paint; override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+      X, Y: Integer); override;
+    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+      X, Y: Integer); override;
+    procedure Notification(AComponent: TComponent;
+      Operation: TOperation); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property Down: TSpinButtonState read FDown write SetDown default sbNotDown;
+  published
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Visible;
+    property DownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
+    property UpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
+    property FocusControl: TWinControl read FFocusControl write SetFocusControl;
+    property ShowHint;
+    property ParentShowHint;
+{$IFDEF RX_D4}
+    property Anchors;
+    property Constraints;
+    property DragKind;
+{$ENDIF}
+    property OnBottomClick: TNotifyEvent read FOnBottomClick write FOnBottomClick;
+    property OnTopClick: TNotifyEvent read FOnTopClick write FOnTopClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+{$IFDEF RX_D4}
+    property OnEndDock;
+    property OnStartDock;
+{$ENDIF}
+  end;
+
+{ TRxSpinEdit }
+
+  TValueType = (vtInteger, vtFloat, vtHex);
+
+  TRxSpinEdit = class(TCustomEdit)
+  private
+    FAlignment: TAlignment;
+    FMinValue: Extended;
+    FMaxValue: Extended;
+    FIncrement: Extended;
+    FDecimal: Byte;
+    FChanging: Boolean;
+    FEditorEnabled: Boolean;
+    FValueType: TValueType;
+    FButton: TRxSpinButton;
+    FBtnWindow: TWinControl;
+    FArrowKeys: Boolean;
+    FOnTopClick: TNotifyEvent;
+    FOnBottomClick: TNotifyEvent;
+    function GetMinHeight: Integer;
+    procedure GetTextHeight(var SysHeight, aHeight: Integer);
+    function GetValue: Extended;
+    function CheckValue(NewValue: Extended): Extended;
+    function GetAsInteger: Longint;
+    function IsIncrementStored: Boolean;
+    function IsMaxStored: Boolean;
+    function IsMinStored: Boolean;
+    function IsValueStored: Boolean;
+    procedure SetArrowKeys(Value: Boolean);
+    procedure SetAsInteger(NewValue: Longint);
+    procedure SetValue(NewValue: Extended);
+    procedure SetValueType(NewType: TValueType);
+    procedure SetDecimal(NewValue: Byte);
+    function GetButtonWidth: Integer;
+    procedure RecreateButton;
+    procedure ResizeButton;
+    procedure SetAlignment(Value: TAlignment);
+    procedure LMSize(var Message: TLMSize); message LM_SIZE;
+    procedure CMEnter(var Message: TLMessage); message CM_ENTER;
+    procedure CMExit(var Message: TLMExit); message CM_EXIT;
+    procedure WMPaste(var Message: TLMessage); message LM_PASTE;
+    procedure WMCut(var Message: TLMessage); message LM_CUT;
+//    procedure CMCtl3DChanged(var Message: TLMessage); message CM_CTL3DCHANGED;
+    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
+    procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
+    procedure CheckButtonVisible;
+    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
+  protected
+    procedure Change; override;
+    function IsValidChar(Key: Char): Boolean; virtual;
+    procedure UpClick(Sender: TObject); virtual;
+    procedure DownClick(Sender: TObject); virtual;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure KeyPress(var Key: Char); override;
+    procedure CreateParams(var Params: TCreateParams); override;
+    procedure CreateWnd; override;
+    // Added from TEditButton
+    procedure SetParent(AParent: TWinControl); override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure Loaded; override;
+    procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED;
+    //
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property AsInteger: Longint read GetAsInteger write SetAsInteger default 0;
+    property Text;
+  published
+    property Alignment: TAlignment read FAlignment write SetAlignment
+      default taLeftJustify;
+    property ArrowKeys: Boolean read FArrowKeys write SetArrowKeys default True;
+    property Decimal: Byte read FDecimal write SetDecimal default 2;
+    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
+    property Increment: Extended read FIncrement write FIncrement stored IsIncrementStored;
+    property MaxValue: Extended read FMaxValue write FMaxValue stored IsMaxStored;
+    property MinValue: Extended read FMinValue write FMinValue stored IsMinStored;
+    property ValueType: TValueType read FValueType write SetValueType default vtInteger;
+    property Value: Extended read GetValue write SetValue stored IsValueStored;
+    property AutoSelect;
+    property AutoSize;
+    property BorderStyle;
+    property Color;
+//    property Ctl3D;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property Anchors;
+    property BiDiMode;
+    property Constraints;
+    property DragKind;
+    property ParentBiDiMode;
+    property MaxLength;
+    property ParentColor;
+//    property ParentCtl3D;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    property OnBottomClick: TNotifyEvent read FOnBottomClick write FOnBottomClick;
+    property OnTopClick: TNotifyEvent read FOnTopClick write FOnTopClick;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnContextPopup;
+    property OnEndDock;
+    property OnStartDock;
+//{$ENDIF}
+  end;
+
+implementation
+
+uses
+  rxlclutils, LResources;
+
+const
+  sSpinUpBtn = 'RXSPINUP';
+  sSpinDownBtn = 'RXSPINDOWN';
+
+const
+  InitRepeatPause = 400; { pause before repeat timer (ms) }
+  RepeatPause     = 100;
+
+{ TRxSpinButton }
+
+constructor TRxSpinButton.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+{  FUpBitmap := TBitmap.Create;
+  FDownBitmap := TBitmap.Create;}
+  FUpBitmap := LoadBitmapFromLazarusResource(sSpinUpBtn);
+  FDownBitmap := LoadBitmapFromLazarusResource(sSpinDownBtn);
+  FUpBitmap.OnChange := @GlyphChanged;
+  FDownBitmap.OnChange := @GlyphChanged;
+  Height := 20;
+  Width := 20;
+  FTopDownBtn := TBitmap.Create;
+  FBottomDownBtn := TBitmap.Create;
+  FNotDownBtn := TBitmap.Create;
+  DrawAllBitmap;
+  FLastDown := sbNotDown;
+end;
+
+destructor TRxSpinButton.Destroy;
+begin
+  FTopDownBtn.Free;
+  FBottomDownBtn.Free;
+  FNotDownBtn.Free;
+  FUpBitmap.Free;
+  FDownBitmap.Free;
+  FRepeatTimer.Free;
+  inherited Destroy;
+end;
+
+procedure TRxSpinButton.GlyphChanged(Sender: TObject);
+begin
+  FInvalidate := True;
+  Invalidate;
+end;
+
+function TRxSpinButton.GetUpGlyph: TBitmap;
+begin
+  Result := FUpBitmap;
+end;
+
+procedure TRxSpinButton.SetUpGlyph(Value: TBitmap);
+begin
+  if Value <> nil then FUpBitmap.Assign(Value)
+  else
+    FUpBitmap := LoadBitmapFromLazarusResource(sSpinUpBtn);
+end;
+
+function TRxSpinButton.GetDownGlyph: TBitmap;
+begin
+  Result := FDownBitmap;
+end;
+
+procedure TRxSpinButton.SetDownGlyph(Value: TBitmap);
+begin
+  if Value <> nil then FDownBitmap.Assign(Value)
+  else
+    FDownBitmap := LoadBitmapFromLazarusResource(sSpinDownBtn);
+end;
+
+procedure TRxSpinButton.SetDown(Value: TSpinButtonState);
+var
+  OldState: TSpinButtonState;
+begin
+  OldState := FDown;
+  FDown := Value;
+  if OldState <> FDown then Repaint;
+end;
+
+procedure TRxSpinButton.SetFocusControl(Value: TWinControl);
+begin
+  FFocusControl := Value;
+  if Value <> nil then
+    Value.FreeNotification(Self);
+end;
+
+procedure TRxSpinButton.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation = opRemove) and (AComponent = FFocusControl) then
+    FFocusControl := nil;
+end;
+
+procedure TRxSpinButton.Paint;
+begin
+  if not Enabled and not (csDesigning in ComponentState) then
+    FDragging := False;
+  if (FNotDownBtn.Height <> Height) or (FNotDownBtn.Width <> Width) or
+    FInvalidate then DrawAllBitmap;
+  FInvalidate := False;
+  with Canvas do
+    case FDown of
+      sbNotDown: Draw(0, 0, FNotDownBtn);
+      sbTopDown: Draw(0, 0, FTopDownBtn);
+      sbBottomDown: Draw(0, 0, FBottomDownBtn);
+    end;
+end;
+
+procedure TRxSpinButton.DrawAllBitmap;
+begin
+  DrawBitmap(FTopDownBtn, sbTopDown);
+  DrawBitmap(FBottomDownBtn, sbBottomDown);
+  DrawBitmap(FNotDownBtn, sbNotDown);
+end;
+
+procedure TRxSpinButton.DrawBitmap(ABitmap: TBitmap; ADownState: TSpinButtonState);
+var
+  R, RSrc: TRect;
+  dRect: Integer;
+  {Temp: TBitmap;}
+begin
+  ABitmap.Height := Height;
+  ABitmap.Width := Width;
+  with ABitmap.Canvas do begin
+    R := Bounds(0, 0, Width, Height);
+    Pen.Width := 1;
+    Brush.Color := clBtnFace;
+    Brush.Style := bsSolid;
+    FillRect(R);
+    { buttons frame }
+    Pen.Color := clWindowFrame;
+    Rectangle(0, 0, Width, Height);
+    MoveTo(-1, Height);
+    LineTo(Width, -1);
+    { top button }
+    if ADownState = sbTopDown then Pen.Color := clBtnShadow
+    else Pen.Color := clBtnHighlight;
+    MoveTo(1, Height - 4);
+    LineTo(1, 1);
+    LineTo(Width - 3, 1);
+    if ADownState = sbTopDown then Pen.Color := clBtnHighlight
+      else Pen.Color := clBtnShadow;
+    if ADownState <> sbTopDown then begin
+      MoveTo(1, Height - 3);
+      LineTo(Width - 2, 0);
+    end;
+    { bottom button }
+    if ADownState = sbBottomDown then Pen.Color := clBtnHighlight
+      else Pen.Color := clBtnShadow;
+    MoveTo(2, Height - 2);
+    LineTo(Width - 2, Height - 2);
+    LineTo(Width - 2, 1);
+    if ADownState = sbBottomDown then Pen.Color := clBtnShadow
+      else Pen.Color := clBtnHighlight;
+    MoveTo(2, Height - 2);
+    LineTo(Width - 1, 1);
+    { top glyph }
+    dRect := 1;
+    if ADownState = sbTopDown then Inc(dRect);
+    R := Bounds(Round((Width / 4) - (FUpBitmap.Width / 2)) + dRect,
+      Round((Height / 4) - (FUpBitmap.Height / 2)) + dRect, FUpBitmap.Width,
+      FUpBitmap.Height);
+    RSrc := Bounds(0, 0, FUpBitmap.Width, FUpBitmap.Height);
+    {
+    if Self.Enabled or (csDesigning in ComponentState) then
+      BrushCopy(R, FUpBitmap, RSrc, FUpBitmap.TransparentColor)
+    else begin
+      Temp := CreateDisabledBitmap(FUpBitmap, clBlack);
+      try
+        BrushCopy(R, Temp, RSrc, Temp.TransparentColor);
+      finally
+        Temp.Free;
+      end;
+    end;
+    }
+    //BrushCopy(R, FUpBitmap, RSrc, FUpBitmap.TransparentColor);
+    StretchDraw(R, FUpBitmap);
+    { bottom glyph }
+    R := Bounds(Round((3 * Width / 4) - (FDownBitmap.Width / 2)) - 1,
+      Round((3 * Height / 4) - (FDownBitmap.Height / 2)) - 1,
+      FDownBitmap.Width, FDownBitmap.Height);
+    RSrc := Bounds(0, 0, FDownBitmap.Width, FDownBitmap.Height);
+    {
+    if Self.Enabled or (csDesigning in ComponentState) then
+      BrushCopy(R, FDownBitmap, RSrc, FDownBitmap.TransparentColor)
+    else begin
+      Temp := CreateDisabledBitmap(FDownBitmap, clBlack);
+      try
+        BrushCopy(R, Temp, RSrc, Temp.TransparentColor);
+      finally
+        Temp.Free;
+      end;
+    end;
+    }
+    //BrushCopy(R, FDownBitmap, RSrc, FDownBitmap.TransparentColor);
+    StretchDraw(R, FDownBitmap);
+    if ADownState = sbBottomDown then begin
+      Pen.Color := clBtnShadow;
+      MoveTo(3, Height - 2);
+      LineTo(Width - 1, 2);
+    end;
+  end;
+end;
+
+procedure TRxSpinButton.CMEnabledChanged(var Message: TMessage);
+begin
+  inherited;
+  FInvalidate := True;
+  Invalidate;
+end;
+
+procedure TRxSpinButton.TopClick;
+begin
+  if Assigned(FOnTopClick) then begin
+    FOnTopClick(Self);
+    if not (csLButtonDown in ControlState) then FDown := sbNotDown;
+  end;
+end;
+
+procedure TRxSpinButton.BottomClick;
+begin
+  if Assigned(FOnBottomClick) then begin
+    FOnBottomClick(Self);
+    if not (csLButtonDown in ControlState) then FDown := sbNotDown;
+  end;
+end;
+
+procedure TRxSpinButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  if (Button = mbLeft) and Enabled then begin
+    if (FFocusControl <> nil) and FFocusControl.TabStop and
+      FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
+        FFocusControl.SetFocus;
+    if FDown = sbNotDown then begin
+      FLastDown := FDown;
+      if Y > (-(Height/Width) * X + Height) then begin
+        FDown := sbBottomDown;
+        BottomClick;
+      end
+      else begin
+        FDown := sbTopDown;
+        TopClick;
+      end;
+      if FLastDown <> FDown then begin
+        FLastDown := FDown;
+        Repaint;
+      end;
+      if FRepeatTimer = nil then FRepeatTimer := TTimer.Create(Self);
+      FRepeatTimer.OnTimer := @TimerExpired;
+      FRepeatTimer.Interval := InitRepeatPause;
+      FRepeatTimer.Enabled := True;
+    end;
+    FDragging := True;
+  end;
+end;
+
+procedure TRxSpinButton.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+  NewState: TSpinButtonState;
+begin
+  inherited MouseMove(Shift, X, Y);
+  if FDragging then begin
+    if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then begin
+      NewState := FDown;
+      if Y > (-(Width / Height) * X + Height) then begin
+        if (FDown <> sbBottomDown) then begin
+          if FLastDown = sbBottomDown then FDown := sbBottomDown
+          else FDown := sbNotDown;
+          if NewState <> FDown then Repaint;
+        end;
+      end
+      else begin
+        if (FDown <> sbTopDown) then begin
+          if (FLastDown = sbTopDown) then FDown := sbTopDown
+          else FDown := sbNotDown;
+          if NewState <> FDown then Repaint;
+        end;
+      end;
+    end else
+      if FDown <> sbNotDown then begin
+        FDown := sbNotDown;
+        Repaint;
+      end;
+  end;
+end;
+
+procedure TRxSpinButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  if FDragging then begin
+    FDragging := False;
+    if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then begin
+      FDown := sbNotDown;
+      FLastDown := sbNotDown;
+      Repaint;
+    end;
+  end;
+end;
+
+procedure TRxSpinButton.TimerExpired(Sender: TObject);
+begin
+  FRepeatTimer.Interval := RepeatPause;
+  if (FDown <> sbNotDown) and MouseCapture then begin
+    try
+      if FDown = sbBottomDown then BottomClick else TopClick;
+    except
+      FRepeatTimer.Enabled := False;
+      raise;
+    end;
+  end;
+end;
+
+function DefBtnWidth: Integer;
+begin
+  Result := GetSystemMetrics(SM_CXVSCROLL);
+  if Result > 15 then Result := 15;
+end;
+
+{ TRxSpinEdit }
+
+constructor TRxSpinEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Text := '0';
+  ControlStyle := ControlStyle - [csSetCaption];
+  FIncrement := 1.0;
+  FDecimal := 2;
+  FEditorEnabled := True;
+  FArrowKeys := True;
+  RecreateButton;
+  CheckButtonVisible
+end;
+
+destructor TRxSpinEdit.Destroy;
+begin
+  Destroying;
+  FChanging := True;
+  if FButton <> nil then
+    FreeAndNil(FButton);
+  if FBtnWindow <> nil then
+    FreeAndNil(FBtnWindow);
+  inherited Destroy;
+end;
+
+procedure TRxSpinEdit.RecreateButton;
+begin
+  if (csDestroying in ComponentState) then
+    Exit;
+  if FButton <> nil then
+    FreeAndNil(FButton);
+
+  if FBtnWindow <> nil then
+    FreeAndNil(FBtnWindow);
+
+  FBtnWindow := TWinControl.Create(Self);
+//  FBtnWindow.ComponentStyle:=FBtnWindow.ComponentStyle + csSubComponent;
+  with FBtnWindow do
+  begin
+    FreeNotification(Self);
+    Height := Self.Height;
+    Width := Self.Height;
+    ControlStyle := ControlStyle + [csNoDesignSelectable];
+  end;
+
+  if FBtnWindow <> nil then
+  begin
+    FButton := TRxSpinButton.Create(Self);
+    with FButton do
+    begin
+      FocusControl := Self;
+      OnTopClick := @UpClick;
+      OnBottomClick := @DownClick;
+      Width := FBtnWindow.Height;
+      Height := FBtnWindow.Height;
+      FreeNotification(FBtnWindow);
+    end;
+  end;
+  CheckButtonVisible;
+end;
+
+procedure TRxSpinEdit.SetArrowKeys(Value: Boolean);
+begin
+  FArrowKeys := Value;
+  ResizeButton;
+end;
+
+function TRxSpinEdit.GetButtonWidth: Integer;
+begin
+  if FBtnWindow <> nil then
+    Result := FBtnWindow.Width
+  else
+    Result := DefBtnWidth;
+end;
+
+procedure TRxSpinEdit.ResizeButton;
+begin
+  if FBtnWindow <> nil then begin
+    FBtnWindow.Parent   := Parent;
+    FBtnWindow.SetBounds(Width, Top, Height, Height);
+    if FButton <> nil then
+      FButton.SetBounds(0, 0, FBtnWindow.Width, FBtnWindow.Height);
+  end;
+end;
+
+procedure TRxSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if ArrowKeys and (Key in [VK_UP, VK_DOWN]) then begin
+    if Key = VK_UP then UpClick(Self)
+    else if Key = VK_DOWN then DownClick(Self);
+    Key := 0;
+  end;
+end;
+
+procedure TRxSpinEdit.Change;
+begin
+  if not FChanging then inherited Change;
+end;
+
+procedure TRxSpinEdit.KeyPress(var Key: Char);
+begin
+  if not IsValidChar(Key) then begin
+    Key := #0;
+    Beep;
+  end;
+  if Key <> #0 then begin
+    inherited KeyPress(Key);
+    if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then begin
+      { must catch and remove this, since is actually multi-line }
+      GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
+      if Key = Char(VK_RETURN) then Key := #0;
+    end;
+  end;
+end;
+
+function TRxSpinEdit.IsValidChar(Key: Char): Boolean;
+var
+  ValidChars: set of Char;
+begin
+  ValidChars := ['+', '-', '0'..'9'];
+  if ValueType = vtFloat then begin
+    if Pos(DefaultFormatSettings.DecimalSeparator, Text) = 0 then
+      ValidChars := ValidChars + [DefaultFormatSettings.DecimalSeparator];
+    if Pos('E', AnsiUpperCase(Text)) = 0 then
+      ValidChars := ValidChars + ['e', 'E'];
+  end
+  else if ValueType = vtHex then begin
+    ValidChars := ValidChars + ['A'..'F', 'a'..'f'];
+  end;
+  Result := (Key in ValidChars) or (Key < #32);
+  if not FEditorEnabled and Result and ((Key >= #32) or
+    (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
+end;
+
+procedure TRxSpinEdit.CreateParams(var Params: TCreateParams);
+begin
+  inherited CreateParams(Params);
+end;
+
+procedure TRxSpinEdit.SetParent(AParent: TWinControl);
+begin
+  inherited SetParent(AParent);
+  if FBtnWindow <> nil then begin
+    FBtnWindow.Parent := AParent;
+    FBtnWindow.AnchorToCompanion(akLeft, 0, Self);
+    FBtnWindow.Visible := True;
+    if FButton <> nil then begin
+      FButton.Parent := FBtnWindow;
+      FButton.Visible:= True;
+    end;
+  end;
+end;
+
+procedure TRxSpinEdit.Notification(AComponent: TComponent; Operation: TOperation
+  );
+begin
+  inherited Notification(AComponent, Operation);
+  if (AComponent = FBtnWindow) and (Operation = opRemove) then begin
+    if FButton <> nil then
+      FreeAndNil(FButton);
+    FreeAndNil(FBtnWindow);
+  end;
+end;
+
+procedure TRxSpinEdit.Loaded;
+begin
+  inherited Loaded;
+  CheckButtonVisible;
+  ResizeButton;
+end;
+
+procedure TRxSpinEdit.CMVisibleChanged(var Msg: TLMessage);
+begin
+  inherited CMVisibleChanged(Msg);
+  CheckButtonVisible;
+end;
+
+procedure TRxSpinEdit.CreateWnd;
+begin
+  inherited CreateWnd;
+end;
+
+procedure TRxSpinEdit.SetAlignment(Value: TAlignment);
+begin
+  if FAlignment <> Value then begin
+    FAlignment := Value;
+    RecreateWnd(Self);
+  end;
+end;
+
+procedure TRxSpinEdit.LMSize(var Message: TLMSize);
+begin
+  inherited;
+  ResizeButton;
+end;
+
+procedure TRxSpinEdit.GetTextHeight(var SysHeight, aHeight: Integer);
+var
+  DC: HDC;
+  SaveFont: HFont;
+  SysMetrics, Metrics: TTextMetric;
+begin
+  DC := GetDC(0);
+  GetTextMetrics(DC, SysMetrics);
+  SaveFont := SelectObject(DC, Font.Handle);
+  GetTextMetrics(DC, Metrics);
+  SelectObject(DC, SaveFont);
+  ReleaseDC(0, DC);
+  SysHeight := SysMetrics.tmHeight;
+  Height := Metrics.tmHeight;
+end;
+
+function TRxSpinEdit.GetMinHeight: Integer;
+var
+  I, H: Integer;
+begin
+  GetTextHeight(I, H);
+  if I > H then I := H;
+  Result := H +  (GetSystemMetrics(SM_CYBORDER) * 4) + 1;
+end;
+
+procedure TRxSpinEdit.UpClick(Sender: TObject);
+var
+  OldText: string;
+begin
+  if ReadOnly then Beep
+  else begin
+    FChanging := True;
+    try
+      OldText := inherited Text;
+      Value := Value + FIncrement;
+    finally
+      FChanging := False;
+    end;
+    if CompareText(inherited Text, OldText) <> 0 then begin
+      Modified := True;
+      Change;
+    end;
+    if Assigned(FOnTopClick) then FOnTopClick(Self);
+  end;
+end;
+
+procedure TRxSpinEdit.DownClick(Sender: TObject);
+var
+  OldText: string;
+begin
+  if ReadOnly then Beep
+  else begin
+    FChanging := True;
+    try
+      OldText := inherited Text;
+      Value := Value - FIncrement;
+    finally
+      FChanging := False;
+    end;
+    if CompareText(inherited Text, OldText) <> 0 then begin
+      Modified := True;
+      Change;
+    end;
+    if Assigned(FOnBottomClick) then FOnBottomClick(Self);
+  end;
+end;
+
+procedure TRxSpinEdit.CMFontChanged(var Message: TLMessage);
+begin
+  inherited;
+  ResizeButton;
+end;
+
+procedure TRxSpinEdit.CheckButtonVisible;
+begin
+  if FBtnWindow <> nil then begin
+    FBtnWindow.Visible := (csDesigning in ComponentState) or Visible;
+    if FButton <> nil then
+      FButton.Visible := FBtnWindow.Visible;
+  end;
+end;
+
+procedure TRxSpinEdit.WMSetFocus(var Message: TLMSetFocus);
+begin
+  inherited;
+end;
+
+{procedure TRxSpinEdit.CMCtl3DChanged(var Message: TLMessage);
+begin
+  inherited;
+  ResizeButton;
+end;}
+
+procedure TRxSpinEdit.CMEnabledChanged(var Message: TLMessage);
+begin
+  inherited;
+  if FBtnWindow <> nil then
+    FBtnWindow.Enabled := Enabled;
+end;
+
+procedure TRxSpinEdit.WMPaste(var Message: TLMessage);
+begin
+  if not FEditorEnabled or ReadOnly then Exit;
+  inherited;
+end;
+
+procedure TRxSpinEdit.WMCut(var Message: TLMessage);
+begin
+  if not FEditorEnabled or ReadOnly then Exit;
+  inherited;
+end;
+
+procedure TRxSpinEdit.CMExit(var Message: TLMExit);
+begin
+  inherited;
+  if CheckValue(Value) <> Value then SetValue(Value);
+end;
+
+procedure TRxSpinEdit.CMEnter(var Message: TLMessage);
+begin
+  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
+  inherited;
+end;
+
+function TRxSpinEdit.GetValue: Extended;
+begin
+  try
+    if ValueType = vtFloat then Result := StrToFloat(Text)
+    else if ValueType = vtHex then Result := StrToInt('$' + Text)
+    else Result := StrToInt(Text);
+  except
+    if ValueType = vtFloat then Result := FMinValue
+    else Result := Trunc(FMinValue);
+  end;
+end;
+
+procedure TRxSpinEdit.SetValue(NewValue: Extended);
+begin
+  if ValueType = vtFloat then
+    Text := FloatToStrF(CheckValue(NewValue), ffFixed, 15, FDecimal)
+  else if ValueType = vtHex then
+    Text := IntToHex(Round(CheckValue(NewValue)), 1)
+  else
+    Text := IntToStr(Round(CheckValue(NewValue)));
+end;
+
+function TRxSpinEdit.GetAsInteger: Longint;
+begin
+  Result := Trunc(GetValue);
+end;
+
+procedure TRxSpinEdit.SetAsInteger(NewValue: Longint);
+begin
+  SetValue(NewValue);
+end;
+
+procedure TRxSpinEdit.SetValueType(NewType: TValueType);
+begin
+  if FValueType <> NewType then begin
+    FValueType := NewType;
+    Value := GetValue;
+    if FValueType in [vtInteger, vtHex] then
+    begin
+      FIncrement := Round(FIncrement);
+      if FIncrement = 0 then FIncrement := 1;
+    end;
+  end;
+end;
+
+function TRxSpinEdit.IsIncrementStored: Boolean;
+begin
+  Result := FIncrement <> 1.0;
+end;
+
+function TRxSpinEdit.IsMaxStored: Boolean;
+begin
+  Result := (MaxValue <> 0.0);
+end;
+
+function TRxSpinEdit.IsMinStored: Boolean;
+begin
+  Result := (MinValue <> 0.0);
+end;
+
+function TRxSpinEdit.IsValueStored: Boolean;
+begin
+  Result := (GetValue <> 0.0);
+end;
+
+procedure TRxSpinEdit.SetDecimal(NewValue: Byte);
+begin
+  if FDecimal <> NewValue then begin
+    FDecimal := NewValue;
+    Value := GetValue;
+  end;
+end;
+
+function TRxSpinEdit.CheckValue(NewValue: Extended): Extended;
+begin
+  Result := NewValue;
+  if (FMaxValue <> FMinValue) then begin
+    if NewValue < FMinValue then
+      Result := FMinValue
+    else if NewValue > FMaxValue then
+      Result := FMaxValue;
+  end;
+end;
+
+initialization
+  {$I rxspin.lrs}
+end.

RXLib/rxcontrols/rxswitch.pas

@@ -0,0 +1,531 @@
+{ rxswitch 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 rxswitch;
+
+{$I rx.inc}
+
+interface
+
+uses SysUtils, LCLType, LCLProc, LCLIntf, LMessages, Classes, Graphics,
+  Controls, Forms, ExtCtrls, Menus;
+
+type
+
+{ TRxSwitch }
+
+  TTextPos = (tpNone, tpLeft, tpRight, tpAbove, tpBelow);
+  TSwithState = (sw_off, sw_on);
+  TSwitchBitmaps = set of TSwithState;
+
+  TRxSwitch = class(TCustomControl)
+  private
+    FActive: Boolean;
+    FBitmaps: array [TSwithState] of TBitmap;
+    FDisableBitmaps: array [TSwithState] of TBitmap;
+    FOnOn: TNotifyEvent;
+    FOnOff: TNotifyEvent;
+    FStateOn: TSwithState;
+    FTextPosition: TTextPos;
+    FBorderStyle: TBorderStyle;
+    FToggleKey: TShortCut;
+    FShowFocus: Boolean;
+    FUserBitmaps: TSwitchBitmaps;
+    function GetSwitchGlyphOff: TBitmap;
+    function GetSwitchGlyphOn: TBitmap;
+    procedure GlyphChanged(Sender: TObject);
+    procedure SetStateOn(Value: TSwithState);
+    procedure SetSwitchGlyphOff(const AValue: TBitmap);
+    procedure SetSwitchGlyphOn(const AValue: TBitmap);
+    procedure SetTextPosition(Value: TTextPos);
+    procedure SetBorderStyle(Value: TBorderStyle);
+    function GetSwitchGlyph(Index: TSwithState): TBitmap;
+    procedure SetSwitchGlyph(Index: TSwithState; Value: TBitmap);
+    function StoreBitmap(Index: TSwithState): Boolean;
+    procedure SetShowFocus(Value: Boolean);
+    procedure CreateDisabled(Index: TSwithState);
+    procedure ReadBinaryData(Stream: TStream);
+    function StoreBitmapOff: boolean;
+    function StoreBitmapOn: boolean;
+    procedure WriteBinaryData(Stream: TStream);
+    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
+    procedure CMFocusChanged(var Message: TLMessage); message CM_FOCUSCHANGED;
+    procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
+    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
+  protected
+    procedure CreateParams(var Params: TCreateParams); override;
+    procedure DefineProperties(Filer: TFiler); override;
+    function GetPalette: HPALETTE; override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+      X, Y: Integer); override;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure Paint; override;
+    procedure DoOn; dynamic;
+    procedure DoOff; dynamic;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure ToggleSwitch;
+  published
+    property Align;
+    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle
+      default bsNone;
+    property Caption;
+    property Color;
+    property Cursor;
+    property DragMode;
+    property DragCursor;
+    property Enabled;
+    property Font;
+    property GlyphOff: TBitmap read GetSwitchGlyphOff write SetSwitchGlyphOff
+      stored StoreBitmapOff;
+    property GlyphOn: TBitmap read GetSwitchGlyphOn write SetSwitchGlyphOn
+      stored StoreBitmapOn;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowFocus: Boolean read FShowFocus write SetShowFocus default True;
+    property ToggleKey: TShortCut read FToggleKey write FToggleKey
+      default VK_SPACE;
+    property ShowHint;
+    property StateOn: TSwithState read FStateOn write SetStateOn default sw_off;
+    property TabOrder;
+    property TabStop default True;
+    property TextPosition: TTextPos read FTextPosition write SetTextPosition
+      default tpNone;
+    property Anchors;
+    property Constraints;
+    property DragKind;
+    property Visible;
+    property OnClick;
+    property OnDblClick;
+    property OnEnter;
+    property OnExit;
+    property OnMouseMove;
+    property OnMouseDown;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnKeyDown;
+    property OnKeyUp;
+    property OnKeyPress;
+    property OnDragOver;
+    property OnDragDrop;
+    property OnEndDrag;
+    property OnStartDrag;
+    property OnContextPopup;
+    property OnEndDock;
+    property OnStartDock;
+    property OnOn: TNotifyEvent read FOnOn write FOnOn;
+    property OnOff: TNotifyEvent read FOnOff write FOnOff;
+  end;
+
+{$R rxswitch.res}
+
+implementation
+
+uses rxlclutils;
+
+const
+  BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
+
+{ TRxSwitch component }
+
+constructor TRxSwitch.Create(AOwner: TComponent);
+var
+  I : TSwithState;
+begin
+  inherited Create(AOwner);
+  ControlStyle := [csClickEvents, csSetCaption, csCaptureMouse,
+    csOpaque, csDoubleClicks];
+  Width := 50;
+  Height := 60;
+  for I := sw_off to sw_on do
+  begin
+    FBitmaps[I] := TBitmap.Create;
+    SetSwitchGlyph(I, nil);
+    FBitmaps[I].OnChange := @GlyphChanged;
+  end;
+  FUserBitmaps := [];
+  FShowFocus := True;
+  FStateOn := sw_off;
+  FTextPosition := tpNone;
+  FBorderStyle := bsNone;
+  FToggleKey := VK_SPACE;
+  TabStop := True;
+end;
+
+destructor TRxSwitch.Destroy;
+var
+  I: Byte;
+begin
+  for I := 0 to 1 do
+  begin
+    FBitmaps[TSwithState(I)].OnChange := nil;
+    FDisableBitmaps[TSwithState(I)].Free;
+    FBitmaps[TSwithState(I)].Free;
+  end;
+  inherited Destroy;
+end;
+
+procedure TRxSwitch.CreateParams(var Params: TCreateParams);
+begin
+  inherited CreateParams(Params);
+  with Params do begin
+    WindowClass.Style := WindowClass.Style or CS_HREDRAW or CS_VREDRAW;
+    Style := Style or Longword(BorderStyles[FBorderStyle]);
+  end;
+end;
+
+procedure TRxSwitch.DefineProperties(Filer: TFiler);
+
+  function DoWrite: Boolean;
+  begin
+    if Assigned(Filer.Ancestor) then
+      Result := FUserBitmaps <> TRxSwitch(Filer.Ancestor).FUserBitmaps
+    else Result := FUserBitmaps <> [];
+  end;
+
+begin
+  inherited DefineProperties(Filer);
+  Filer.DefineBinaryProperty('Data', @ReadBinaryData, @WriteBinaryData,
+    DoWrite);
+end;
+
+function TRxSwitch.GetPalette: HPALETTE;
+begin
+  if Enabled then Result := FBitmaps[FStateOn].Palette else Result := 0;
+end;
+
+procedure TRxSwitch.ReadBinaryData(Stream: TStream);
+begin
+  Stream.ReadBuffer(FUserBitmaps, SizeOf(FUserBitmaps));
+end;
+
+function TRxSwitch.StoreBitmapOff: boolean;
+begin
+  Result:=StoreBitmap(sw_off);
+end;
+
+function TRxSwitch.StoreBitmapOn: boolean;
+begin
+  Result:=StoreBitmap(sw_on);
+end;
+
+procedure TRxSwitch.WriteBinaryData(Stream: TStream);
+begin
+  Stream.WriteBuffer(FUserBitmaps, SizeOf(FUserBitmaps));
+end;
+
+function TRxSwitch.StoreBitmap(Index: TSwithState): Boolean;
+begin
+  Result := Index in FUserBitmaps;
+end;
+
+function TRxSwitch.GetSwitchGlyph(Index: TSwithState): TBitmap;
+begin
+  if csLoading in ComponentState then Include(FUserBitmaps, Index);
+  Result := FBitmaps[Index]
+end;
+
+procedure TRxSwitch.CreateDisabled(Index: TSwithState);
+begin
+  if FDisableBitmaps[Index] <> nil then
+    FDisableBitmaps[Index].Free;
+  try
+    FDisableBitmaps[Index] :=nil;
+//      CreateDisabledBitmap(FBitmaps[Index], clBlack);
+  except
+    FDisableBitmaps[Index] := nil;
+    raise;
+  end;
+end;
+
+procedure TRxSwitch.GlyphChanged(Sender: TObject);
+var
+  I: TSwithState;
+begin
+  for I := sw_off to sw_on do
+    if Sender = FBitmaps[I] then
+    begin
+      CreateDisabled(I);
+    end;
+  Invalidate;
+end;
+
+function TRxSwitch.GetSwitchGlyphOff: TBitmap;
+begin
+  Result:=GetSwitchGlyph(sw_off);
+end;
+
+function TRxSwitch.GetSwitchGlyphOn: TBitmap;
+begin
+  Result:=GetSwitchGlyph(sw_on);
+end;
+
+procedure TRxSwitch.SetSwitchGlyph(Index: TSwithState; Value: TBitmap);
+var
+  S: String;
+  B: TBitmap;
+begin
+  FBitmaps[Index].Clear;
+  if Value <> nil then
+  begin
+    FBitmaps[Index].Assign(Value);
+    Include(FUserBitmaps, Index);
+  end
+  else
+  begin
+    case Index of
+{      sw_off: FBitmaps[Index].Handle:=CreatePixmapIndirect(@RXSWITCH_OFF[0], GetSysColor(COLOR_BTNFACE));
+      sw_on: FBitmaps[Index].Handle:=CreatePixmapIndirect(@RXSWITCH_ON[0],
+                                          GetSysColor(COLOR_BTNFACE));}
+      sw_off:S:='rxswitch_off';
+      sw_on:S:='rxswitch_on';
+    else
+      Exit;
+    end;
+    B:=CreateResBitmap(S);
+    FBitmaps[Index].Assign(B);
+    B.Free;
+    Exclude(FUserBitmaps, Index);
+  end;
+end;
+
+procedure TRxSwitch.CMFocusChanged(var Message: TLMessage);
+var
+  Active: Boolean;
+begin
+{  with Message do Active := (Sender = Self);
+  if Active <> FActive then
+  begin
+    FActive := Active;
+    if FShowFocus then Invalidate;
+  end;}
+  inherited;
+end;
+
+procedure TRxSwitch.CMEnabledChanged(var Message: TLMessage);
+begin
+  inherited;
+  Invalidate;
+end;
+
+procedure TRxSwitch.CMTextChanged(var Message: TLMessage);
+begin
+  inherited;
+  Invalidate;
+end;
+
+procedure TRxSwitch.CMDialogChar(var Message: TCMDialogChar);
+begin
+  if IsAccel(Message.CharCode, Caption) and CanFocus then begin
+    SetFocus;
+    Message.Result := 1;
+  end;
+end;
+
+procedure TRxSwitch.MouseDown(Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  if Button = mbLeft then
+  begin
+    if TabStop and CanFocus then SetFocus;
+    ToggleSwitch;
+  end;
+  inherited MouseDown(Button, Shift, X, Y);
+end;
+
+procedure TRxSwitch.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  inherited KeyDown(Key, Shift);
+  if FToggleKey = ShortCut(Key, Shift) then begin
+    ToggleSwitch;
+    Key := 0;
+  end;
+end;
+
+procedure TRxSwitch.Paint;
+var
+  ARect: TRect;
+  Text1: array[0..255] of Char;
+  FontHeight: Integer;
+
+  procedure DrawBitmap(Bmp: TBitmap);
+  var
+    TmpImage: TBitmap;
+    IWidth, IHeight, X, Y: Integer;
+    IRect: TRect;
+  begin
+    IWidth := Bmp.Width;
+    IHeight := Bmp.Height;
+    IRect := Rect(0, 0, IWidth, IHeight);
+    TmpImage := TBitmap.Create;
+    try
+      TmpImage.Width := IWidth;
+      TmpImage.Height := IHeight;
+      TmpImage.Canvas.Brush.Color := Self.Brush.Color;
+//      TmpImage.Canvas.BrushCopy(IRect, Bmp, IRect, Bmp.TransparentColor);
+      X := 0; Y := 0;
+      case FTextPosition of
+        tpNone:
+          begin
+            X := ((Width - IWidth) div 2);
+            Y := ((Height - IHeight) div 2);
+          end;
+        tpLeft:
+          begin
+            X := Width - IWidth;
+            Y := ((Height - IHeight) div 2);
+            Dec(ARect.Right, IWidth);
+          end;
+        tpRight:
+          begin
+            X := 0;
+            Y := ((Height - IHeight) div 2);
+            Inc(ARect.Left, IWidth);
+          end;
+        tpAbove:
+          begin
+            X := ((Width - IWidth) div 2);
+            Y := Height - IHeight;
+            Dec(ARect.Bottom, IHeight);
+          end;
+        tpBelow:
+          begin
+            X := ((Width - IWidth) div 2);
+            Y := 0;
+            Inc(ARect.Top, IHeight);
+          end;
+      end;
+//      Canvas.Draw(X, Y, TmpImage);
+      Canvas.Draw(X, Y, Bmp);
+//      if Focused and FShowFocus and TabStop and not (csDesigning in ComponentState) then
+//        Canvas.DrawFocusRect(Rect(X, Y, X + IWidth, Y + IHeight));
+//        Canvas.FrameRect(Rect(X, Y, X + IWidth, Y + IHeight));
+    finally
+      TmpImage.Free;
+    end;
+  end;
+
+begin
+  ARect := GetClientRect;
+  with Canvas do
+  begin
+    Font := Self.Font;
+    Brush.Color := Self.Color;
+    FillRect(ARect);
+    if not Enabled and (FDisableBitmaps[FStateOn] <> nil) then
+      DrawBitmap(FDisableBitmaps[FStateOn])
+    else
+      DrawBitmap(FBitmaps[FStateOn]);
+    if FTextPosition <> tpNone then
+    begin
+      FontHeight := TextHeight('W');
+      with ARect do
+      begin
+        Top := ((Bottom + Top) - FontHeight) shr 1;
+        Bottom := Top + FontHeight;
+      end;
+      StrPCopy(Text1, Caption);
+      DrawText(Handle, Text1, StrLen(Text1), ARect, {DT_EXPANDTABS or }DT_VCENTER or DT_CENTER);
+    end;
+  end;
+end;
+
+procedure TRxSwitch.DoOn;
+begin
+  if Assigned(FOnOn) then FOnOn(Self);
+end;
+
+procedure TRxSwitch.DoOff;
+begin
+  if Assigned(FOnOff) then FOnOff(Self);
+end;
+
+procedure TRxSwitch.ToggleSwitch;
+begin
+  StateOn := TSwithState(not boolean(StateOn));
+end;
+
+procedure TRxSwitch.SetBorderStyle(Value: TBorderStyle);
+begin
+  if FBorderStyle <> Value then
+  begin
+    FBorderStyle := Value;
+    RecreateWnd(Self);
+  end;
+end;
+
+procedure TRxSwitch.SetStateOn(Value: TSwithState);
+begin
+  if FStateOn <> Value then
+  begin
+    FStateOn := Value;
+    Invalidate;
+    if Value = sw_on then
+      DoOn
+    else
+      DoOff;
+  end;
+end;
+
+procedure TRxSwitch.SetSwitchGlyphOff(const AValue: TBitmap);
+begin
+  SetSwitchGlyph(sw_off, AValue);
+end;
+
+procedure TRxSwitch.SetSwitchGlyphOn(const AValue: TBitmap);
+begin
+  SetSwitchGlyph(sw_on, AValue);
+end;
+
+procedure TRxSwitch.SetTextPosition(Value: TTextPos);
+begin
+  if FTextPosition <> Value then
+  begin
+    FTextPosition := Value;
+    Invalidate;
+  end;
+end;
+
+procedure TRxSwitch.SetShowFocus(Value: Boolean);
+begin
+  if FShowFocus <> Value then
+  begin
+    FShowFocus := Value;
+    if not (csDesigning in ComponentState) then Invalidate;
+  end;
+end;
+
+end.

RXLib/rxcontrols/rxsystemservices.pas

@@ -0,0 +1,143 @@
+{ RxSystemServices 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 RxSystemServices;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;
+
+type
+  TRxServiceType = (sstAll, sstService, sstDrivers);
+  TRxServiceStatus = (sssAll, sssActive, sssInactive);
+  TRxServiceState = (srsStoped,          //SERVICE_STOPPED          : S := 'Сервис не запущен'
+                     srsStartPending,    //SERVICE_START_PENDING    : S := 'Сервис в процессе запуска';
+                     srsStopPending,     //SERVICE_STOP_PENDING     : S := 'Сервис в процессе завершения';
+                     srsRunning,         //SERVICE_RUNNING          : S := 'Сервис запущен';
+                     srsContinuePending, //SERVICE_CONTINUE_PENDING : S := 'Сервис в процессе запуска после временной оснановки';
+                     srsPausePending,    //SERVICE_PAUSE_PENDING    : S := 'Сервис в процессе временной оснановки';
+                     srsPaused           //SERVICE_PAUSED           : S := 'Сервис временно оснановлен';
+                     );
+
+  TRxServiceItem = record
+    Name:string;
+    Description:string;
+    Status:TRxServiceState;
+  end;
+
+type
+
+  { TRxSystemServices }
+
+  TRxSystemServices = class(TComponent)
+  private
+    FItemCount: integer;
+    FServerName: string;
+    FServiceStatus: TRxServiceStatus;
+    FServiceType: TRxServiceType;
+    function GetItems(Index: integer): TRxServiceItem;
+    procedure SetItemCount(const AValue: integer);
+    procedure SetItems(Index: integer; const AValue: TRxServiceItem);
+    procedure SetServerName(const AValue: string);
+    procedure SetServiceStatus(const AValue: TRxServiceStatus);
+    procedure SetServiceType(const AValue: TRxServiceType);
+  protected
+    procedure ClearItems;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property Items[Index:integer]:TRxServiceItem read GetItems write SetItems;
+    property ItemCount:integer read FItemCount write SetItemCount;
+  published
+    property ServerName:string read FServerName write SetServerName;
+    property ServiceType:TRxServiceType read FServiceType write SetServiceType;     //(sstAll, sstService, sstDrivers);
+    property ServiceStatus:TRxServiceStatus read FServiceStatus write SetServiceStatus; //(sssAll, sssActive, sssInactive);
+  end;
+
+implementation
+
+{ TRxSystemServices }
+
+procedure TRxSystemServices.SetServerName(const AValue: string);
+begin
+  if FServerName=AValue then exit;
+  FServerName:=AValue;
+end;
+
+function TRxSystemServices.GetItems(Index: integer): TRxServiceItem;
+begin
+
+end;
+
+procedure TRxSystemServices.SetItemCount(const AValue: integer);
+begin
+  if FItemCount=AValue then exit;
+  FItemCount:=AValue;
+end;
+
+procedure TRxSystemServices.SetItems(Index: integer;
+  const AValue: TRxServiceItem);
+begin
+
+end;
+
+procedure TRxSystemServices.SetServiceStatus(const AValue: TRxServiceStatus);
+begin
+  if FServiceStatus=AValue then exit;
+  FServiceStatus:=AValue;
+end;
+
+procedure TRxSystemServices.SetServiceType(const AValue: TRxServiceType);
+begin
+  if FServiceType=AValue then exit;
+  FServiceType:=AValue;
+end;
+
+procedure TRxSystemServices.ClearItems;
+begin
+  FItemCount:=0;
+end;
+
+constructor TRxSystemServices.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+end;
+
+destructor TRxSystemServices.Destroy;
+begin
+  ClearItems;
+  inherited Destroy;
+end;
+
+end.

RXLib/rxcontrols/rxtbrsetup.lfm

@@ -0,0 +1,334 @@
+object ToolPanelSetupForm: TToolPanelSetupForm
+  Left = 383
+  Height = 487
+  Top = 176
+  Width = 657
+  ActiveControl = PageControl1
+  Caption = 'Tool panel setup'
+  ClientHeight = 487
+  ClientWidth = 657
+  FormStyle = fsStayOnTop
+  OnClose = FormClose
+  OnDestroy = FormDestroy
+  OnResize = FormResize
+  Position = poScreenCenter
+  LCLVersion = '1.7'
+  object PageControl1: TPageControl
+    Left = 0
+    Height = 433
+    Top = 0
+    Width = 657
+    ActivePage = TabSheet1
+    Align = alClient
+    TabIndex = 0
+    TabOrder = 0
+    object TabSheet1: TTabSheet
+      Caption = 'Visible buttons'
+      ClientHeight = 395
+      ClientWidth = 651
+      object Label1: TLabel
+        AnchorSideLeft.Control = BitBtn3
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = TabSheet1
+        Left = 347
+        Height = 20
+        Top = 6
+        Width = 112
+        BorderSpacing.Around = 6
+        Caption = 'Avaliable buttons'
+        FocusControl = ListBtnAvaliable
+        ParentColor = False
+      end
+      object Label2: TLabel
+        AnchorSideTop.Control = TabSheet1
+        Left = 8
+        Height = 20
+        Top = 6
+        Width = 97
+        BorderSpacing.Around = 6
+        Caption = 'Visible buttons'
+        FocusControl = ListBtnVisible
+        ParentColor = False
+      end
+      object BitBtn3: TBitBtn
+        AnchorSideLeft.Control = BitBtn6
+        AnchorSideTop.Control = BitBtn4
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = BitBtn6
+        AnchorSideRight.Side = asrBottom
+        Left = 309
+        Height = 30
+        Top = 160
+        Width = 32
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        BorderSpacing.InnerBorder = 2
+        Caption = '<<'
+        OnClick = BitBtn3Click
+        TabOrder = 0
+      end
+      object BitBtn4: TBitBtn
+        AnchorSideLeft.Control = BitBtn6
+        AnchorSideTop.Control = BitBtn5
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = BitBtn6
+        AnchorSideRight.Side = asrBottom
+        Left = 309
+        Height = 36
+        Top = 118
+        Width = 32
+        Anchors = [akTop, akLeft, akRight]
+        AutoSize = True
+        BorderSpacing.Top = 6
+        BorderSpacing.InnerBorder = 2
+        Caption = '<'
+        OnClick = BitBtn4Click
+        TabOrder = 1
+      end
+      object BitBtn5: TBitBtn
+        AnchorSideLeft.Control = BitBtn6
+        AnchorSideTop.Control = BitBtn6
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = BitBtn6
+        AnchorSideRight.Side = asrBottom
+        Left = 309
+        Height = 38
+        Top = 74
+        Width = 32
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        BorderSpacing.InnerBorder = 2
+        Caption = '>'
+        OnClick = BitBtn5Click
+        TabOrder = 2
+      end
+      object BitBtn6: TBitBtn
+        AnchorSideLeft.Control = TabSheet1
+        AnchorSideLeft.Side = asrCenter
+        AnchorSideTop.Control = ListBtnAvaliable
+        Left = 309
+        Height = 36
+        Top = 32
+        Width = 32
+        AutoSize = True
+        BorderSpacing.InnerBorder = 2
+        Caption = '>>'
+        OnClick = BitBtn6Click
+        TabOrder = 3
+      end
+      object ListBtnAvaliable: TListBox
+        AnchorSideLeft.Control = BitBtn3
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = Label1
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = TabSheet1
+        AnchorSideRight.Side = asrBottom
+        AnchorSideBottom.Control = cbShowCaption
+        Left = 347
+        Height = 259
+        Top = 32
+        Width = 298
+        Anchors = [akTop, akLeft, akRight, akBottom]
+        BorderSpacing.Around = 6
+        IntegralHeight = True
+        Items.Strings = (
+          '111'
+          '222'
+          '333'
+          '44'
+          '555'
+          '666'
+          '777'
+        )
+        ItemHeight = 0
+        OnClick = ListBtnAvaliableClick
+        OnDblClick = ListBtnVisibleDblClick
+        OnDrawItem = ListBox1DrawItem
+        ScrollWidth = 296
+        Style = lbOwnerDrawFixed
+        TabOrder = 4
+      end
+      object ListBtnVisible: TListBox
+        AnchorSideLeft.Control = Label2
+        AnchorSideTop.Control = Label2
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = BitBtn6
+        AnchorSideBottom.Control = cbShowCaption
+        Left = 14
+        Height = 259
+        Top = 32
+        Width = 289
+        Anchors = [akTop, akLeft, akRight, akBottom]
+        BorderSpacing.Around = 6
+        ItemHeight = 0
+        OnClick = ListBtnAvaliableClick
+        OnDblClick = ListBtnVisibleDblClick
+        OnDrawItem = ListBox1DrawItem
+        ScrollWidth = 287
+        Style = lbOwnerDrawFixed
+        TabOrder = 5
+        TopIndex = -1
+      end
+      object Panel1: TPanel
+        AnchorSideBottom.Control = TabSheet1
+        AnchorSideBottom.Side = asrBottom
+        Left = 3
+        Height = 62
+        Top = 327
+        Width = 639
+        Alignment = taLeftJustify
+        Anchors = [akLeft, akRight, akBottom]
+        BorderSpacing.Around = 6
+        BevelOuter = bvLowered
+        FullRepaint = False
+        TabOrder = 6
+      end
+      object cbShowCaption: TCheckBox
+        AnchorSideLeft.Control = TabSheet1
+        AnchorSideBottom.Control = Panel1
+        Left = 6
+        Height = 24
+        Top = 297
+        Width = 112
+        Anchors = [akLeft, akBottom]
+        BorderSpacing.Around = 6
+        Caption = 'Show caption'
+        OnChange = cbShowCaptionChange
+        TabOrder = 7
+      end
+    end
+    object TabSheet2: TTabSheet
+      Caption = 'Options'
+      ClientHeight = 395
+      ClientWidth = 651
+      object cbShowHint: TCheckBox
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = cbTransp
+        AnchorSideTop.Side = asrBottom
+        Left = 6
+        Height = 24
+        Top = 178
+        Width = 90
+        BorderSpacing.Around = 6
+        Caption = 'Show hint'
+        TabOrder = 0
+      end
+      object cbTransp: TCheckBox
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = cbFlatBtn
+        AnchorSideTop.Side = asrBottom
+        Left = 6
+        Height = 24
+        Top = 148
+        Width = 101
+        BorderSpacing.Around = 6
+        Caption = 'Transparent'
+        TabOrder = 1
+      end
+      object cbFlatBtn: TCheckBox
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = RadioGroup1
+        AnchorSideTop.Side = asrBottom
+        Left = 6
+        Height = 24
+        Top = 118
+        Width = 104
+        BorderSpacing.Around = 6
+        Caption = 'Flat buttons'
+        TabOrder = 2
+      end
+      object RadioGroup1: TRadioGroup
+        AnchorSideLeft.Control = Panel2
+        AnchorSideLeft.Side = asrBottom
+        AnchorSideTop.Control = TabSheet2
+        AnchorSideRight.Control = TabSheet2
+        AnchorSideRight.Side = asrBottom
+        Left = 333
+        Height = 106
+        Top = 6
+        Width = 312
+        Anchors = [akTop, akLeft, akRight]
+        AutoFill = False
+        AutoSize = True
+        BorderSpacing.Around = 6
+        Caption = 'Button align'
+        ChildSizing.LeftRightSpacing = 6
+        ChildSizing.TopBottomSpacing = 6
+        ChildSizing.ShrinkHorizontal = crsScaleChilds
+        ChildSizing.ShrinkVertical = crsScaleChilds
+        ChildSizing.Layout = cclLeftToRightThenTopToBottom
+        ChildSizing.ControlsPerLine = 1
+        ClientHeight = 84
+        ClientWidth = 308
+        Items.Strings = (
+          'None'
+          'Left'
+          'Rignt'
+        )
+        TabOrder = 3
+        TabStop = True
+      end
+      object RadioGroup2: TRadioGroup
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideTop.Control = TabSheet2
+        AnchorSideRight.Control = Panel2
+        Left = 6
+        Height = 106
+        Top = 6
+        Width = 312
+        Anchors = [akTop, akLeft, akRight]
+        AutoFill = True
+        AutoSize = True
+        BorderSpacing.Around = 6
+        Caption = 'Tool bar style'
+        ChildSizing.LeftRightSpacing = 6
+        ChildSizing.TopBottomSpacing = 6
+        ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+        ChildSizing.EnlargeVertical = crsHomogenousChildResize
+        ChildSizing.ShrinkHorizontal = crsScaleChilds
+        ChildSizing.ShrinkVertical = crsScaleChilds
+        ChildSizing.Layout = cclLeftToRightThenTopToBottom
+        ChildSizing.ControlsPerLine = 1
+        ClientHeight = 84
+        ClientWidth = 308
+        Items.Strings = (
+          'Standart'
+          'Windows XP'
+          'Native'
+        )
+        TabOrder = 4
+        TabStop = True
+      end
+      object Panel2: TPanel
+        AnchorSideLeft.Control = TabSheet2
+        AnchorSideLeft.Side = asrCenter
+        AnchorSideTop.Control = TabSheet2
+        AnchorSideBottom.Control = TabSheet2
+        AnchorSideBottom.Side = asrBottom
+        Left = 324
+        Height = 383
+        Top = 6
+        Width = 3
+        Anchors = [akTop, akLeft, akBottom]
+        BorderSpacing.Around = 6
+        TabOrder = 5
+      end
+    end
+  end
+  object ButtonPanel1: TButtonPanel
+    Left = 6
+    Height = 42
+    Top = 439
+    Width = 645
+    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 = 1
+    ShowButtons = [pbClose, pbHelp]
+  end
+end

RXLib/rxcontrols/rxtbrsetup.pas

@@ -0,0 +1,356 @@
+{ rxtbrsetup 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 rxtbrsetup;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
+  rxtoolbar, StdCtrls, ComCtrls, ExtCtrls, ButtonPanel;
+
+type
+
+  { TToolPanelSetupForm }
+
+  TToolPanelSetupForm = class(TForm)
+    BitBtn3: TBitBtn;
+    BitBtn4: TBitBtn;
+    BitBtn5: TBitBtn;
+    BitBtn6: TBitBtn;
+    ButtonPanel1: TButtonPanel;
+    cbShowHint: TCheckBox;
+    cbTransp: TCheckBox;
+    cbFlatBtn: TCheckBox;
+    cbShowCaption: TCheckBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    ListBtnAvaliable: TListBox;
+    ListBtnVisible: TListBox;
+    PageControl1: TPageControl;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    RadioGroup1: TRadioGroup;
+    RadioGroup2: TRadioGroup;
+    TabSheet1: TTabSheet;
+    TabSheet2: TTabSheet;
+    procedure BitBtn3Click(Sender: TObject);
+    procedure BitBtn4Click(Sender: TObject);
+    procedure BitBtn5Click(Sender: TObject);
+    procedure BitBtn6Click(Sender: TObject);
+    procedure CheckBox1Change(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormResize(Sender: TObject);
+    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
+    procedure ListBtnAvaliableClick(Sender: TObject);
+    procedure cbShowCaptionChange(Sender: TObject);
+    procedure ListBtnVisibleDblClick(Sender: TObject);
+  private
+    procedure FillItems(List:TStrings; AVisible:boolean);
+    procedure UpdateStates;
+    procedure Localize;
+  public
+    FToolPanel:TToolPanel;
+    constructor CreateSetupForm(AToolPanel:TToolPanel);
+  end; 
+
+var
+  ToolPanelSetupForm: TToolPanelSetupForm;
+
+implementation
+uses rxlclutils, ActnList, rxboxprocs, rxconst, LCLProc, rxShortCutUnit;
+
+{$R *.lfm}
+
+type
+  THackToolPanel = class(TToolPanel);
+{ TToolPanelSetupForm }
+
+procedure TToolPanelSetupForm.FormDestroy(Sender: TObject);
+begin
+  if Assigned(FToolPanel) then
+  begin
+    THackToolPanel(FToolPanel).SetCustomizing(false);
+    THackToolPanel(FToolPanel).FCustomizer:=nil;
+  end;
+end;
+
+procedure TToolPanelSetupForm.FormResize(Sender: TObject);
+begin
+  ListBtnVisible.Width:=BitBtn6.Left - 4 - ListBtnVisible.Left;
+  ListBtnAvaliable.Left:=BitBtn6.Left + BitBtn6.Width + 4;
+  ListBtnAvaliable.Width:=Width - ListBtnAvaliable.Left - 4;
+  Label1.Left:=ListBtnAvaliable.Left;
+end;
+
+procedure TToolPanelSetupForm.ListBox1DrawItem(Control: TWinControl;
+  Index: Integer; ARect: TRect; State: TOwnerDrawState);
+var
+  Offset:integer;
+  P:TToolbarItem;
+  BtnRect:TRect;
+  Cnv:TCanvas;
+  C: TColor;
+  S: String;
+begin
+  Cnv:=(Control as TListBox).Canvas;
+  C:=Cnv.Brush.Color;
+  Cnv.FillRect(ARect);       { clear the rectangle }
+  P:=TToolbarItem((Control as TListBox).Items.Objects[Index]);
+  if Assigned(P) then
+  begin
+    if Assigned(FToolPanel.ImageList) and Assigned(P.Action) then
+    begin
+      if (P.Action is TCustomAction) and
+         (TCustomAction(P.Action).ImageIndex>-1) and
+         (TCustomAction(P.Action).ImageIndex < FToolPanel.ImageList.Count) then
+      begin
+        Offset := 2;
+        BtnRect.Top:=ARect.Top + 2;
+        BtnRect.Left:=ARect.Left + Offset;
+        BtnRect.Right:=BtnRect.Left + FToolPanel.BtnWidth;
+        BtnRect.Bottom:=BtnRect.Top + FToolPanel.BtnHeight;
+        Cnv.Brush.Color := clBtnFace;
+        Cnv.FillRect(BtnRect);
+        DrawButtonFrame(Cnv, BtnRect, false, false);
+        FToolPanel.ImageList.Draw(Cnv, BtnRect.Left + (FToolPanel.BtnWidth - FToolPanel.ImageList.Width) div 2,
+                                       BtnRect.Top + (FToolPanel.BtnHeight - FToolPanel.ImageList.Height) div 2,
+                                       TCustomAction(P.Action).ImageIndex, True);
+        Offset:=BtnRect.Right;
+      end;
+      Offset := Offset + 6;
+      Cnv.Brush.Color:=C;
+      Cnv.TextOut(ARect.Left + Offset, (ARect.Top + ARect.Bottom  - Cnv.TextHeight('Wg')) div 2, TCustomAction(P.Action).Caption);  { display the text }
+      if (P.Action is TAction) then
+        if TAction(P.Action).ShortCut <> 0 then
+        begin
+          S:=ShortCutToText(TAction(P.Action).ShortCut);
+          if S<> '' then
+            Cnv.TextOut(ARect.Right - Cnv.TextWidth(S) - 2, (ARect.Top + ARect.Bottom  - Cnv.TextHeight('Wg')) div 2, S);  { display the shortut caption }
+        end;
+    end;
+  end;
+end;
+
+procedure TToolPanelSetupForm.ListBtnAvaliableClick(Sender: TObject);
+begin
+  with (Sender as TListBox) do
+  begin
+    if (ItemIndex>-1) and (ItemIndex<Items.Count) then
+    begin
+      Panel1.Caption:=TCustomAction(TToolbarItem(Items.Objects[ItemIndex]).Action).Hint;
+      if Sender = ListBtnVisible then
+        cbShowCaption.Checked:=TToolbarItem(Items.Objects[ItemIndex]).ShowCaption;
+    end;
+  end;
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.cbShowCaptionChange(Sender: TObject);
+begin
+  if (ListBtnVisible.ItemIndex>-1) and (ListBtnVisible.ItemIndex<ListBtnVisible.Items.Count) then
+    TToolbarItem(ListBtnVisible.Items.Objects[ListBtnVisible.ItemIndex]).ShowCaption:=cbShowCaption.Checked;
+end;
+
+procedure TToolPanelSetupForm.ListBtnVisibleDblClick(Sender: TObject);
+var
+  Act: TBasicAction;
+  A: TShortCut;
+begin
+  if FToolPanel.CustomizeShortCut then
+  if (TListBox(Sender).ItemIndex>-1) and (TListBox(Sender).ItemIndex<TListBox(Sender).Items.Count) then
+  begin
+    Act:=TToolbarItem(TListBox(Sender).Items.Objects[TListBox(Sender).ItemIndex]).Action;
+    if Act is TCustomAction then
+    begin
+      A:=TCustomAction(Act).ShortCut;
+      Hide;
+      if RxSelectShortCut(A) then
+      begin
+        TCustomAction(Act).ShortCut:=A;
+        TListBox(Sender).Invalidate;
+      end;
+      Show;
+    end;
+  end;
+end;
+
+procedure TToolPanelSetupForm.FillItems(List: TStrings; AVisible: boolean);
+var
+  i, p:integer;
+begin
+  List.Clear;
+  for i:=0 to FToolPanel.Items.Count - 1 do
+  begin
+    if (FToolPanel.Items[i].Visible = AVisible) and Assigned(FToolPanel.Items[i].Action) then
+    begin
+      P:=List.Add(FToolPanel.Items[i].Action.Name);
+      List.Objects[P]:=FToolPanel.Items[i];
+    end;
+  end;
+end;
+
+procedure TToolPanelSetupForm.UpdateStates;
+var
+  i:integer;
+begin
+  for I:=0 to ListBtnVisible.Items.Count - 1 do
+    TToolbarItem(ListBtnVisible.Items.Objects[i]).Visible:=true;
+
+  for I:=0 to ListBtnAvaliable.Items.Count - 1 do
+    TToolbarItem(ListBtnAvaliable.Items.Objects[i]).Visible:=false;
+    
+  BitBtn6.Enabled:=ListBtnVisible.Items.Count>0;
+  BitBtn5.Enabled:=ListBtnVisible.Items.Count>0;
+  cbShowCaption.Enabled:=(ListBtnVisible.Items.Count>0) and (ListBtnVisible.ItemIndex>=0);
+
+  BitBtn4.Enabled:=ListBtnAvaliable.Items.Count>0;
+  BitBtn3.Enabled:=ListBtnAvaliable.Items.Count>0;
+
+  cbFlatBtn.Checked:=tpFlatBtns in FToolPanel.Options;
+end;
+
+procedure TToolPanelSetupForm.Localize;
+begin
+  Caption:=sToolPanelSetup;
+  TabSheet1.Caption:=sVisibleButtons;
+  TabSheet2.Caption:=sOptions;
+  Label2.Caption:=sVisibleButtons;
+  Label2.Caption:=sVisibleButtons;
+  Label1.Caption:=sAvaliableButtons;
+  cbShowCaption.Caption:=sShowCaption;
+  RadioGroup2.Caption:=sToolBarStyle;
+  RadioGroup2.Items.Clear;
+  RadioGroup2.Items.Add(sToolBarStyle1);
+  RadioGroup2.Items.Add(sToolBarStyle2);
+  RadioGroup2.Items.Add(sToolBarStyle3);
+  cbFlatBtn.Caption:=sFlatButtons;
+  cbTransp.Caption:=sTransparent;
+  cbShowHint.Caption:=sShowHint;
+  RadioGroup1.Caption:=sButtonAlign;
+  RadioGroup1.Items.Clear;
+  RadioGroup1.Items.Add(sButtonAlign1);
+  RadioGroup1.Items.Add(sButtonAlign2);
+  RadioGroup1.Items.Add(sButtonAlign3);
+end;
+
+procedure TToolPanelSetupForm.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction:=caFree;
+end;
+
+procedure TToolPanelSetupForm.CheckBox1Change(Sender: TObject);
+var
+  tpo:TToolPanelOptions;
+begin
+  tpo:=FToolPanel.Options;
+  if cbTransp.Checked then
+    tpo:=tpo + [tpTransparentBtns]
+  else
+    tpo:=tpo - [tpTransparentBtns];
+
+  FToolPanel.ToolBarStyle:=TToolBarStyle(RadioGroup2.ItemIndex);
+
+  if cbFlatBtn.Checked then
+    tpo:=tpo + [tpFlatBtns]
+  else
+    tpo:=tpo - [tpFlatBtns];
+
+  FToolPanel.ShowHint:=cbShowHint.Checked;
+  FToolPanel.Options:=tpo;
+  
+  FToolPanel.ButtonAllign:=TToolButtonAllign(RadioGroup1.ItemIndex);
+  cbFlatBtn.Checked:=tpFlatBtns in FToolPanel.Options;
+end;
+
+procedure TToolPanelSetupForm.BitBtn4Click(Sender: TObject);
+begin
+  BoxMoveSelectedItems(ListBtnAvaliable, ListBtnVisible);
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.BitBtn3Click(Sender: TObject);
+begin
+  BoxMoveAllItems(ListBtnAvaliable, ListBtnVisible);
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.BitBtn5Click(Sender: TObject);
+begin
+  BoxMoveSelectedItems(ListBtnVisible, ListBtnAvaliable);
+  UpdateStates;
+end;
+
+procedure TToolPanelSetupForm.BitBtn6Click(Sender: TObject);
+begin
+  BoxMoveAllItems(ListBtnVisible, ListBtnAvaliable);
+  UpdateStates;
+end;
+
+constructor TToolPanelSetupForm.CreateSetupForm(AToolPanel: TToolPanel);
+begin
+  inherited Create(AToolPanel);
+  Localize;
+  PageControl1.ActivePageIndex:=0;
+  FormResize(nil);
+  FToolPanel:=AToolPanel;
+
+
+  cbFlatBtn.Checked:=tpFlatBtns in FToolPanel.Options;
+  cbTransp.Checked:=tpTransparentBtns in FToolPanel.Options;
+  cbShowHint.Checked:=FToolPanel.ShowHint;
+
+  ListBtnAvaliable.ItemHeight:=FToolPanel.BtnHeight + 4;
+  ListBtnVisible.ItemHeight:=FToolPanel.BtnHeight + 4;
+
+  FillItems(ListBtnVisible.Items, true);
+  FillItems(ListBtnAvaliable.Items, false);
+
+  RadioGroup1.ItemIndex:=Ord(FToolPanel.ButtonAllign);
+  RadioGroup2.ItemIndex:=Ord(FToolPanel.ToolBarStyle);
+
+  UpdateStates;
+
+  cbFlatBtn.OnChange:=@CheckBox1Change;
+  cbTransp.OnChange:=@CheckBox1Change;
+  cbShowHint.OnChange:=@CheckBox1Change;
+  RadioGroup1.OnClick:=@CheckBox1Change;
+  RadioGroup2.OnClick:=@CheckBox1Change;
+
+end;
+
+end.
+

RXLib/rxcontrols/rxtimeedit.pas

@@ -0,0 +1,363 @@
+{ RxTimeEdit 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 RxTimeEdit;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, rxspin,
+  MaskEdit, LMessages, LCLType;
+
+type
+
+  { TCustomRxTimeEdit }
+
+  TCustomRxTimeEdit = class(TCustomMaskEdit)
+  private
+    FButton: TRxSpinButton;
+    FButtonNeedsFocus: Boolean;
+    FOnButtonClick : TNotifyEvent;
+    FShowSecond: boolean;
+    FDisplayFormat:string;
+    procedure CheckButtonVisible;
+    function GetButtonHint: TTranslateString;
+    function GetTime: TTime;
+    procedure SetButtonHint(const AValue: TTranslateString);
+    procedure SetButtonNeedsFocus(const AValue: Boolean);
+    procedure SetShowSecond(AValue: boolean);
+    procedure SetTime(const AValue: TTime);
+    procedure DoChangeValue(AValue:integer);
+    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
+    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
+    procedure SetEnabled(Value: Boolean); override;
+  protected
+    procedure UpdateEditFormat;
+    procedure SetParent(AParent: TWinControl); override;
+    procedure DoPositionButton; virtual;
+    procedure UpClick(Sender: TObject); virtual;
+    procedure DownClick(Sender: TObject); virtual;
+    property ButtonOnlyWhenFocused: Boolean read FButtonNeedsFocus write SetButtonNeedsFocus default False;
+    property OnButtonClick : TNotifyEvent read FOnButtonClick write FOnButtonClick;
+    property ButtonHint: TTranslateString read GetButtonHint write SetButtonHint;
+    property ShowSecond:boolean read FShowSecond write SetShowSecond;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property Time:TTime read GetTime write SetTime;
+  end;
+
+type
+  TRxTimeEdit = class(TCustomRxTimeEdit)
+  public
+    property Text;
+  published
+    property ShowSecond;
+    property AutoSize;
+    property AutoSelect;
+    property Align;
+    property Anchors;
+    property BorderSpacing;
+    property ButtonOnlyWhenFocused;
+    property ButtonHint;
+    property CharCase;
+    property Color;
+//    property DirectInput;
+    property DragCursor;
+    property DragMode;
+    property EchoMode;
+    property Enabled;
+//    property Flat;
+    property Font;
+//    property Glyph;
+    property MaxLength;
+//    property NumGlyphs;
+    property OnButtonClick;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEditingDone;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnStartDrag;
+    property OnUTF8KeyPress;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PasswordChar;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+  end;
+
+implementation
+
+
+{ TCustomRxTimeEdit }
+
+procedure TCustomRxTimeEdit.CheckButtonVisible;
+begin
+  If Assigned(FButton) then
+    FButton.Visible:=(csdesigning in ComponentState) or
+                     (Visible and (Focused or not FButtonNeedsFocus));
+end;
+
+function TCustomRxTimeEdit.GetButtonHint: TTranslateString;
+begin
+  Result:=FButton.Hint;
+end;
+
+function TCustomRxTimeEdit.GetTime: TTime;
+begin
+  Result:=StrToTimeDef(Text, 0);
+end;
+
+procedure TCustomRxTimeEdit.SetButtonHint(const AValue: TTranslateString);
+begin
+  if AValue = '' then
+    FButton.Hint:=Hint
+  else
+    FButton.Hint:=AValue;
+end;
+
+procedure TCustomRxTimeEdit.SetButtonNeedsFocus(const AValue: Boolean);
+begin
+  if FButtonNeedsFocus<>AValue then
+  begin
+    FButtonNeedsFocus:=AValue;
+    CheckButtonVisible;
+  end;
+end;
+
+procedure TCustomRxTimeEdit.SetShowSecond(AValue: boolean);
+begin
+  if FShowSecond=AValue then Exit;
+  FShowSecond:=AValue;
+  UpdateEditFormat;
+end;
+
+procedure TCustomRxTimeEdit.SetTime(const AValue: TTime);
+var
+  H, M, S, MS: word;
+begin
+  DecodeTime(AValue, H, M, S, MS);
+  Text:=Format(FDisplayFormat, [H, M, S, MS]);
+  //Text:=TimeToStr(AValue);
+end;
+
+procedure TCustomRxTimeEdit.DoChangeValue(AValue: integer);
+var
+  S:ShortString;
+  H1, M2, S3:Integer;
+  i,p:integer;
+
+procedure IncHour;
+begin
+  H1:=H1+AValue;
+  if H1>23 then
+    H1:=0
+  else
+  if H1<0 then
+    H1:=23;
+end;
+
+procedure IncMin;
+begin
+  M2:=M2+AValue;
+  if M2>59 then
+    M2:=0
+  else
+  if M2<0 then
+    M2:=59
+  else
+    exit;
+  IncHour;
+end;
+
+procedure IncSec;
+begin
+  S3:=S3+AValue;
+  if S3>59 then
+    S3:=0
+  else
+  if S3<0 then
+    S3:=59
+  else
+    exit;
+  IncMin;
+end;
+
+begin
+  S:=Text;
+  for i:=1 to Length(S) do
+    if S[i]=' ' then
+      S[i]:='0';
+
+  H1:=StrToInt(S[1]+S[2]);
+  M2:=StrToInt(S[4]+S[5]);
+  if FShowSecond then
+    S3:=StrToInt(S[7]+S[8])
+  else
+    S3:=0;
+  P:=GetSelStart;
+  if P < 3 then
+    IncHour
+  else
+  if P < 6 then
+    IncMin
+  else
+  if FShowSecond then
+    IncSec;
+  //Text:=Format('%2.2d'+ DefaultFormatSettings.TimeSeparator +'%2.2d'+ DefaultFormatSettings.TimeSeparator +'%2.2d', [H1, M2, S3]);
+  SetTime(EncodeTime(H1, M2, S3, 0));
+  SetSelStart(P);
+end;
+
+procedure TCustomRxTimeEdit.WMSetFocus(var Message: TLMSetFocus);
+begin
+  FButton.Visible:=True;
+  inherited;
+end;
+
+procedure TCustomRxTimeEdit.WMKillFocus(var Message: TLMKillFocus);
+begin
+  if FButtonNeedsFocus then
+    FButton.Visible:=False;
+  inherited;
+end;
+
+procedure TCustomRxTimeEdit.SetEnabled(Value: Boolean);
+begin
+  inherited SetEnabled(Value);
+  FButton.Enabled:=Value;
+end;
+
+procedure TCustomRxTimeEdit.UpdateEditFormat;
+var
+  FOldTime: TTime;
+begin
+  FOldTime:=GetTime;
+  if FShowSecond then
+  begin
+    EditMask:='!#0'+DefaultFormatSettings.TimeSeparator + '00'+DefaultFormatSettings.TimeSeparator + '00;1;_';
+    FDisplayFormat:='%2.2d'+ DefaultFormatSettings.TimeSeparator +'%2.2d'+ DefaultFormatSettings.TimeSeparator +'%2.2d';
+  end
+  else
+  begin
+    EditMask:='!#0'+DefaultFormatSettings.TimeSeparator + '00;1;_';
+    FDisplayFormat:='%2.2d'+ DefaultFormatSettings.TimeSeparator +'%2.2d';
+  end;
+  SetTime(FOldTime);
+end;
+
+procedure TCustomRxTimeEdit.SetParent(AParent: TWinControl);
+begin
+  inherited SetParent(AParent);
+  if FButton <> nil then
+  begin
+    DoPositionButton;
+    CheckButtonVisible;
+  end;
+end;
+
+procedure TCustomRxTimeEdit.DoPositionButton;
+begin
+  if FButton = nil then exit;
+  FButton.Parent := Parent;
+  FButton.Visible := Visible;
+  FButton.AnchorToCompanion(akLeft,0,Self);
+//  if FButton.Width = 0 then
+    FButton.Width:=26;//Height;
+end;
+
+procedure TCustomRxTimeEdit.UpClick(Sender: TObject);
+begin
+  if not ReadOnly then
+  begin
+    DoChangeValue(1);
+    if Assigned(FOnButtonClick) then
+      FOnButtonClick(Self);
+  end;
+end;
+
+procedure TCustomRxTimeEdit.DownClick(Sender: TObject);
+begin
+  if not ReadOnly then
+  begin
+    DoChangeValue(-1);
+    if Assigned(FOnButtonClick) then
+      FOnButtonClick(Self);
+  end;
+end;
+
+constructor TCustomRxTimeEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FShowSecond:=true;
+  FButton := TRxSpinButton.Create(Self);
+  FButton.FocusControl := Self;
+  FButton.Width := Self.Height;
+  FButton.Height := Self.Height;
+  FButton.FreeNotification(Self);
+  FButton.ControlStyle := FButton.ControlStyle + [csNoDesignSelectable];
+  FButton.OnTopClick := @UpClick;
+  FButton.OnBottomClick := @DownClick;
+
+  UpdateEditFormat;
+end;
+
+destructor TCustomRxTimeEdit.Destroy;
+begin
+  if FButton <> nil then
+    FreeAndNil(FButton);
+  inherited Destroy;
+end;
+
+initialization
+  RegisterPropertyToSkip(TRxTimeEdit, 'Text', '', '');
+end.

RXLib/rxcontrols/rxtooledit.pas

@@ -0,0 +1,982 @@
+{ tooledit 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 rxtooledit;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LCLType, LMessages, Graphics, MaskEdit, Controls, EditBtn,
+  LCLVersion, rxpickdate, rxdateutil;
+
+type
+  { TCustomDateEdit }
+
+  TYearDigits = (dyDefault, dyFour, dyTwo);
+  TPopupAlign = (epaRight, epaLeft);
+  TCalendarStyle = (csPopup, csDialog);
+
+const
+{$IFDEF DEFAULT_POPUP_CALENDAR}
+  dcsDefault = csPopup;
+{$ELSE}
+  dcsDefault = csDialog;
+{$ENDIF DEFAULT_POPUP_CALENDAR}
+
+type
+
+  { TCustomRxDateEdit }
+
+  TCustomRxDateEdit = class(TCustomEditButton)
+  private
+    FCalendarHints: TStrings;
+    FBlanksChar: Char;
+    FCancelCaption: TCaption;
+    FDefaultToday: Boolean;
+    FDialogTitle: TCaption;
+    FPopupColor: TColor;
+    FNotInThisMonthColor:TColor;
+    FOKCaption: TCaption;
+    FOnAcceptDAte: TAcceptDateEvent;
+    FStartOfWeek: TDayOfWeekName;
+    FWeekendColor: TColor;
+    FWeekends: TDaysOfWeek;
+    FYearDigits: TYearDigits;
+    FDateFormat: string[10];
+    FFormatting: Boolean;
+    FPopupVisible: Boolean;
+    FPopupAlign: TPopupAlign;
+    FCalendarStyle: TCalendarStyle;
+    //function GetCalendarStyle: TCalendarStyle;
+    function GetDate: TDateTime;
+    function GetPopupColor: TColor;
+    function GetPopupVisible: Boolean;
+    function GetValidDate: boolean;
+    function IsStoreTitle: boolean;
+    procedure SetBlanksChar(const AValue: Char);
+    procedure SetCalendarStyle(const AValue: TCalendarStyle);
+    procedure SetDate(const AValue: TDateTime);
+    procedure SetPopupColor(const AValue: TColor);
+    procedure SetStartOfWeek(const AValue: TDayOfWeekName);
+    procedure SetWeekendColor(const AValue: TColor);
+    procedure SetWeekends(const AValue: TDaysOfWeek);
+    procedure SetYearDigits(const AValue: TYearDigits);
+    procedure CalendarHintsChanged(Sender: TObject);
+
+    function AcceptPopup(var Value: TDateTime): Boolean;
+    procedure AcceptValue(const AValue: TDateTime);
+//    procedure SetPopupValue(const Value: Variant);
+  protected
+    FPopup: TPopupCalendar;
+    procedure UpdateFormat;
+    procedure UpdatePopup;
+    function TextStored: Boolean;
+    procedure PopupDropDown(DisableEdit: Boolean); virtual;
+    procedure PopupCloseUp(Sender: TObject; Accept: Boolean);
+    procedure HidePopup; virtual;
+    procedure ShowPopup(AOrigin: TPoint); virtual;
+    procedure ApplyDate(Value: TDateTime); virtual;
+    procedure EditChange; override;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure KeyPress(var Key: Char); override;
+
+    procedure ButtonClick; override;
+    procedure EditKeyDown(var Key: word; Shift: TShiftState); override;
+    procedure EditKeyPress( var Key: char); override;
+
+    {$IF lcl_fullversion < 01090000}
+    function GetDefaultGlyph: TBitmap; override;
+    {$ENDIF}
+    function GetDefaultGlyphName: String; override;
+    function CreatePopupForm:TPopupCalendar;
+    procedure DoEnter; override;
+
+    property BlanksChar: Char read FBlanksChar write SetBlanksChar default ' ';
+    property DialogTitle:TCaption Read FDialogTitle Write FDialogTitle Stored IsStoreTitle;
+    Property OnAcceptDate : TAcceptDateEvent Read FOnAcceptDAte Write FOnAcceptDate;
+    property OKCaption:TCaption Read FOKCaption Write FOKCaption;
+    property CancelCaption:TCaption Read FCancelCaption Write FCancelCaption;
+    property DefaultToday: Boolean read FDefaultToday write FDefaultToday
+      default False;
+    property StartOfWeek: TDayOfWeekName read FStartOfWeek write SetStartOfWeek default Mon;
+    property Weekends: TDaysOfWeek read FWeekends write SetWeekends default [Sun];
+    property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
+    property YearDigits: TYearDigits read FYearDigits write SetYearDigits default dyDefault;
+    property PopupColor: TColor read GetPopupColor write SetPopupColor
+      default clBtnFace;
+    property CalendarStyle: TCalendarStyle read FCalendarStyle//GetCalendarStyle
+      write SetCalendarStyle default dcsDefault;
+    property PopupVisible: Boolean read GetPopupVisible;
+    property PopupAlign: TPopupAlign read FPopupAlign write FPopupAlign default epaLeft;
+    property NotInThisMonthColor:TColor read FNotInThisMonthColor write FNotInThisMonthColor default clSilver;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure CheckValidDate;
+    function GetDateMask: string;
+    procedure UpdateMask; virtual;
+    property Date: TDateTime read GetDate write SetDate;
+    property Formatting: Boolean read FFormatting;
+    property ValidDate:boolean read GetValidDate;
+  end;
+  
+type
+
+  { TRxDateEdit }
+
+  TRxDateEdit = class(TCustomRxDateEdit)
+  protected
+    procedure Loaded; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property PopupVisible;
+  published
+    property Action;
+    property Align;
+    property Anchors;
+    property AutoSelect;
+    property AutoSize;
+    property BlanksChar;
+    property BorderSpacing;
+    property ButtonOnlyWhenFocused;
+    property ButtonWidth;
+    property CalendarStyle;
+    property CancelCaption;
+    property CharCase;
+    property Color;
+    property Constraints;
+    property DefaultToday;
+    property DialogTitle;
+    property DirectInput;
+    property DragMode;
+    property EchoMode;
+    property Enabled;
+    property Font;
+    property Glyph;
+    property MaxLength;
+    property NotInThisMonthColor;
+    property NumGlyphs default {$IF lcl_fullversion >= 1090000} 1 {$ELSE} 2 {$ENDIF};
+    property OKCaption;
+    property ParentFont;
+    property ParentShowHint;
+    property PasswordChar;
+    property PopupAlign;
+    property PopupColor;
+    property PopupMenu;
+    property ReadOnly;
+    property ShowHint;
+    property StartOfWeek;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property Visible;
+    property WeekendColor;
+    property Weekends;
+    property YearDigits;
+    property Spacing default 0;
+
+    property OnAcceptDate;
+    property OnChange;
+    property OnChangeBounds;
+    property OnClick;
+    property OnEditingDone;
+    property OnEnter;
+    property OnExit;
+    Property OnKeyDown;
+    property OnKeyPress;
+    Property OnKeyUp;
+    Property OnMouseDown;
+    Property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnResize;
+  end;
+  
+
+function PaintComboEdit(Editor: TCustomMaskEdit; const AText: string;
+  AAlignment: TAlignment; StandardPaint: Boolean;
+  var ACanvas: TControlCanvas; var Message: TLMPaint): Boolean;
+
+function EditorTextMargins(Editor: TCustomMaskEdit): TPoint;
+
+implementation
+uses lclintf, LCLStrConsts, rxconst, rxstrutils, LResources,
+  Forms, LCLProc,
+  variants;
+
+{.$IFNDEF RX_USE_LAZARUS_RESOURCE}
+{.$R tooledit.res}
+{.$ENDIF}
+
+type
+  TPopupCalendarAccess = class(TPopupCalendar)
+  end;
+
+function EditorTextMargins(Editor: TCustomMaskEdit): TPoint;
+var
+  DC: HDC;
+  SaveFont: HFont;
+  I: Integer;
+  SysMetrics, Metrics: TTextMetric;
+begin
+  with Editor do
+  begin
+(*    if NewStyleControls then
+    begin
+      if BorderStyle = bsNone then
+        I := 0
+      else
+{      if Ctl3D then
+        I := 1
+      else}
+        I := 2;
+      Result.X := {SendMessage(Handle, LM_GETMARGINS, 0, 0) and $0000FFFF} + I;
+      Result.Y := I;
+    end
+    else *)
+    begin
+      if BorderStyle = bsNone then
+        I := 0
+      else
+      begin
+        DC := GetDC(0);
+        GetTextMetrics(DC, SysMetrics);
+        SaveFont := SelectObject(DC, Font.Handle);
+        GetTextMetrics(DC, Metrics);
+        SelectObject(DC, SaveFont);
+        ReleaseDC(0, DC);
+        I := SysMetrics.tmHeight;
+        if I > Metrics.tmHeight then
+          I := Metrics.tmHeight;
+        I := I div 4;
+      end;
+      Result.X := I;
+      Result.Y := I div 4;
+    end;
+  end;
+end;
+
+function PaintComboEdit(Editor: TCustomMaskEdit; const AText: string;
+  AAlignment: TAlignment; StandardPaint: Boolean;
+  var ACanvas: TControlCanvas; var Message: TLMPaint): Boolean;
+var
+  AWidth, ALeft: Integer;
+  Margins: TPoint;
+  R: TRect;
+  DC: HDC;
+  PS: TPaintStruct;
+  S: string;
+{$IFDEF USED_BiDi}
+  ExStyle: DWORD;
+const
+  AlignStyle: array[Boolean, TAlignment] of DWORD =
+   ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
+    (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
+{$ENDIF}
+begin
+  Result := True;
+  with Editor do
+  begin
+{$IFDEF USED_BiDi}
+    if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
+{$ENDIF}
+    if StandardPaint and not(csPaintCopy in ControlState) then
+    begin
+{$IFDEF USED_BiDi}
+      if SysLocale.MiddleEast and HandleAllocated and (IsRightToLeft) then
+      begin { This keeps the right aligned text, right aligned }
+        ExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and
+          (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR);
+        if UseRightToLeftReading then
+          ExStyle := ExStyle or WS_EX_RTLREADING;
+        if UseRightToLeftScrollbar then
+          ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
+        ExStyle := ExStyle or
+          AlignStyle[UseRightToLeftAlignment, AAlignment];
+        if DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) <> ExStyle then
+          SetWindowLong(Handle, GWL_EXSTYLE, ExStyle);
+      end;
+{$ENDIF USED_BiDi}
+      Result := False;
+      { return false if we need to use standard paint handler }
+      Exit;
+    end;
+    { Since edit controls do not handle justification unless multi-line (and
+      then only poorly) we will draw right and center justify manually unless
+      the edit has the focus. }
+    if ACanvas = nil then
+    begin
+      ACanvas := TControlCanvas.Create;
+      ACanvas.Control := Editor;
+    end;
+
+    DC := Message.DC;
+    if DC = 0 then DC := BeginPaint(Handle, PS);
+    ACanvas.Handle := DC;
+
+    try
+      ACanvas.Font := Font;
+      if not Enabled and NewStyleControls and not
+        (csDesigning in ComponentState) and
+        (ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
+        ACanvas.Font.Color := clGrayText;
+      with ACanvas do
+      begin
+        R := ClientRect;
+        Brush.Color := Color;
+        S := AText;
+        AWidth := TextWidth(S);
+        Margins := EditorTextMargins(Editor);
+        case AAlignment of
+          taLeftJustify: ALeft := Margins.X;
+          taRightJustify: ALeft := ClientWidth - AWidth - Margins.X - 2;
+        else
+          ALeft := (ClientWidth - AWidth) div 2;
+        end;
+{$IFDEF USED_BiDi}
+        if SysLocale.MiddleEast then UpdateTextFlags;
+{$ENDIF}
+        Brush.Style := bsClear;
+        TextRect(R, ALeft, Margins.Y, S);
+      end;
+    finally
+      ACanvas.Handle := 0;
+      if Message.DC = 0 then EndPaint(Handle, PS);
+    end;
+  end;
+end;
+
+{ TRxDateEdit }
+
+procedure TRxDateEdit.Loaded;
+begin
+  inherited Loaded;
+  {$IF lcl_fullversion >= 1090000}
+{  if Assigned(Glyph)
+      and (Glyph.Equals(RxDateGlyph)) then}
+    NumGlyphs:=1;
+  {$ENDIF}
+end;
+
+constructor TRxDateEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Spacing:=0;
+  UpdateMask;
+end;
+
+{ TCustomRxDateEdit }
+
+function TCustomRxDateEdit.IsStoreTitle: boolean;
+begin
+  Result:=DialogTitle<>rsPickDate;
+end;
+
+procedure TCustomRxDateEdit.SetBlanksChar(const AValue: Char);
+begin
+  if FBlanksChar=AValue then exit;
+  if (AValue < ' ') then
+    FBlanksChar:=' '
+  else
+    FBlanksChar:=AValue;
+  UpdateMask;
+end;
+
+function TCustomRxDateEdit.GetDate: TDateTime;
+begin
+  if DefaultToday then Result := SysUtils.Date
+  else Result := NullDate;
+  if Text<>'' then
+    Result := StrToDateFmtDef(FDateFormat, Text, Result);
+end;
+
+function TCustomRxDateEdit.GetPopupColor: TColor;
+begin
+  if FPopup <> nil then Result := TPopupCalendar(FPopup).Color
+  else Result := FPopupColor;
+end;
+
+function TCustomRxDateEdit.GetPopupVisible: Boolean;
+begin
+  Result := (FPopup <> nil) and FPopupVisible;
+end;
+
+function TCustomRxDateEdit.GetValidDate: boolean;
+begin
+  try
+    StrToDateFmt(FDateFormat, Text);
+    Result:=true;
+  except
+    Result:=false;
+  end;
+end;
+
+procedure TCustomRxDateEdit.SetCalendarStyle(const AValue: TCalendarStyle);
+begin
+  if AValue <> FCalendarStyle then
+  begin
+    FCalendarStyle:=AValue;
+(*    case AValue of
+      csPopup:
+        begin
+          if FPopup = nil then
+          begin
+            FPopup := CreatePopupCalendar(Self{$IFDEF USED_BiDi}, BiDiMode {$ENDIF});
+          end;
+          FPopup.OnCloseUp := @PopupCloseUp;
+          FPopup.Color := FPopupColor;
+          TRxCalendarGrid(FPopup.Calendar).NotInThisMonthColor:=FNotInThisMonthColor;
+        end;
+      csDialog:
+        begin
+          FPopup.Free;
+          FPopup := nil;
+        end;
+    end;*)
+  end;
+end;
+
+procedure TCustomRxDateEdit.SetDate(const AValue: TDateTime);
+var
+  D: TDateTime;
+begin
+  D := Date;
+  if AValue = NullDate then
+    Text := ''
+  else
+    Text := FormatDateTime(FDateFormat, AValue);
+  Modified := D <> Date;
+end;
+
+procedure TCustomRxDateEdit.SetPopupColor(const AValue: TColor);
+begin
+  if AValue <> FPopupColor then
+  begin
+    if FPopup <> nil then FPopup.Color := AValue;
+    FPopupColor := AValue;
+    UpdatePopup;
+  end;
+end;
+
+procedure TCustomRxDateEdit.SetStartOfWeek(const AValue: TDayOfWeekName);
+begin
+  if FStartOfWeek=AValue then exit;
+  FStartOfWeek:=AValue;
+  UpdatePopup;
+  UpdateMask;
+end;
+
+procedure TCustomRxDateEdit.SetWeekendColor(const AValue: TColor);
+begin
+  if FWeekendColor=AValue then exit;
+  FWeekendColor:=AValue;
+  UpdatePopup;
+end;
+
+procedure TCustomRxDateEdit.SetWeekends(const AValue: TDaysOfWeek);
+begin
+  if FWeekends=AValue then exit;
+  FWeekends:=AValue;
+  UpdatePopup;
+end;
+
+procedure TCustomRxDateEdit.SetYearDigits(const AValue: TYearDigits);
+begin
+  if FYearDigits=AValue then exit;
+  FYearDigits:=AValue;
+//  UpdateFormat;
+  UpdateMask;
+end;
+
+procedure TCustomRxDateEdit.CalendarHintsChanged(Sender: TObject);
+begin
+  TStringList(FCalendarHints).OnChange := nil;
+  try
+    while (FCalendarHints.Count > 4) do
+      FCalendarHints.Delete(FCalendarHints.Count - 1);
+  finally
+    TStringList(FCalendarHints).OnChange := @CalendarHintsChanged;
+  end;
+  if not (csDesigning in ComponentState) then UpdatePopup;
+end;
+
+function TCustomRxDateEdit.AcceptPopup(var Value: TDateTime): Boolean;
+var
+  D: TDateTime;
+begin
+  Result := True;
+  if Assigned(FOnAcceptDate) then
+  begin
+    D :=Value;
+    FOnAcceptDate(Self, D, Result);
+    if Result then
+      Value := D;
+  end;
+end;
+
+procedure TCustomRxDateEdit.AcceptValue(const AValue: TDateTime);
+begin
+  SetDate(AValue);
+  if Modified then
+    inherited EditChange;
+end;
+
+procedure TCustomRxDateEdit.UpdateFormat;
+begin
+  case YearDigits of
+    dyDefault:FDateFormat :=DefDateFormat(FourDigitYear);
+    dyFour:FDateFormat := DefDateFormat(true);
+    dyTwo:FDateFormat := DefDateFormat(false);//DefDateMask(FBlanksChar, false);
+  end;
+end;
+
+procedure TCustomRxDateEdit.UpdatePopup;
+begin
+  if FPopup <> nil then SetupPopupCalendar(FPopup, FStartOfWeek,
+    FWeekends, FWeekendColor, FCalendarHints, FourDigitYear);
+end;
+
+function TCustomRxDateEdit.TextStored: Boolean;
+begin
+  Result := not IsEmptyStr(Text, [#0, ' ', DateSeparator, FBlanksChar]);
+end;
+
+procedure TCustomRxDateEdit.PopupDropDown(DisableEdit: Boolean);
+var
+  P: TPoint;
+  ABounds:TRect;
+  Y: Integer;
+
+procedure DoTrySetDate;
+var
+  D:TDateTime;
+begin
+  if Text<>'' then
+  begin
+    try
+      D:=StrToDate(Text);
+      FPopup.Date:=D;
+    except
+      if FDefaultToday then
+        FPopup.Date:=sysutils.Date;
+    end;
+  end
+  else
+  if FDefaultToday then
+    FPopup.Date:=sysutils.Date;
+end;
+
+begin
+  if not Assigned(FPopup) then
+    FPopup:=CreatePopupForm;
+
+  UpdatePopup;
+
+  if (FPopup <> nil) and not (ReadOnly {or FPopupVisible}) then
+  begin
+
+    P := Parent.ClientToScreen(Point(Left, Top));
+
+    ABounds := Screen.MonitorFromPoint(P).BoundsRect;
+
+    Y := P.Y + Height;
+    if Y + FPopup.Height > ABounds.Bottom then
+      Y := P.Y - FPopup.Height;
+    case FPopupAlign of
+      epaRight:
+        begin
+          Dec(P.X, FPopup.Width - Width);
+          if P.X < 0 then Inc(P.X, FPopup.Width - Width);
+        end;
+      epaLeft:
+        begin
+          if P.X + FPopup.Width > ABounds.Right then
+            Dec(P.X, FPopup.Width - Width);
+        end;
+    end;
+    if P.X < 0 then P.X := 0
+    else if P.X + FPopup.Width > ABounds.Right then
+      P.X := ABounds.Right - FPopup.Width;
+
+    DoTrySetDate;
+
+    ShowPopup(Point(P.X, Y));
+//    FPopupVisible := True;
+{    if DisableEdit then
+    begin
+      inherited ReadOnly := True;
+      HideCaret(Handle);
+    end;}
+  end;
+end;
+
+procedure TCustomRxDateEdit.PopupCloseUp(Sender: TObject; Accept: Boolean);
+var
+  AValue: Variant;
+begin
+(*
+  if (FPopup <> nil) and FPopupVisible then
+  begin
+{    if GetCapture <> 0 then
+      SendMessage(GetCapture, WM_CANCELMODE, 0, 0);}
+//    AValue := GetPopupValue;
+    HidePopup;
+    try
+      try
+        if CanFocus then
+        begin
+          SetFocus;
+//          if GetFocus = Handle then SetShowCaret;
+        end;
+      except
+        { ignore exceptions }
+      end;
+//      DirectInput:=DirectInput;
+      Invalidate;
+{      if Accept and AcceptPopup(AValue) and EditCanModify then
+      begin
+        AcceptValue(AValue);
+        if FFocused then inherited SelectAll;
+      end;}
+    finally
+      FPopupVisible := False;
+    end;
+  end;
+*)
+end;
+
+procedure TCustomRxDateEdit.HidePopup;
+begin
+  FPopup.Hide;
+end;
+
+procedure TCustomRxDateEdit.ShowPopup(AOrigin: TPoint);
+var
+  FAccept:boolean;
+  D:TDateTime;
+begin
+  if not Assigned(FPopup) then
+    FPopup:=CreatePopupForm;
+  FPopup.Left:=AOrigin.X;
+  FPopup.Top:=AOrigin.Y;
+  FPopup.AutoSizeForm;
+  TRxCalendarGrid(FPopup.Calendar).NotInThisMonthColor := FNotInThisMonthColor;
+  FAccept:=FPopup.ShowModal = mrOk;
+  if CanFocus then SetFocus;
+
+  if FAccept {and EditCanModify} then
+  begin
+    D:=FPopup.Date;
+    if AcceptPopup(D) then
+    begin
+      FPopup.Date:=D;
+      AcceptValue(D);
+      if Focused then inherited SelectAll;
+    end;
+  end;
+end;
+
+procedure TCustomRxDateEdit.ApplyDate(Value: TDateTime);
+begin
+  SetDate(Value);
+  SelectAll;
+end;
+
+procedure TCustomRxDateEdit.EditChange;
+begin
+  if not FFormatting then
+  inherited EditChange;
+end;
+
+procedure TCustomRxDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  if (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN,
+    VK_ADD, VK_SUBTRACT]) and
+    PopupVisible then
+  begin
+    TPopupCalendarAccess(FPopup).KeyDown(Key, Shift);
+    Key := 0;
+  end
+  else
+  if (Shift = []) and DirectInput then
+  begin
+    case Key of
+      VK_ADD:
+        begin
+          ApplyDate(NvlDate(Date, Now) + 1);
+          Key := 0;
+        end;
+      VK_SUBTRACT:
+        begin
+          ApplyDate(NvlDate(Date, Now) - 1);
+          Key := 0;
+        end;
+    end;
+  end;
+  inherited KeyDown(Key, Shift);
+end;
+
+procedure TCustomRxDateEdit.KeyPress(var Key: Char);
+begin
+  if (Key in ['T', 't', '+', '-']) and PopupVisible then
+  begin
+//    FPopup.KeyPress(Key);
+    Key := #0;
+  end
+  else
+  if DirectInput then
+  begin
+    case Key of
+      'T', 't':
+        begin
+          ApplyDate(Trunc(Now));
+          Key := #0;
+        end;
+      '+', '-':
+        begin
+          Key := #0;
+        end;
+    end;
+  end;
+  inherited KeyPress(Key);
+end;
+
+procedure TCustomRxDateEdit.EditKeyDown(var Key: word; Shift: TShiftState);
+begin
+  if (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN,
+    VK_ADD, VK_SUBTRACT]) and
+    PopupVisible then
+  begin
+    TPopupCalendarAccess(FPopup).KeyDown(Key, Shift);
+    Key := 0;
+  end
+  else
+  if (Shift = []) and DirectInput then
+  begin
+    case Key of
+      VK_ADD:
+        begin
+          ApplyDate(NvlDate(Date, Now) + 1);
+          Key := 0;
+        end;
+      VK_SUBTRACT:
+        begin
+          ApplyDate(NvlDate(Date, Now) - 1);
+          Key := 0;
+        end;
+    end;
+  end;
+  inherited EditKeyDown(Key, Shift);
+end;
+
+procedure TCustomRxDateEdit.EditKeyPress(var Key: char);
+begin
+  if (Key in ['T', 't', '+', '-']) and PopupVisible then
+  begin
+    Key := #0;
+  end
+  else
+  if DirectInput then
+  begin
+    case Key of
+      'T', 't':
+        begin
+          ApplyDate(Trunc(Now));
+          Key := #0;
+        end;
+      '+', '-':
+        begin
+          Key := #0;
+        end;
+    end;
+  end;
+  inherited EditKeyPress(Key);
+end;
+
+procedure TCustomRxDateEdit.ButtonClick;
+var
+  D: TDateTime;
+  A: Boolean;
+begin
+  inherited ButtonClick;
+  if CalendarStyle <> csDialog then
+    PopupDropDown(True)
+  else
+  if CalendarStyle = csDialog then
+  begin
+    D := Self.Date;
+    A := SelectDate(D, DialogTitle, FStartOfWeek, FWeekends, FWeekendColor, FCalendarHints);
+    if CanFocus then SetFocus;
+    if A then
+    begin
+      if Assigned(FOnAcceptDate) then FOnAcceptDate(Self, D, A);
+      if A then
+      begin
+        Self.Date := D;
+        inherited SelectAll;
+      end;
+    end;
+  end;
+end;
+
+{$IF lcl_fullversion < 01090000}
+function TCustomRxDateEdit.GetDefaultGlyph: TBitmap;
+var
+  R: TRect;
+  B: TCustomBitmap;
+begin
+  Result := DateGlyph;
+end;
+{$ENDIF}
+
+function TCustomRxDateEdit.GetDefaultGlyphName: String;
+begin
+  {$IF lcl_fullversion < 01090000}
+    {$IFDEF LINUX}
+    Result:='picDateEdit';
+    {$ELSE}
+    {$IFDEF WINDOWS}
+    Result:='picDateEdit';
+    {$ELSE}
+    Result:='';
+    {$ENDIF}
+    {$ENDIF}
+  {$ELSE}
+    Result:=ResBtnCalendar
+  {$ENDIF}
+end;
+
+function TCustomRxDateEdit.CreatePopupForm: TPopupCalendar;
+begin
+  Result := CreatePopupCalendar(Self {$IFDEF USED_BiDi}, BiDiMode {$ENDIF});
+  Result.OnCloseUp := @PopupCloseUp;
+  Result.Color := FPopupColor;
+  TRxCalendarGrid(Result.Calendar).NotInThisMonthColor:=FNotInThisMonthColor;
+end;
+
+procedure TCustomRxDateEdit.DoEnter;
+begin
+  if Enabled then
+    inherited DoEnter;
+end;
+
+constructor TCustomRxDateEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FBlanksChar := ' ';
+  FDialogTitle := sDateDlgTitle;
+  FPopupColor := clWindow;
+  FNotInThisMonthColor := clSilver;
+  FPopupAlign := epaLeft;
+  FStartOfWeek := Mon;
+  FWeekends := [Sun];
+  FWeekendColor := clRed;
+  FYearDigits := dyDefault;
+  FCalendarHints := TStringList.Create;
+  TStringList(FCalendarHints).OnChange := @CalendarHintsChanged;
+  ControlState := ControlState + [csCreating];
+  try
+    UpdateFormat;
+    FPopup:=nil;
+  finally
+    ControlState := ControlState - [csCreating];
+  end;
+  {$IF lcl_fullversion < 01090000}
+  NumGlyphs := 2;
+  {$ENDIF}
+end;
+
+destructor TCustomRxDateEdit.Destroy;
+begin
+  if Assigned(FPopup) then
+  begin
+    FPopup.OnCloseUp := nil;
+    FreeAndNil(FPopup);
+  end;
+  TStringList(FCalendarHints).OnChange := nil;
+  FreeAndNil(FCalendarHints);
+  inherited Destroy;
+end;
+
+procedure TCustomRxDateEdit.CheckValidDate;
+begin
+  if TextStored then
+    try
+      FFormatting := True;
+      try
+        SetDate(StrToDateFmt(FDateFormat, Text));
+      finally
+        FFormatting := False;
+      end;
+    except
+      if CanFocus then SetFocus;
+      raise;
+    end;
+end;
+
+function TCustomRxDateEdit.GetDateMask: string;
+begin
+  case YearDigits of
+    dyDefault:Result :=DefDateMask(FBlanksChar, FourDigitYear);
+    dyFour:Result := DefDateMask(FBlanksChar, true);
+    dyTwo:Result := DefDateMask(FBlanksChar, false);
+  end;
+end;
+
+procedure TCustomRxDateEdit.UpdateMask;
+var
+  DateValue: TDateTime;
+  OldFormat: string[10];
+begin
+  DateValue := GetDate;
+  OldFormat := FDateFormat;
+  UpdateFormat;
+  if (GetDateMask <> EditMask) or (OldFormat <> FDateFormat) then
+  begin
+    { force update }
+    EditMask := '';
+    EditMask := GetDateMask;
+  end;
+  UpdatePopup;
+  SetDate(DateValue);
+end;
+
+{$IFDEF RX_USE_LAZARUS_RESOURCE}
+initialization
+  {$I rxtooledit.lrs}
+{$ENDIF}
+
+end.
+

RXLib/rxcontrols/rxversinfo.pas

@@ -0,0 +1,316 @@
+{ RxVersInfo is part of RxFPC library
+
+  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 RxVersInfo;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, versionresource, lclversion;
+
+type
+  TLongVersion = string;
+  TVersionCharSet = string;
+  TVersionLanguage = string;
+
+  { TRxVersionInfo }
+
+  TRxVersionInfo = class(TComponent)
+  private
+    FValid: Boolean;
+    FValues:TStringList;
+    FFileName: string;
+    function GetComments: string;
+    function GetCompanyName: string;
+    function GetFileDescription: string;
+    function GetFileLongVersion: TLongVersion;
+    function GetFileName: string;
+    function GetFileVersion: string;
+    //function GetFixedFileInfo: PVSFixedFileInfo;
+    function GetInternalName: string;
+    function GetLegalCopyright: string;
+    function GetLegalTrademarks: string;
+    function GetOriginalFilename: string;
+    function GetPrivateBuild: string;
+    function GetProductLongVersion: TLongVersion;
+    function GetProductName: string;
+    function GetProductVersion: string;
+    function GetSpecialBuild: string;
+    function GetTranslation: Pointer;
+    function GetVerFileDate: TDateTime;
+    function GetVersionCharSet: TVersionCharSet;
+    function GetVersionLanguage: TVersionLanguage;
+    function GetVersionNum: Longint;
+    function GetVerValue(const VerName: string): string;
+    function GetWidgetName: string;
+    procedure SetFileName(const AValue: string);
+    procedure DoVersionInfo(V:TVersionResource);
+  protected
+    { Protected declarations }
+  public
+    constructor Create(AOwner: TComponent);override;
+    destructor Destroy; override;
+    procedure LoadFromFile(const AFileName:string);
+
+    property FileName: string read GetFileName write SetFileName;
+    property Valid: Boolean read FValid;
+    //property FixedFileInfo: PVSFixedFileInfo read GetFixedFileInfo;
+    property FileLongVersion: TLongVersion read GetFileLongVersion;
+    property ProductLongVersion: TLongVersion read GetProductLongVersion;
+    property Translation: Pointer read GetTranslation;
+    property VersionLanguage: TVersionLanguage read GetVersionLanguage;
+    property VersionCharSet: TVersionCharSet read GetVersionCharSet;
+    property VersionNum: Longint read GetVersionNum;
+    property Comments: string read GetComments;
+    property CompanyName: string read GetCompanyName;
+    property FileDescription: string read GetFileDescription;
+    property FileVersion: string read GetFileVersion;
+    property InternalName: string read GetInternalName;
+    property LegalCopyright: string read GetLegalCopyright;
+    property LegalTrademarks: string read GetLegalTrademarks;
+    property OriginalFilename: string read GetOriginalFilename;
+    property ProductVersion: string read GetProductVersion;
+    property ProductName: string read GetProductName;
+    property SpecialBuild: string read GetSpecialBuild;
+    property PrivateBuild: string read GetPrivateBuild;
+    property Values[const VerName: string]: string read GetVerValue;
+    property VerFileDate: TDateTime read GetVerFileDate;
+  published
+    property WidgetName:string read GetWidgetName;
+  end;
+
+
+implementation
+uses FileUtil, resource, resreader, InterfaceBase, rxconst, LazFileUtils,
+  LazUTF8
+{$IFDEF WINDOWS}
+  , winpeimagereader
+{$ENDIF}
+{$IFDEF LINUX}
+  , elfreader
+{$ENDIF}
+{$IF (lcl_major > 0) and (lcl_minor > 6)}, LCLPlatformDef {$ENDIF};
+
+
+{ TRxVersionInfo }
+
+function TRxVersionInfo.GetComments: string;
+begin
+  Result:=FValues.Values['Comments'];
+end;
+
+function TRxVersionInfo.GetCompanyName: string;
+begin
+  Result:=FValues.Values['CompanyName'];
+end;
+
+function TRxVersionInfo.GetFileDescription: string;
+begin
+  Result:=FValues.Values['FileDescription'];
+end;
+
+function TRxVersionInfo.GetFileLongVersion: TLongVersion;
+begin
+  Result:=FValues.Values['FileVersion'];
+end;
+
+function TRxVersionInfo.GetFileName: string;
+begin
+  Result:=FValues.Values['OriginalFilename'];
+  if Result = '' then
+    Result:=FFileName;
+end;
+
+function TRxVersionInfo.GetFileVersion: string;
+begin
+  Result:=FValues.Values['FileVersion'];
+end;
+
+{function TRxVersionInfo.GetFixedFileInfo: PVSFixedFileInfo;
+begin
+  Result:='';
+end;}
+
+function TRxVersionInfo.GetInternalName: string;
+begin
+  Result:=FValues.Values['InternalName'];
+end;
+
+function TRxVersionInfo.GetLegalCopyright: string;
+begin
+  Result:=FValues.Values['LegalCopyright'];
+end;
+
+function TRxVersionInfo.GetLegalTrademarks: string;
+begin
+  Result:=FValues.Values['LegalTrademarks'];
+end;
+
+function TRxVersionInfo.GetOriginalFilename: string;
+begin
+  Result:=FValues.Values['LegalTrademarks'];
+end;
+
+function TRxVersionInfo.GetPrivateBuild: string;
+begin
+  Result:='';
+end;
+
+function TRxVersionInfo.GetProductLongVersion: TLongVersion;
+begin
+  Result:='';
+end;
+
+function TRxVersionInfo.GetProductName: string;
+begin
+  Result:=FValues.Values['ProductName'];
+end;
+
+function TRxVersionInfo.GetProductVersion: string;
+begin
+  Result:=FValues.Values['ProductVersion'];
+end;
+
+function TRxVersionInfo.GetSpecialBuild: string;
+begin
+  Result:='';
+end;
+
+function TRxVersionInfo.GetTranslation: Pointer;
+begin
+  Result:=nil;
+end;
+
+function TRxVersionInfo.GetVerFileDate: TDateTime;
+begin
+  Result:=0;
+end;
+
+function TRxVersionInfo.GetVersionCharSet: TVersionCharSet;
+begin
+  Result:='';
+end;
+
+function TRxVersionInfo.GetVersionLanguage: TVersionLanguage;
+begin
+  Result:='';
+end;
+
+function TRxVersionInfo.GetVersionNum: Longint;
+begin
+  Result:=0;
+end;
+
+procedure TRxVersionInfo.SetFileName(const AValue: string);
+begin
+  LoadFromFile(AValue);
+end;
+
+procedure TRxVersionInfo.DoVersionInfo(V: TVersionResource);
+var
+  i,j:integer;
+begin
+  for i:=0 to V.StringFileInfo.Count-1 do
+  begin
+    for j:=0 to V.StringFileInfo[i].Count-1 do
+      FValues.Values[V.StringFileInfo[i].Keys[j]]:=SysToUTF8(V.StringFileInfo[i].ValuesByIndex[j]);
+  end;
+end;
+
+constructor TRxVersionInfo.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FValues:=TStringList.Create;
+  LoadFromFile(ParamStr(0));
+end;
+
+destructor TRxVersionInfo.Destroy;
+begin
+  FreeAndNil(FValues);
+  inherited Destroy;
+end;
+
+procedure TRxVersionInfo.LoadFromFile(const AFileName: string);
+var
+  Res:TResources;
+  i:integer;
+  Reader:TAbstractResourceReader;
+  V:TVersionResource;
+begin
+  FFileName:=AFileName;
+  FValues.Clear;
+  FValid:=false;
+  Reader:=nil;
+  {$IFDEF WINDOWS}
+  Reader:=TWinPEImageResourceReader.Create;
+  {$ENDIF}
+  {$IFDEF LINUX}
+  Reader:=TElfResourceReader.Create;
+  {$ENDIF}
+
+  if Reader = nil then
+    exit;
+
+  Res:=TResources.Create;
+  V:=nil;
+  try
+    Res.LoadFromFile(AFileName, Reader);
+    for i:=0 to Res.Count-1 do
+    begin
+      if Res[i] is TVersionResource then
+        V:=Res[i] as TVersionResource;
+    end;
+    FValid:=Assigned(V);
+    if FValid then
+      DoVersionInfo(V);
+  finally
+    Res.Free;
+    Reader.Free;
+  end;
+end;
+
+function TRxVersionInfo.GetVerValue(const VerName: string): string;
+begin
+  Result:=FValues.Values[VerName];
+end;
+
+function TRxVersionInfo.GetWidgetName: string;
+begin
+  {$IF (lcl_fullversion < 01070000)}
+  Result:=sWidget + LCLPlatformDirNames[WidgetSet.LCLPlatform];
+  {$ELSE}
+  Result:=sWidget + LCLPlatformDisplayNames[WidgetSet.LCLPlatform];
+  {$ENDIF}
+end;
+
+end.

RXLib/rxcontrols/rxviewspanel.pas

@@ -0,0 +1,512 @@
+{ RxViewsPanel 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 RxViewsPanel;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  Buttons, StdCtrls, LCLType;
+
+type
+  TRxViewsPanel = class;
+  TRxViewsPanelItem = class;
+
+  TSelectViewEvent = procedure (Sender: TObject; ItemIndex:integer; const Item:TRxViewsPanelItem) of object;
+  { TRxViewsPanelItem }
+
+  TRxViewsPanelItem = class(TCollectionItem)
+  private
+    FButton: TSpeedButton;
+    FImageIndex: integer;
+    FLabel:TLabel;
+    function GetAction: TBasicAction;
+    function GetCaption: string;
+    function GetEnabled: Boolean;
+    function GetHint: TTranslateString;
+    function GetImageIndex: integer;
+    function GetTag: Longint;
+    function GetVisible: boolean;
+    procedure SetAction(const AValue: TBasicAction);
+    procedure SetCaption(const AValue: string);
+    procedure SetEnabled(const AValue: Boolean);
+    procedure SetHint(const AValue: TTranslateString);
+    procedure SetImageIndex(const AValue: integer);
+    procedure SetTag(const AValue: Longint);
+    procedure SetVisible(const AValue: boolean);
+    procedure UpdatePosition;
+    procedure UpdateImage;
+    procedure DoViewButtonClick(Sender:TObject);
+  protected
+    function GetDisplayName: string; override;
+  public
+    constructor Create(ACollection: TCollection); override;
+    destructor Destroy; override;
+  published
+    property Action:TBasicAction read GetAction write SetAction;
+    property Visible:boolean read GetVisible write SetVisible;
+    property Caption:string read GetCaption Write SetCaption;
+    property Tag: Longint read GetTag write SetTag default 0;
+    property ImageIndex:integer read GetImageIndex write SetImageIndex;
+    property Hint:TTranslateString read GetHint write SetHint;
+    property Enabled: Boolean read GetEnabled write SetEnabled default True;
+  end;
+
+
+  { TRxViewsPanelItems }
+
+  TRxViewsPanelItems = class(TCollection)
+  private
+    FRxViewsPanel:TRxViewsPanel;
+    function GetPanelItem(Index: Integer): TRxViewsPanelItem;
+    procedure SetPanelItem(Index: Integer; const AValue: TRxViewsPanelItem);
+  protected
+    procedure Update(Item: TCollectionItem);override;
+  public
+    constructor Create(ARxViewsPanel: TRxViewsPanel);
+    property Items[Index: Integer]: TRxViewsPanelItem read GetPanelItem write SetPanelItem; default;
+    procedure UpdateImages;
+  end;
+
+  { TRxViewsPanel }
+
+  TRxViewsPanel = class(TCustomPanel)
+  private
+    FButtonHeght: integer;
+    FImageList: TImageList;
+    FItemIndex: integer;
+    FItems:TRxViewsPanelItems;
+    FOnSelectViewEvent: TSelectViewEvent;
+    function GetItems: TRxViewsPanelItems;
+    procedure SetButtonHeght(const AValue: integer);
+    procedure SetImageList(const AValue: TImageList);
+    procedure SetItemIndex(const AValue: integer);
+    procedure SetItems(const AValue: TRxViewsPanelItems);
+    procedure InternalSelectView(Item:TRxViewsPanelItem);
+  protected
+    procedure Loaded; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property Align;
+    property Anchors;
+    property ButtonHeght:integer read FButtonHeght write SetButtonHeght;
+    property Color default clGrayText;
+    property Items:TRxViewsPanelItems read GetItems write SetItems;
+    property ImageList:TImageList read FImageList write SetImageList;
+    property OnSelectViewEvent:TSelectViewEvent read FOnSelectViewEvent write FOnSelectViewEvent;
+    property ItemIndex:integer read FItemIndex write SetItemIndex;
+
+    property Alignment;
+    property AutoSize;
+    property BorderSpacing;
+    property BevelInner;
+    property BevelOuter;
+    property BevelWidth;
+    property BidiMode;
+    property BorderWidth;
+    property BorderStyle;
+    property Caption;
+    property ChildSizing;
+    property ClientHeight;
+    property ClientWidth;
+    property Constraints;
+    property DockSite;
+    property DragCursor;
+    property DragKind;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property FullRepaint;
+    property ParentBidiMode;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property UseDockManager default True;
+    property Visible;
+    property OnClick;
+    property OnContextPopup;
+    property OnDockDrop;
+    property OnDockOver;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDock;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnGetSiteInfo;
+    property OnGetDockCaption;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnResize;
+    property OnStartDock;
+    property OnStartDrag;
+    property OnUnDock;
+
+  end;
+
+
+implementation
+
+
+{ TRxViewsPanel }
+
+function TRxViewsPanel.GetItems: TRxViewsPanelItems;
+begin
+  Result:=FItems;
+end;
+
+procedure TRxViewsPanel.SetButtonHeght(const AValue: integer);
+var
+  I:integer;
+begin
+  if FButtonHeght=AValue then exit;
+  FButtonHeght:=AValue;
+  for i:=0 to FItems.Count - 1 do
+    Items[i].FButton.Height:=AValue;
+end;
+
+procedure TRxViewsPanel.SetImageList(const AValue: TImageList);
+begin
+  if FImageList=AValue then exit;
+  FImageList:=AValue;
+  FItems.UpdateImages;
+end;
+
+procedure TRxViewsPanel.SetItemIndex(const AValue: integer);
+begin
+  if FItemIndex=AValue then exit;
+  if (AValue < 0) or (AValue > FItems.Count - 1) then exit;
+  FItemIndex:=AValue;
+  Items[AValue].FButton.Click;
+  Items[AValue].FButton.Down:=true;
+end;
+
+procedure TRxViewsPanel.SetItems(const AValue: TRxViewsPanelItems);
+begin
+  FItems.Assign(AValue);
+end;
+
+procedure TRxViewsPanel.InternalSelectView(Item: TRxViewsPanelItem);
+begin
+  FItemIndex:=Item.Index;
+  if Assigned(FOnSelectViewEvent) then
+    FOnSelectViewEvent(Self, Item.Index, Item);
+end;
+
+procedure TRxViewsPanel.Loaded;
+begin
+  inherited Loaded;
+  FItems.Update(nil);
+  FItems.UpdateImages;
+  if (FItems.Count>0) and (FItemIndex>-1) and (FItemIndex < FItems.Count) then
+    FItems[FItemIndex].FButton.Down:=true;
+end;
+
+constructor TRxViewsPanel.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  BevelOuter:=bvLowered;
+  Caption:='';
+  if Assigned(AOwner) then
+    Align:=alLeft;
+  Color:=clGrayText;
+  FItems:=TRxViewsPanelItems.Create(Self);
+
+  ControlStyle:=ControlStyle - [csSetCaption, csAcceptsControls];
+  FButtonHeght:=50;
+end;
+
+destructor TRxViewsPanel.Destroy;
+begin
+  FreeAndNil(FItems);
+  inherited Destroy;
+end;
+
+{ TRxViewsPanelItem }
+
+function TRxViewsPanelItem.GetAction: TBasicAction;
+begin
+  Result:=FButton.Action;
+end;
+
+function TRxViewsPanelItem.GetCaption: string;
+begin
+  Result:=FLabel.Caption;
+end;
+
+function TRxViewsPanelItem.GetEnabled: Boolean;
+begin
+  Result:=FButton.Enabled;
+end;
+
+function TRxViewsPanelItem.GetHint: TTranslateString;
+begin
+  Result:=FButton.Hint;
+end;
+
+function TRxViewsPanelItem.GetImageIndex: integer;
+begin
+{  if Assigned(FButton.Action) then
+    Result:=FButton.Action.;}
+  Result:=FImageIndex;
+//  FButton.Glyph.;
+end;
+
+function TRxViewsPanelItem.GetTag: Longint;
+begin
+  Result:=FButton.Tag;
+end;
+
+function TRxViewsPanelItem.GetVisible: boolean;
+begin
+  Result:=FButton.Visible;
+end;
+
+procedure TRxViewsPanelItem.SetAction(const AValue: TBasicAction);
+begin
+  FButton.Action:=AValue;
+end;
+
+procedure TRxViewsPanelItem.SetCaption(const AValue: string);
+begin
+  FLabel.Caption:=AValue;
+end;
+
+procedure TRxViewsPanelItem.SetEnabled(const AValue: Boolean);
+begin
+  FButton.Enabled:=AValue;
+  FLabel.Enabled:=AValue;
+end;
+
+procedure TRxViewsPanelItem.SetHint(const AValue: TTranslateString);
+begin
+  FButton.Hint:=AValue;
+end;
+
+procedure TRxViewsPanelItem.SetImageIndex(const AValue: integer);
+begin
+  if FImageIndex=AValue then exit;
+  FImageIndex:=AValue;
+  UpdateImage;
+end;
+
+procedure TRxViewsPanelItem.SetTag(const AValue: Longint);
+begin
+  FButton.Tag:=AValue;
+end;
+
+procedure TRxViewsPanelItem.SetVisible(const AValue: boolean);
+begin
+  FButton.Visible:=AValue;
+  FLabel.Visible:=AValue;
+end;
+
+procedure TRxViewsPanelItem.UpdatePosition;
+var
+  PP:TRxViewsPanelItem;
+begin
+  if Index <> 0 then
+  begin
+    PP:=TRxViewsPanelItems(Collection).GetPanelItem(Index - 1);
+    if Assigned(PP.FLabel) then
+    begin
+      FButton.Top:=PP.FLabel.Top + PP.FLabel.Height;
+    end;
+  end;
+  FLabel.Top:=FButton.Top + FButton.Height;
+end;
+
+procedure TRxViewsPanelItem.UpdateImage;
+var
+  VP:TRxViewsPanel;
+begin
+  VP:=TRxViewsPanelItems(Collection).FRxViewsPanel;
+  if Assigned(VP.FImageList) then
+    VP.FImageList.GetBitmap(FImageIndex, FButton.Glyph);
+end;
+
+procedure TRxViewsPanelItem.DoViewButtonClick(Sender: TObject);
+begin
+  TRxViewsPanelItems(Collection).FRxViewsPanel.InternalSelectView(Self);
+end;
+
+function TRxViewsPanelItem.GetDisplayName: string;
+begin
+  if FLabel.Caption<> '' then
+    Result:=FLabel.Caption
+  else
+    Result:=inherited GetDisplayName;
+end;
+
+constructor TRxViewsPanelItem.Create(ACollection: TCollection);
+var
+  VP:TRxViewsPanel;
+begin
+  inherited Create(ACollection);
+  VP:=TRxViewsPanelItems(ACollection).FRxViewsPanel;
+  FImageIndex:=-1;
+
+  FButton:=TSpeedButton.Create(VP);
+//  FButton.Align:=alTop;
+  FButton.ShowCaption:=false;
+  FButton.Transparent:=true;
+  FButton.GroupIndex:=1;
+  FButton.Height:=VP.FButtonHeght;
+  FButton.Parent:=VP;
+
+
+  FLabel:=TLabel.Create(VP);
+//  FLabel.Align:=alTop;
+  FLabel.WordWrap:=true;
+  FLabel.Alignment:=taCenter;
+  FLabel.AutoSize:=true;
+  FLabel.Parent:=VP;
+
+  FButton.BorderSpacing.Around:=6;
+  FLabel.BorderSpacing.Around:=6;
+
+  FButton.AnchorSide[akLeft].Control:=VP;
+  FButton.AnchorSide[akRight].Control:=VP;
+  FButton.AnchorSide[akRight].Side:=asrBottom;
+  FButton.Anchors:=[akTop, akLeft, akRight];
+  FButton.OnClick:=@DoViewButtonClick;
+
+  FLabel.AnchorSide[akTop].Control:=FButton;
+  FLabel.AnchorSide[akLeft].Control:=VP;
+  FLabel.AnchorSide[akRight].Control:=VP;
+  FLabel.AnchorSide[akRight].Side:=asrBottom;
+  FLabel.Anchors:=[akTop, akLeft, akRight];
+  FLabel.Top:=FButton.Top + FButton.Height;
+
+  UpdatePosition;
+end;
+
+destructor TRxViewsPanelItem.Destroy;
+begin
+  FreeAndNil(FButton);
+  FreeAndNil(FLabel);
+  inherited Destroy;
+end;
+
+{ TRxViewsPanelItems }
+
+function TRxViewsPanelItems.GetPanelItem(Index: Integer): TRxViewsPanelItem;
+begin
+  result := TRxViewsPanelItem( inherited Items[Index] );
+
+end;
+
+procedure TRxViewsPanelItems.SetPanelItem(Index: Integer;
+  const AValue: TRxViewsPanelItem);
+begin
+  Items[Index].Assign( AValue );
+end;
+
+procedure TRxViewsPanelItems.Update(Item: TCollectionItem);
+var
+  i:integer;
+  P, P1:TRxViewsPanelItem;
+begin
+  inherited Update(Item);
+  if not Assigned(Item) then
+  begin
+    for i:=0 to Count - 1 do
+    begin
+      P:=GetPanelItem(I);
+      if Assigned(P.FButton) and Assigned(P.FLabel) then
+      begin
+        if i=0 then
+        begin
+          P.FButton.AnchorSide[akTop].Control:=FRxViewsPanel;
+          P.FButton.AnchorSide[akTop].Side:=asrTop;
+
+          P.FLabel.AnchorSide[akTop].Control:=P.FButton;
+          P.FLabel.AnchorSide[akTop].Side:=asrBottom;
+
+
+        end
+        else
+        begin
+          P1:=GetPanelItem(I-1);
+          if Assigned(P1.FButton) and Assigned(P1.FLabel) then
+          begin
+            P.FButton.AnchorSide[akTop].Control:=P1.FLabel;
+            P.FButton.AnchorSide[akTop].Side:=asrBottom;
+
+            P.FLabel.AnchorSide[akTop].Control:=P.FButton;
+            P.FLabel.AnchorSide[akTop].Side:=asrBottom;
+          end;
+        end;
+        P.FButton.AnchorSide[akLeft].Control:=FRxViewsPanel;
+        P.FButton.AnchorSide[akRight].Control:=FRxViewsPanel;
+        P.FButton.AnchorSide[akRight].Side:=asrBottom;
+
+        P.FLabel.AnchorSide[akTop].Control:=P.FButton;
+        P.FLabel.AnchorSide[akLeft].Control:=FRxViewsPanel;
+        P.FLabel.AnchorSide[akRight].Control:=FRxViewsPanel;
+        P.FLabel.AnchorSide[akRight].Side:=asrBottom;
+      end;
+    end;
+  end;
+end;
+
+constructor TRxViewsPanelItems.Create(ARxViewsPanel: TRxViewsPanel);
+begin
+  inherited Create(TRxViewsPanelItem);
+  FRxViewsPanel:=ARxViewsPanel;
+end;
+
+procedure TRxViewsPanelItems.UpdateImages;
+var
+  i:integer;
+begin
+  for I:=0 to Count - 1 do
+    Items[i].UpdateImage;
+end;
+
+end.

RXLib/rxcontrols/rxxmlpropstorage.pas

@@ -0,0 +1,104 @@
+{ RxXMLPropStorage unit
+
+  Copyright (C) 2005-2018 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 RxXMLPropStorage;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, XMLPropStorage;
+
+const
+  defCFGFileExt = '.xcfg';
+
+type
+
+  { TRxXMLPropStorage }
+
+  TRxXMLPropStorage = class(TXMLPropStorage)
+  private
+    FSeparateFiles: boolean;
+    function FixPath2(const APath: String): String;
+  protected
+    function GetXMLFileName: string; override;
+  public
+
+  published
+    property SeparateFiles:boolean read FSeparateFiles write FSeparateFiles;
+  end;
+
+
+implementation
+uses LazFileUtils, LazUTF8, rxapputils;
+
+
+function GetDefaultCfgName: string;
+var
+  S:string;
+begin
+  Result := ExtractFileName(ChangeFileExt(Application.ExeName, defCFGFileExt));
+  S:=SysToUTF8(RxGetAppConfigDir(false));
+  ForceDirectoriesUTF8(S);
+  Result:=S+Result;
+end;
+
+{ TRxXMLPropStorage }
+
+function TRxXMLPropStorage.FixPath2(const APath: String): String;
+begin
+  Result:=StringReplace(APath,'/', '.', [rfReplaceAll]);
+end;
+
+function TRxXMLPropStorage.GetXMLFileName: string;
+var
+  S: String;
+begin
+  if ExtractFileDir(FileName) <> '' then
+    Result:=FileName
+  else
+  begin
+    S:=GetDefaultCfgName;
+    if FileName <> '' then
+      Result:=AppendPathDelim(ExtractFileDir(S)) + FileName
+    else
+    begin
+      if FSeparateFiles then
+        Result:=AppendPathDelim(ExtractFileDir(S)) + FixPath2(RootSection) + defCFGFileExt
+      else
+        Result:=S;
+    end;
+  end;
+  Result:=UTF8ToSys(Result);
+end;
+
+end.