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

This commit is contained in:
2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions

View File

@@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="5">
<Item1>
<PackageName Value="rx_sort_zeos"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
<Item3>
<PackageName Value="rxnew"/>
</Item3>
<Item4>
<PackageName Value="zcomponent"/>
</Item4>
<Item5>
<PackageName Value="LCL"/>
</Item5>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@@ -0,0 +1,234 @@
object Form1: TForm1
Left = 612
Height = 444
Top = 268
Width = 702
Caption = 'Form1'
ClientHeight = 444
ClientWidth = 702
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 444
Top = 0
Width = 702
ColumnDefValues.BlobText = '(blob)'
TitleButtons = True
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID_R'
Width = 60
FieldName = 'ID_R'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Empty)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID'
Width = 60
FieldName = 'ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Empty)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Filter.Style = rxfstDialog
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'CODE'
Width = 60
FieldName = 'CODE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Empty)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Filter.Style = rxfstDialog
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'NAME'
Width = 350
FieldName = 'NAME'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Empty)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Filter.Style = rxfstDialog
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'CODE1'
FieldName = 'CODE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Empty)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Filter.Style = rxfstDialog
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.DrawFullLine = False
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgFilter, rdgAllowQuickFilter, rdgAllowFilterForm, rdgAllowToolMenu]
Align = alClient
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = dsData
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgHeaderPushedLook]
TabOrder = 0
end
object rxData: TRxMemoryData
FieldDefs = <
item
Name = 'ID_R'
DataType = ftInteger
end
item
Name = 'ID'
DataType = ftInteger
end
item
Name = 'CODE'
DataType = ftInteger
end
item
Name = 'NAME'
DataType = ftString
Size = 200
end>
AfterInsert = rxDataAfterInsert
PacketRecords = 0
Left = 459
Top = 245
object rxDataID: TLongintField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataCODE: TLongintField
FieldKind = fkData
FieldName = 'CODE'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataNAME: TStringField
FieldKind = fkData
FieldName = 'NAME'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 200
end
object rxDataID_R: TLongintField
FieldKind = fkData
FieldName = 'ID_R'
Index = 3
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
end
object dsData: TDataSource
DataSet = rxData
Left = 416
Top = 245
end
end

View File

@@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="ETTF"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

Binary file not shown.

After

Width:  |  Height:  |  Size: 156 B

View File

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

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 727 B

View File

@@ -0,0 +1,650 @@
{ DateUtil unit
Copyright (C) 2005-2017 Lagunov Aleksey alexs@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 rxdateutil;
{$I rx.inc}
interface
function CurrentYear: Word;
function IsLeapYear(AYear: Integer): Boolean;
function DaysPerMonth(AYear, AMonth: Integer): Integer;
function FirstDayOfPrevMonth: TDateTime;
function LastDayOfPrevMonth: TDateTime;
function FirstDayOfNextMonth: TDateTime;
function ExtractDay(ADate: TDateTime): Word;
function ExtractMonth(ADate: TDateTime): Word;
function ExtractYear(ADate: TDateTime): Word;
function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
function ValidDate(ADate: TDateTime): Boolean;
procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
function MonthsBetween(Date1, Date2: TDateTime): Double;
function DaysInPeriod(Date1, Date2: TDateTime): Longint;
{ Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
function DaysBetween(Date1, Date2: TDateTime): Longint;
{ The same as previous but if Date2 < Date1 result = 0 }
function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
function CutTime(ADate: TDateTime): TDateTime; { Set time to 00:00:00:00 }
type
TDateOrder = (doMDY, doDMY, doYMD);
TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
TDaysOfWeek = set of TDayOfWeekName;
{ String to date conversions }
function GetDateOrder(const DateFormat: string): TDateOrder;
function MonthFromName(const S: string; MaxLen: Byte): Byte;
function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
function StrToDateFmt(const DateFormat, S: string): TDateTime;
function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
function DefDateFormat(FourDigitYear: Boolean): string;
function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
{$IFDEF WIN32}
function FormatLongDate(Value: TDateTime): string;
function FormatLongDateTime(Value: TDateTime): string;
{$ENDIF}
const
DefaultDateOrder = doDMY;
{$IFDEF USE_FOUR_DIGIT_YEAR}
var
FourDigitYear: Boolean;
{$ELSE}
function FourDigitYear: Boolean;
{$ENDIF USE_FOUR_DIGIT_YEAR}
const
CenturyOffset: Byte = 60;
NullDate: TDateTime = 0;
implementation
uses DateUtils, SysUtils, RXStrUtils, rxdconst{, DBConsts }{$IFDEF WIN32}, Windows{$ENDIF};
function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
begin
if DateValue = NullDate then Result := DefaultValue
else Result := DateValue;
end;
function IsLeapYear(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;
function DaysPerMonth(AYear, AMonth: Integer): Integer;
const
DaysInMonth: array[1..12] of Integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysInMonth[AMonth];
if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;
function FirstDayOfNextMonth: TDateTime;
var
Year, Month, Day: Word;
begin
DecodeDate(Date, Year, Month, Day);
Day := 1;
if Month < 12 then Inc(Month)
else begin
Inc(Year);
Month := 1;
end;
Result := EncodeDate(Year, Month, Day);
end;
function FirstDayOfPrevMonth: TDateTime;
var
Year, Month, Day: Word;
begin
DecodeDate(Date, Year, Month, Day);
Day := 1;
if Month > 1 then Dec(Month)
else begin
Dec(Year);
Month := 12;
end;
Result := EncodeDate(Year, Month, Day);
end;
function LastDayOfPrevMonth: TDateTime;
var
D: TDateTime;
Year, Month, Day: Word;
begin
D := FirstDayOfPrevMonth;
DecodeDate(D, Year, Month, Day);
Day := DaysPerMonth(Year, Month);
Result := EncodeDate(Year, Month, Day);
end;
function ExtractDay(ADate: TDateTime): Word;
var
M, Y: Word;
begin
DecodeDate(ADate, Y, M, Result);
end;
function ExtractMonth(ADate: TDateTime): Word;
var
D, Y: Word;
begin
DecodeDate(ADate, Y, Result, D);
end;
function ExtractYear(ADate: TDateTime): Word;
var
D, M: Word;
begin
DecodeDate(ADate, Result, M, D);
end;
function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
var
D, M, Y: Word;
Day, Month, Year: Longint;
begin
DecodeDate(ADate, Y, M, D);
Year := Y; Month := M; Day := D;
Inc(Year, Years);
Inc(Year, Months div 12);
Inc(Month, Months mod 12);
if Month < 1 then begin
Inc(Month, 12);
Dec(Year);
end
else if Month > 12 then begin
Dec(Month, 12);
Inc(Year);
end;
if Day > DaysPerMonth(Year, Month) then Day := DaysPerMonth(Year, Month);
Result := EncodeDate(Year, Month, Day) + Days + Frac(ADate);
end;
procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
{ Corrected by Anatoly A. Sanko (2:450/73) }
var
DtSwap: TDateTime;
Day1, Day2, Month1, Month2, Year1, Year2: Word;
begin
if Date1 > Date2 then begin
DtSwap := Date1;
Date1 := Date2;
Date2 := DtSwap;
end;
DecodeDate(Date1, Year1, Month1, Day1);
DecodeDate(Date2, Year2, Month2, Day2);
Years := Year2 - Year1;
Months := 0;
Days := 0;
if Month2 < Month1 then begin
Inc(Months, 12);
Dec(Years);
end;
Inc(Months, Month2 - Month1);
if Day2 < Day1 then begin
Inc(Days, DaysPerMonth(Year1, Month1));
if Months = 0 then begin
Dec(Years);
Months := 11;
end
else Dec(Months);
end;
Inc(Days, Day2 - Day1);
end;
function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
begin
Result := ADate + Delta;
end;
function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncDate(ADate, 0, Delta, 0);
end;
function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncDate(ADate, 0, 0, Delta);
end;
function MonthsBetween(Date1, Date2: TDateTime): Double;
var
D, M, Y: Word;
begin
DateDiff(Date1, Date2, D, M, Y);
Result := 12 * Y + M;
if (D > 1) and (D < 7) then Result := Result + 0.25
else if (D >= 7) and (D < 15) then Result := Result + 0.5
else if (D >= 15) and (D < 21) then Result := Result + 0.75
else if (D >= 21) then Result := Result + 1;
end;
function IsValidDate(Y, M, D: Word): Boolean;
begin
Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
(D >= 1) and (D <= DaysPerMonth(Y, M));
end;
function ValidDate(ADate: TDateTime): Boolean;
var
Year, Month, Day: Word;
begin
try
DecodeDate(ADate, Year, Month, Day);
Result := IsValidDate(Year, Month, Day);
except
Result := False;
end;
end;
function DaysInPeriod(Date1, Date2: TDateTime): Longint;
begin
if ValidDate(Date1) and ValidDate(Date2) then
Result := Abs(Trunc(Date2) - Trunc(Date1)) + 1
else Result := 0;
end;
function DaysBetween(Date1, Date2: TDateTime): Longint;
begin
Result := Trunc(Date2) - Trunc(Date1) + 1;
if Result < 0 then Result := 0;
end;
function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
MSecs: Integer): TDateTime;
begin
Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
if Result < 0 then Result := Result + 1;
end;
function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, Delta, 0, 0, 0);
end;
function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, 0, Delta, 0, 0);
end;
function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, 0, 0, Delta, 0);
end;
function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
begin
Result := IncTime(ATime, 0, 0, 0, Delta);
end;
function CutTime(ADate: TDateTime): TDateTime;
begin
Result := Trunc(ADate);
end;
function CurrentYear: Word;
var
SystemTime: TSystemTime;
begin
GetLocalTime(SystemTime);
Result := SystemTime.Year;
end;
{ String to date conversions. Copied from SYSUTILS.PAS unit. }
procedure ScanBlanks(const S: string; var Pos: Integer);
var
I: Integer;
begin
I := Pos;
while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
Pos := I;
end;
function ScanNumber(const S: string; MaxLength: Integer; var Pos: Integer;
var Number: Longint): Boolean;
var
I: Integer;
N: Word;
begin
Result := False;
ScanBlanks(S, Pos);
I := Pos;
N := 0;
while (I <= Length(S)) and (Longint(I - Pos) < MaxLength) and
(S[I] in ['0'..'9']) and (N < 1000) do
begin
N := N * 10 + (Ord(S[I]) - Ord('0'));
Inc(I);
end;
if I > Pos then begin
Pos := I;
Number := N;
Result := True;
end;
end;
function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
begin
Result := False;
ScanBlanks(S, Pos);
if (Pos <= Length(S)) and (S[Pos] = Ch) then begin
Inc(Pos);
Result := True;
end;
end;
{$IFDEF RX_D3}
procedure ScanToNumber(const S: string; var Pos: Integer);
begin
while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do begin
if S[Pos] in LeadBytes then Inc(Pos);
Inc(Pos);
end;
end;
{$ENDIF}
function GetDateOrder(const DateFormat: string): TDateOrder;
var
I: Integer;
begin
Result := DefaultDateOrder;
I := 1;
while I <= Length(DateFormat) do begin
case Chr(Ord(DateFormat[I]) and $DF) of
{$IFDEF RX_D3}
'E': Result := doYMD;
{$ENDIF}
'Y': Result := doYMD;
'M': Result := doMDY;
'D': Result := doDMY;
else
Inc(I);
Continue;
end;
Exit;
end;
Result := DefaultDateOrder; { default }
end;
function ExpandYear(Year: Integer): Integer;
var
N: Longint;
begin
Result := Year;
if Result < 100 then begin
N := CurrentYear - CenturyOffset;
Inc(Result, N div 100 * 100);
if (CenturyOffset > 0) and (Result < N) then
Inc(Result, 100);
end;
end;
function ScanDate(const S, DateFormat: string; var Pos: Integer;
var Y, M, D: Integer): Boolean;
var
DateOrder: TDateOrder;
N1, N2, N3: Longint;
begin
Result := False;
Y := 0; M := 0; D := 0;
DateOrder := GetDateOrder(DateFormat);
if DefaultFormatSettings.ShortDateFormat[1] = 'g' then { skip over prefix text }
ScanToNumber(S, Pos);
if not (ScanNumber(S, MaxInt, Pos, N1) and ScanChar(S, Pos, DefaultFormatSettings.DateSeparator) and
ScanNumber(S, MaxInt, Pos, N2)) then Exit;
if ScanChar(S, Pos, DateSeparator) then begin
if not ScanNumber(S, MaxInt, Pos, N3) then Exit;
case DateOrder of
doMDY: begin Y := N3; M := N1; D := N2; end;
doDMY: begin Y := N3; M := N2; D := N1; end;
doYMD: begin Y := N1; M := N2; D := N3; end;
end;
Y := ExpandYear(Y);
end
else begin
Y := CurrentYear;
if DateOrder = doDMY then begin
D := N1; M := N2;
end
else begin
M := N1; D := N2;
end;
end;
ScanChar(S, Pos, DefaultFormatSettings.DateSeparator);
ScanBlanks(S, Pos);
(*
{$IFDEF RX_D3}
if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
begin { ignore trailing text }
if ShortTimeFormat[1] in ['0'..'9'] then { stop at time digit }
ScanToNumber(S, Pos)
else { stop at time prefix }
repeat
while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
ScanBlanks(S, Pos);
until (Pos > Length(S)) or
(AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
(AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
end;
{$ENDIF RX_D3}
*)
Result := IsValidDate(Y, M, D) and (Pos > Length(S));
end;
function MonthFromName(const S: string; MaxLen: Byte): Byte;
begin
if Length(S) > 0 then
for Result := 1 to 12 do begin
if (Length(DefaultFormatSettings.LongMonthNames[Result]) > 0) and
(AnsiCompareText(Copy(S, 1, MaxLen),
Copy(DefaultFormatSettings.LongMonthNames[Result], 1, MaxLen)) = 0) then Exit;
end;
Result := 0;
end;
procedure ExtractMask(const Format, S: string; Ch: Char; Cnt: Integer;
var I: Integer; Blank, Default: Integer);
var
Tmp: string[20];
J, L: Integer;
begin
I := Default;
Ch := UpCase(Ch);
L := Length(Format);
if Length(S) < L then L := Length(S)
else if Length(S) > L then Exit;
J := Pos(MakeStr(Ch, Cnt), AnsiUpperCase(Format));
if J <= 0 then Exit;
Tmp := '';
while (UpCase(Format[J]) = Ch) and (J <= L) do begin
if S[J] <> ' ' then Tmp := Tmp + S[J];
Inc(J);
end;
if Tmp = '' then I := Blank
else if Cnt > 1 then begin
I := MonthFromName(Tmp, Length(Tmp));
if I = 0 then I := -1;
end
else I := StrToIntDef(Tmp, -1);
end;
function ScanDateStr(const Format, S: string; var D, M, Y: Integer): Boolean;
var
Pos: Integer;
begin
ExtractMask(Format, S, 'm', 3, M, -1, 0); { short month name? }
if M = 0 then ExtractMask(Format, S, 'm', 1, M, -1, 0);
ExtractMask(Format, S, 'd', 1, D, -1, 1);
ExtractMask(Format, S, 'y', 1, Y, -1, CurrentYear);
Y := ExpandYear(Y);
Result := IsValidDate(Y, M, D);
if not Result then begin
Pos := 1;
Result := ScanDate(S, Format, Pos, Y, M, D);
end;
end;
function InternalStrToDate(const DateFormat, S: string;
var Date: TDateTime): Boolean;
var
D, M, Y: Integer;
begin
if S = '' then begin
Date := NullDate;
Result := True;
end
else begin
Result := ScanDateStr(DateFormat, S, D, M, Y);
if Result then
try
Date := EncodeDate(Y, M, D);
except
Result := False;
end;
end;
end;
function StrToDateFmt(const DateFormat, S: string): TDateTime;
begin
if not InternalStrToDate(DateFormat, S, Result) then
raise EConvertError.CreateFmt({$IFDEF RX_D3} SInvalidDate {$ELSE}
LoadStr(SInvalidDate) {$ENDIF}, [S]);
end;
function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
begin
if not InternalStrToDate(DefaultFormatSettings.ShortDateFormat, S, Result) then
Result := Trunc(Default);
end;
function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
begin
if not InternalStrToDate(DateFormat, S, Result) then
Result := Trunc(Default);
end;
function DefDateFormat(FourDigitYear: Boolean): string;
begin
if FourDigitYear then begin
case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
doMDY: Result := 'MM/DD/YYYY';
doDMY: Result := 'DD/MM/YYYY';
doYMD: Result := 'YYYY/MM/DD';
end;
end
else begin
case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
doMDY: Result := 'MM/DD/YY';
doDMY: Result := 'DD/MM/YY';
doYMD: Result := 'YY/MM/DD';
end;
end;
end;
function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
begin
if FourDigitYear then begin
case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
doMDY, doDMY: Result := '!99/99/9999;1;';
doYMD: Result := '!9999/99/99;1;';
end;
end
else begin
case GetDateOrder(DefaultFormatSettings.ShortDateFormat) of
doMDY, doDMY: Result := '!99/99/99;1;';
doYMD: Result := '!99/99/99;1;';
end;
end;
if Result <> '' then Result := Result + BlanksChar;
end;
{$IFDEF WIN32}
function FormatLongDate(Value: TDateTime): string;
var
Buffer: array[0..1023] of Char;
SystemTime: TSystemTime;
begin
{$IFDEF RX_D3}
DateTimeToSystemTime(Value, SystemTime);
{$ELSE}
with SystemTime do
begin
DecodeDate(Value, wYear, wMonth, wDay);
DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds);
end;
{$ENDIF}
SetString(Result, Buffer, GetDateFormat(GetThreadLocale, DATE_LONGDATE,
@SystemTime, nil, Buffer, SizeOf(Buffer) - 1));
Result := TrimRight(Result);
end;
function FormatLongDateTime(Value: TDateTime): string;
begin
if Value <> NullDate then
Result := FormatLongDate(Value) + FormatDateTime(' tt', Value)
else Result := '';
end;
{$ENDIF WIN32}
{$IFNDEF USE_FOUR_DIGIT_YEAR}
function FourDigitYear: Boolean;
begin
Result := Pos('YYYY', AnsiUpperCase(DefaultFormatSettings.ShortDateFormat)) > 0;
end;
{$ENDIF}
{$IFDEF USE_FOUR_DIGIT_YEAR}
initialization
FourDigitYear := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
{$ENDIF}
end.

View File

@@ -0,0 +1,73 @@
object Form1: TForm1
Left = 708
Height = 240
Top = 316
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Label2: TLabel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
Left = 127
Height = 24
Top = 19
Width = 67
BorderSpacing.Around = 6
Caption = 'Label2'
Font.Height = -20
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object Label3: TLabel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Owner
Left = 119
Height = 13
Top = 0
Width = 82
Caption = 'Keyboard Layout'
ParentColor = False
end
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideTop.Side = asrCenter
Left = 6
Height = 13
Top = 114
Width = 88
BorderSpacing.Around = 6
Caption = 'Enter text for test'
ParentColor = False
end
object Memo1: TMemo
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 101
Top = 133
Width = 308
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
TabOrder = 0
end
object Timer1: TTimer
Interval = 500
OnTimer = Timer1Timer
Left = 144
Top = 72
end
end

View File

@@ -0,0 +1,263 @@
object Form1: TForm1
Left = 574
Height = 620
Top = 316
Width = 770
Caption = 'Form1'
ClientHeight = 620
ClientWidth = 770
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 570
Top = 50
Width = 770
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = True
Columns = <
item
Alignment = taCenter
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'CODE'
Width = 60
FieldName = 'CODE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
WordWrap = True
OnDrawColumnCell = RxDBGrid1Columns0DrawColumnCell
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'DATE'
Width = 90
FieldName = 'DATE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'NAME'
Width = 400
FieldName = 'NAME'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.DrawFullLine = False
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter, rdgAllowToolMenu]
Align = alClient
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = dsData
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
TabOrder = 0
OnMergeCells = RxDBGrid1MergeCells
end
object Panel1: TPanel
Left = 0
Height = 50
Top = 0
Width = 770
Align = alTop
AutoSize = True
ClientHeight = 50
ClientWidth = 770
TabOrder = 1
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 7
Height = 24
Top = 7
Width = 108
BorderSpacing.Around = 6
Caption = 'Col spanning'
OnChange = CheckBox1Change
TabOrder = 0
end
object Button1: TButton
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 694
Height = 36
Top = 7
Width = 69
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Export...'
OnClick = Button1Click
TabOrder = 1
end
object Button2: TButton
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Button1
Left = 643
Height = 36
Top = 7
Width = 45
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Print'
OnClick = Button2Click
TabOrder = 2
end
end
object rxData: TRxMemoryData
FieldDefs = <
item
Name = 'CODE'
DataType = ftInteger
end
item
Name = 'DATE'
DataType = ftDateTime
end
item
Name = 'NAME'
DataType = ftString
Size = 150
end>
PacketRecords = 0
Left = 293
Top = 165
object rxDataCODE: TLongintField
FieldKind = fkData
FieldName = 'CODE'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataDATE: TDateTimeField
FieldKind = fkData
FieldName = 'DATE'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
DisplayFormat = 'dd.mm.yyyy'
end
object rxDataNAME: TStringField
FieldKind = fkData
FieldName = 'NAME'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 150
end
end
object dsData: TDataSource
DataSet = rxData
Left = 256
Top = 165
end
object RxDBGridExportSpreadSheet1: TRxDBGridExportSpreadSheet
RxDBGrid = RxDBGrid1
Caption = 'Экспорт в электронную таблицу'
ShowSetupForm = True
FileName = 'aaa.ods'
PageName = 'Test1'
Options = [ressExportTitle, ressExportColors, ressExportFooter, ressExportFormula, ressOverwriteExisting, ressExportSelectedRows, ressHideZeroValues, ressColSpanning]
OpenAfterExport = True
Left = 336
Top = 165
end
object RxDBGridPrint1: TRxDBGridPrint
RxDBGrid = RxDBGrid1
Caption = 'Печать списка'
ShowSetupForm = True
Options = [rxpoShowTitle, rxpoShowFooter, rxpoShowGridColor, rxpoShowFooterColor, rxpoShowReportTitle, rxpoHideZeroValues]
ShowProgress = True
ReportTitle = 'A'
ShowColumnHeaderOnAllPage = True
Left = 336
Top = 208
end
end

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

View File

@@ -0,0 +1,80 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="rxnew"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EConvertError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

View File

@@ -0,0 +1,387 @@
object Form1: TForm1
Left = 484
Height = 397
Top = 317
Width = 552
Caption = 'Find form'
ClientHeight = 397
ClientWidth = 552
Position = poScreenCenter
ShowHint = True
LCLVersion = '0.9.31'
object ToolPanel1: TToolPanel
Left = 0
Height = 34
Top = 0
Width = 552
Items = <
item
Action = actExit
Visible = True
Left = 5
Height = 24
Top = 5
Width = 53
ShowCaption = True
end
item
Visible = True
Left = 58
Height = 24
Top = 5
Width = 7
ShowCaption = False
ButtonStyle = tbrSeparator
end
item
Action = actBack
Visible = True
Left = 65
Height = 24
Top = 5
Width = 76
ShowCaption = True
ButtonStyle = tbrDropDownExtra
end
item
Action = actForward
Visible = True
Left = 141
Height = 24
Top = 5
Width = 89
ShowCaption = True
ButtonStyle = tbrDropDownExtra
end>
ImageList = ImageList1
ToolBarStyle = tbsWindowsXP
Options = [tpFlatBtns]
Align = alTop
BorderWidth = 4
ClientHeight = 34
ClientWidth = 552
TabOrder = 0
end
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = ToolPanel1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 18
Top = 40
Width = 99
BorderSpacing.Around = 6
Caption = 'Enter finde text'
ParentColor = False
end
object Edit1: TEdit
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BitBtn1
Left = 6
Height = 27
Top = 64
Width = 476
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
TabOrder = 1
Text = 'text to find'
end
object Memo1: TMemo
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Edit1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StatusBar1
Left = 6
Height = 273
Top = 97
Width = 540
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
TabOrder = 2
end
object BitBtn1: TBitBtn
AnchorSideTop.Control = Edit1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 488
Height = 30
Top = 62
Width = 58
Action = actFind
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Glyph.Data = {
46050000424D4605000000000000360000002800000012000000120000000100
2000000000001005000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF003E39
34FF393430FF332F2BFF2C2925FF272421FF201D1BFF1716141A110F0EDB0B0A
09FF070706FF040403FF000000FF000000FFFFFFFF00FFFFFF00000000000000
0000FFFFFF0046413BFF857A70FFC3B8AEFF7C7268FF7F756BFF36322DFF1E1C
190F282522D495897DFFBAAEA2FF7C7268FF7F756BFF010101FFFFFFFF00FFFF
FF000000000000000000FFFFFF004D4741FF83786FFFCCC3BAFF786F65FF7B71
67FF2F2B28F9272421011D1B18EE95897DFFC2B8ADFF786F65FF7C7268FF0605
05FFFFFFFF00FFFFFF000000000000000000FFFFFF00534C46FC83786FFFCCC3
BAFF797066FF71685FFF37332ED5FFFFFF00252220D5857A70FFC2B8ADFF786F
65FF7B7167FF0A0908FCFFFFFF00FFFFFF000000000000000000FFFFFF005A52
4CC39F9286FFCCC3BAFFC0B4AAFFA6988BFF3E3934A8FFFFFF002C2925A89084
79FFC2B8ADFFC0B4AAFFA89B8EFF110F0EC3FFFFFF00FFFFFF00000000000000
0000797066055C554EF9423D38FF58514AFF3D3833FF332F2BFF23201DE51716
14301E1C19B51A1816FF252220FF191715FF0F0E0DFF010101EE00000002FFFF
FF0000000000000000009F9286059D9185FFB1A396FF7F756BFF7C7268FF776D
64FF6C635BFF2E2A26FF564F48FF80766CFF7C7268FF776D64FF70675EFF0000
00FE00000005FFFFFF000000000000000000AB9D9004AFA194E1BAAEA2FF8277
6DFF82776DFFAA917BFFBAA794FFB7A48EFAB09781FF9F8D7DFF836D5BFF7163
57FF95897DFF040403E000000003FFFFFF000000000000000000B9ACA008877D
72489B8E82FF9D9185FF867B71FF564F48FF504A44FF80766CFF6E665DFF826C
58FFA6917DFF948474FF564F48FF0C0B0B7A07070601FFFFFF00000000000000
0000FFFFFF00FFFFFF00746B62FFA4978AFF95897DFF9F9286FF3E3934FFFFFF
FF004C4640FF7E746AFF857A70FF3E3934FF453F3AA72522200C15131102FFFF
FF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF008E8378E2C3B8
AEFF655D55FFFFFFFF007C7268FFA89B8EFF9C8F83E4FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
FF009C8F83E2BCB0A4FF9D9185FFFFFFFF00AEA093FF9D9185FF655D55DAFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000
0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF000000000000000000
}
TabOrder = 3
end
object StatusBar1: TStatusBar
Left = 0
Height = 21
Top = 376
Width = 552
Panels = <>
end
object ActionList1: TActionList
Images = ImageList1
left = 264
top = 200
object actExit: TAction
Caption = 'Exit'
ImageIndex = 0
OnExecute = actExitExecute
end
object actFind: TAction
Caption = 'Find'
ImageIndex = 1
OnExecute = actFindExecute
end
object actBack: TAction
Caption = 'Back'
Enabled = False
ImageIndex = 2
end
object actForward: TAction
Caption = 'Repeat'
Enabled = False
ImageIndex = 3
end
end
object ImageList1: TImageList
Height = 18
Width = 18
left = 320
top = 200
Bitmap = {
4C69040000001200000012000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF006D9CD4896A9AD2FB6697CFEE0000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00709ED6DB6D9CD4FF85B1DAFF5A91B9FF6093CBEA0000000000000000FFFF
FF00FFFFFF00808080FF7E7E7EFF7C7C7CFF7A7A7AFF777777FF757575FF7272
72FF719ED4FF6F9ED6FF87B2DCFFABD3E8FFA9D0E6FF5890B8FF598EC6EA0000
000000000000FFFFFF00FFFFFF007D7D7DFF999999FF999999FF9A9A9AFF9A9A
9AFF9B9B9BFF9B9B9BFF6F9DD3FFAAD1E7FFABD1E7FF98C7E1FF91C2DEFF568F
B7FF5289C1EA0000000000000000FFFFFF00FFFFFF007A7A7AFF999999FF5291
59FF999A99FF9B9B9BFF9C9C9CFF9C9C9CFF6C9AD0FFA7CEE5FF8FC1DFFF89BD
DCFF8BBDDCFF538DB6FF4B84BCEA0000000000000000FFFFFF00FFFFFF007777
77FF9A9A9AFF3D8A45FF498A4FFF9C9C9CFF9D9D9DFF9D9D9DFF6696CCFFA2CB
E3FF89BDDCFF83B9DAFF84B9DAFF518BB5FF437EB6EA00000000000000004494
4DFF42914BFF3F8D48FF3D8945FF5DA465FF5AA061FF45834BFF9E9E9EFF9E9E
9EFF6092C9FF9EC7E2FF83B8DAFF7DB4D7FF7EB3D7FF4F89B4FF3B79B1EA0000
00000000000041904AFF94D29FFF91D09AFF8DCD96FF89CB92FF84C88DFF5198
58FF417C46FF9F9F9FFF5A8EC4FF98C3E0FF7CB3D7FF74AFD6FF5EC4EDFF4B88
B3FF3473ABEA00000000000000003E8B46FF8FCE99FF7DC687FF78C381FF73C0
7CFF74C07CFF79C281FF49904FFF547F57FF5489BFFF94BFDDFF75ADD4FF63B8
E1FF4BD4FFFF428BB8FF2C6EA6EA00000000000000003B8742FF89CB92FF84C8
8DFF80C688FF7BC383FF77C17FFF478F4DFF3B743FFFA1A1A1FF4C84BAFF8DBB
DBFF6EA8D1FF66A6D1FF5FB4DFFF4785B1FF2569A1EA00000000000000003782
3EFF347E3BFF317937FF2E7534FF499150FF468F4CFF39733DFFA1A1A1FFA2A2
A2FF457EB4FF88B7D9FF67A3CFFF619ECCFF639FCCFF4583B1FF1F649CEA0000
000000000000FFFFFF00FFFFFF00606060FFA0A0A0FF3D7641FF367139FFA2A2
A2FFA2A2A2FFA3A3A3FF3D79B0FF82B3D7FF629FCCFF5A9AC9FF5E9BCAFF4381
AFFF196098EA0000000000000000FFFFFF00FFFFFF005C5C5CFFA1A1A1FF3C73
40FFA0A1A1FFA3A3A3FFA3A3A3FFA4A4A4FF3674AAFF7DAFD4FF5B9AC9FF5495
C7FF5896C8FF4180AEFF135C94EA0000000000000000FFFFFF00FFFFFF005858
58FFA2A2A2FFA2A2A2FFA3A3A3FFA4A4A4FFA4A4A4FFA5A5A5FF2F6FA5FF78AB
D2FF78ABD3FF73A7D1FF69A0CDFF407FAEFF0F5991EA00000000000000009999
99FF717171FF545454FF515151FF4F4F4FFF4C4C4CFF4A4A4AFF474747FF4545
45FF25679DFF3274A8FF3D7CAFFF4784B5FF4E8ABAFF3E7EADFF0C578FEA0000
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF001D639B1619609839145D9562105A92880D5890A4135C
92FC0C578FED0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF009C8F
83E2BCB0A4FF9D9185FFFFFFFF00AEA093FF9D9185FF655D55DAFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF008E8378E2C3B8AEFF655D55FFFFFFFF007C7268FFA89B8EFF9C8F
83E4FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFF
FF00FFFFFF00746B62FFA4978AFF95897DFF9F9286FF3E3934FFFFFFFF004C46
40FF7E746AFF857A70FF3E3934FF453F3AA72522200C15131102FFFFFF000000
000000000000B9ACA008877D72489B8E82FF9D9185FF867B71FF564F48FF504A
44FF80766CFF6E665DFF826C58FFA6917DFF948474FF564F48FF0C0B0B7A0707
0601FFFFFF000000000000000000AB9D9004AFA194E1BAAEA2FF82776DFF8277
6DFFAA917BFFBAA794FFB7A48EFAB09781FF9F8D7DFF836D5BFF716357FF9589
7DFF040403E000000003FFFFFF0000000000000000009F9286059D9185FFB1A3
96FF7F756BFF7C7268FF776D64FF6C635BFF2E2A26FF564F48FF80766CFF7C72
68FF776D64FF70675EFF000000FE00000005FFFFFF0000000000000000007970
66055C554EF9423D38FF58514AFF3D3833FF332F2BFF23201DE5171614301E1C
19B51A1816FF252220FF191715FF0F0E0DFF010101EE00000002FFFFFF000000
000000000000FFFFFF005A524CC39F9286FFCCC3BAFFC0B4AAFFA6988BFF3E39
34A8FFFFFF002C2925A8908479FFC2B8ADFFC0B4AAFFA89B8EFF110F0EC3FFFF
FF00FFFFFF000000000000000000FFFFFF00534C46FC83786FFFCCC3BAFF7970
66FF71685FFF37332ED5FFFFFF00252220D5857A70FFC2B8ADFF786F65FF7B71
67FF0A0908FCFFFFFF00FFFFFF000000000000000000FFFFFF004D4741FF8378
6FFFCCC3BAFF786F65FF7B7167FF2F2B28F9272421011D1B18EE95897DFFC2B8
ADFF786F65FF7C7268FF060505FFFFFFFF00FFFFFF000000000000000000FFFF
FF0046413BFF857A70FFC3B8AEFF7C7268FF7F756BFF36322DFF1E1C190F2825
22D495897DFFBAAEA2FF7C7268FF7F756BFF010101FFFFFFFF00FFFFFF000000
000000000000FFFFFF003E3934FF393430FF332F2BFF2C2925FF272421FF201D
1BFF1716141A110F0EDB0B0A09FF070706FF040403FF000000FF000000FFFFFF
FF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00DFDBD7FFB3A79CFFA5998DFFFFFF
FF00AC9F92FF94897FFFB8B4B0FFFFFFFF00FFFFFF000000000000000000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E5E3E1FFCFC9C4FFACA2
97FF776F66FFFFFFFF00776D64FFA09488FFBAB3ADFFE2E1E0FFFFFFFF000000
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00897E
73FF9B8E82FF887D72FF564F48FFC0BCB8FF5D564EFF857668FF7C6F63FF6C65
5FFFBBBAB9FF0000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00C8BFB7FFA89B90FF897E74FF86786AFF8E7F70FFA19181FF958372FF937F
6DFF897666FF7D7166FF555351FF0000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A3978BFFA99D90FF7F756BFF7F7469FF7D7267FF4E47
3FFF6B6056FF84786DFF7A6E64FF776D63FF1C1A18FF0000000000000000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00605953FF46413BFF4E4842FF3833
2FFF383532FFC6C6C5FF5A5856FF1D1B19FF201D1BFF131110FF111111FF0000
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0078726EFFA397
8CFFC2B9AFFFA6998EFF827C76FFFFFFFF006F6C69FF9C9186FFBBB0A5FFA69A
8EFF4F4C49FF0000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00524C46FF90867DFFAEA59BFF776D64FF55504CFFFFFFFF0045423FFF9A8F
84FFA0978CFF7A7167FF1F1C1AFF0000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF0049433DFF90857CFFABA197FF7C7268FF49433EFFFFFF
FF00484441FFA09488FF9F9489FF7D7369FF191715FF0000000000000000FFFF
FF00FFFFFF00FFFFFF003BA8DBFFFFFFFF00403B35FF4A443EFF49443EFF3A36
31FF2A2623FFFFFFFF00373434FF282522FF24221FFF1A1816FF050404FF0000
000000000000FFFFFF00FFFFFF003BA8DBFF3BA8DBFFFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000FFFFFF003BA8DBFF3BA8DBFF3BA8DBFF3BA8
DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8
DBFF3BA8DBFFFFFFFF00FFFFFF000000000000000000FFFFFF003BA8DBFF3BA8
DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8
DBFF3BA8DBFF3BA8DBFF3BA8DBFFFFFFFF00FFFFFF000000000000000000FFFF
FF00FFFFFF003BA8DBFF3BA8DBFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
000000000000FFFFFF00FFFFFF00FFFFFF003BA8DBFFFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
000000000000FFFFFF00FFFFFF00B8B4B0FF94897FFFAC9F92FFFFFFFF00A599
8DFFB3A79CFFDFDBD7FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000FFFFFF00E2E1E0FFBAB3ADFFA09488FF776D
64FFFFFFFF00776F66FFACA297FFCFC9C4FFE5E3E1FFFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF000000000000000000BBBAB9FF6C655FFF7C6F
63FF857668FF5D564EFFC0BCB8FF564F48FF887D72FF9B8E82FF897E73FFFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000005553
51FF7D7166FF897666FF937F6DFF958372FFA19181FF8E7F70FF86786AFF897E
74FFA89B90FFC8BFB7FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
0000000000001C1A18FF776D63FF7A6E64FF84786DFF6B6056FF4E473FFF7D72
67FF7F7469FF7F756BFFA99D90FFA3978BFFFFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000111111FF131110FF201D1BFF1D1B19FF5A58
56FFC6C6C5FF383532FF38332FFF4E4842FF46413BFF605953FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF0000000000000000004F4C49FFA69A8EFFBBB0
A5FF9C9186FF6F6C69FFFFFFFF00827C76FFA6998EFFC2B9AFFFA3978CFF7872
6EFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000001F1C
1AFF7A7167FFA0978CFF9A8F84FF45423FFFFFFFFF0055504CFF776D64FFAEA5
9BFF90867DFF524C46FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
000000000000191715FF7D7369FF9F9489FFA09488FF484441FFFFFFFF004943
3EFF7C7268FFABA197FF90857CFF49433DFFFFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000050404FF1A1816FF24221FFF282522FF3734
34FFFFFFFF002A2623FF3A3631FF49443EFF4A443EFF403B35FFFFFFFF003BA8
DBFFFFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF003BA8DBFF3BA8DBFFFFFFFF00FFFFFF000000000000000000FFFF
FF00FFFFFF003BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8
DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFFFFFFFF000000
000000000000FFFFFF00FFFFFF003BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8
DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8DBFF3BA8
DBFFFFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003BA8
DBFF3BA8DBFFFFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF003BA8DBFFFFFFFF00FFFFFF00FFFFFF0000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
object PopupMenu1: TPopupMenu
left = 120
top = 136
end
object RxHistoryNavigator1: TRxHistoryNavigator
ToolPanel = ToolPanel1
BackBtn = 'actBack'
ForwardBtn = 'actForward'
OnHistoryNavigate = RxHistoryNavigator1HistoryNavigate
left = 441
top = 48
end
object ApplicationProperties1: TApplicationProperties
OnHint = ApplicationProperties1Hint
left = 360
top = 200
end
end

View File

@@ -0,0 +1 @@
TRXDBGRIDCOLUMSFORM.CAPTION=Grid colums

View File

@@ -0,0 +1,25 @@
<?xml version="1.0" encoding="UTF-8"?>
<fpdoc-descriptions><package name="rxtools"><module name="rxFileUtils"><short>Модуль содержит вспомогательные утилиты для работы с файлами и каталогами</short><element name="FileNameDisabledChars"><short>Список символов, которые нельзя использовать в имени фала</short><descr><p>Константа FileNameDisabledChars содержит список символов, которые нельзя использовать в имени файла.</p><p>Значения константы зависит от платформы</p>
</descr>
</element><element name="IsValidFileNameChar"><short>Функция проверяет допустимост использования символа в имени файла</short>
</element><element name="NormalizeFileName"><short>Функция приводит имя файла к правильному виду в зависимости от платформы</short><descr><p>Данная функция проверяет все символы в имени файла и заменяет запрещённые символы на указанный <b>AReplaceChar</b>.</p><p>По умолчанию вместо AReplaceChar подставляется символ "_" (подчёркивание)</p>
</descr>
</element><element name="GetFileOwnerUser"><short>Функция возвращает имя пользователя - владельца файла</short>
<descr><p>function <b>GetFileOwnerUser</b>(const SearchDomain, FileName:<b>String</b>):<b>String</b>;</p><p>Функция возвращает имя пользователя операционной системы владельца указанного файла.</p><p><b>Входные параметры:</b>
</p><p>SearchDomain - Домен, в котором будет производится поиск оператора (пустой для текущего домена оператора).</p><p>FileName - Полное имя файла.</p><remark>В данный момент функция реализована только для windows.</remark>
</descr>
</element><element name="GetFileOwnerData"><short>Функция возвращает данные о владельце файла</short>
<descr><p><b>procedure</b> GetFileOwnerData(<b>const</b> SearchDomain, FileName:<b>String</b>;<b>out</b> UserName, DomainName:<b>String</b>);</p><p>Процедура возвращает имя и домен пользователя операционной системы владельца указанного файла. </p><p><b>Входные параметры:</b>
</p><p>- SearchDomain - Домен, в котором будет производится поиск оператора (пустой для текущего домена оператора).</p><p>- FileName - Полное имя файла.</p><p><b>Выходные параметры:</b>
</p><p>- UserName - Имя пльзователя.</p><p>- DomainName - Домен, в котором найден данный пользователь.</p><remark>В данный момент функция реализована только для windows.</remark>
</descr>
</element><element name="NormalizeDirectoryName"><short>Функция приводит все разделители в полном пути к файлу к виду принятом на текущей платформе</short>
<descr><p><b>function</b> NormalizeDirectoryName(<b>const</b> DirName:<b>string</b>):<b>string</b>;</p><p>Функция проверяет все разделители каталогов в указанном имени файла/каталога и, если нужно, меняет их на значение константы<b>DirectorySeparator</b>.</p>
</descr>
</element><element name="GetUserName"><short>Функция возвращяет имя текущего пользователя, зарегистрированного в операционной сиситеме на рабочем месте</short>
<descr><p><b>function</b> GetUserName: <b>string</b>;</p><p>Функция <b>GetUserName</b> возвращает имя оператора, зарегистрированного в системе</p>
</descr>
</element>
</module>
</package>
</fpdoc-descriptions>

View File

@@ -0,0 +1,49 @@
unit Unit4;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls;
type
{ TForm4 }
TForm4 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Panel1: TPanel;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
CntMM:integer = 0;
implementation
{$R *.lfm}
{ TForm4 }
procedure TForm4.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:=caFree;
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
Inc(CntMM);
Panel1.Caption:=Panel1.Caption + IntToStr(CntMM);
Caption:=Panel1.Caption;
end;
end.

View File

@@ -0,0 +1,319 @@
{ RxDBSpinEdit 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 RxDBSpinEdit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Spin,
DbCtrls, DB, LMessages, LCLType, LCLVersion;
type
{ TCustomRxDBSpinEdit }
TCustomRxDBSpinEdit = class(TCustomFloatSpinEdit)
private
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
procedure SetDataField(const AValue: string);
procedure SetDataSource(const AValue: TDataSource);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
procedure ActiveChange(Sender: TObject);
procedure LayoutChange(Sender: TObject);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
function IsReadOnly: boolean;
protected
function GetReadOnly: Boolean;override;
procedure SetReadOnly(AValue: Boolean);override;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
//property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Change; override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
published
{ Published declarations }
end;
TRxDBSpinEdit = class(TCustomRxDBSpinEdit)
published
property DataField;
property DataSource;
property ReadOnly;
property Align;
property Anchors;
property AutoSelect;
property AutoSize;
property BorderSpacing;
property Constraints;
property DecimalPlaces;
property Enabled;
property Font;
property Increment;
property MaxValue;
property MinValue;
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;
property OnUTF8KeyPress;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property Value;
property Visible;
end;
implementation
uses rxdbutils;
type
TFieldDataLinkHack = class(TFieldDataLink)
end;
{ TCustomRxDBSpinEdit }
procedure TCustomRxDBSpinEdit.DataChange(Sender: TObject);
begin
if Assigned(FDataLink.Field) and (FDataLink.Field.DataType in NumericDataTypes) then
begin
if (FDataLink.Field.DataType in IntegerDataTypes) then
DecimalPlaces:=0
else
begin
if FDataLink.Field.DataType = ftBCD then
DecimalPlaces:=(FDatalink.Field as TBCDField).Precision
else
DecimalPlaces:=(FDatalink.Field as TFloatField).Precision;
end;
Value:=FDatalink.Field.AsFloat;
end
else
begin
Text := '';
end;
end;
function TCustomRxDBSpinEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TCustomRxDBSpinEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TCustomRxDBSpinEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TCustomRxDBSpinEdit.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TCustomRxDBSpinEdit.SetDataField(const AValue: string);
begin
FDataLink.FieldName := AValue;
end;
procedure TCustomRxDBSpinEdit.SetDataSource(const AValue: TDataSource);
begin
ChangeDataSource(Self,FDataLink,AValue);
end;
procedure TCustomRxDBSpinEdit.SetReadOnly(AValue: Boolean);
begin
inherited;
FDataLink.ReadOnly := AValue;
end;
procedure TCustomRxDBSpinEdit.UpdateData(Sender: TObject);
begin
FDataLink.Field.Value := Value;
end;
procedure TCustomRxDBSpinEdit.FocusRequest(Sender: TObject);
begin
SetFocus;
end;
procedure TCustomRxDBSpinEdit.ActiveChange(Sender: TObject);
begin
if FDatalink.Active then
DataChange(Sender)
else
begin
Text := '';
FDataLink.Reset;
end;
end;
procedure TCustomRxDBSpinEdit.LayoutChange(Sender: TObject);
begin
DataChange(Sender);
end;
procedure TCustomRxDBSpinEdit.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink);
end;
procedure TCustomRxDBSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key=VK_ESCAPE then
begin
//cancel out of editing by reset on esc
FDataLink.Reset;
SelectAll;
Key := VK_UNKNOWN;
end
else
if Key=VK_DELETE then
begin
if not IsReadOnly then
FDatalink.Edit;
end
else
if Key=VK_TAB then
begin
if FDataLink.CanModify and FDatalink.Editing then
FDataLink.UpdateRecord;
end;
end;
procedure TCustomRxDBSpinEdit.Change;
begin
FDatalink.Edit;
FDataLink.Modified;
inherited Change;
end;
function TCustomRxDBSpinEdit.IsReadOnly: boolean;
begin
Result := true;
if FDatalink.Active and (not Self.ReadOnly) then
Result := (Field = nil) or Field.ReadOnly;
end;
procedure TCustomRxDBSpinEdit.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then
DataChange(Self);
end;
procedure TCustomRxDBSpinEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) then
begin
if (FDataLink<>nil) and (AComponent=DataSource) then
DataSource:=nil;
end;
end;
procedure TCustomRxDBSpinEdit.WMSetFocus(var Message: TLMSetFocus);
begin
inherited WMSetFocus(Message);
if not FDatalink.Editing then
FDatalink.Reset;
end;
procedure TCustomRxDBSpinEdit.WMKillFocus(var Message: TLMKillFocus);
begin
inherited WMKillFocus(Message);
if not FDatalink.Editing then
FDatalink.Reset
else
TFieldDataLinkHack(FDatalink).UpdateData;
end;
constructor TCustomRxDBSpinEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FDataLink.OnActiveChange := @ActiveChange;
{$if (lcl_major = 0) and (lcl_release <= 30)}
FDataLink.OnLayoutChange := @LayoutChange;
{$endif}
end;
destructor TCustomRxDBSpinEdit.Destroy;
begin
FreeAndNil(FDataLink);
inherited Destroy;
end;
end.

View File

@@ -0,0 +1,69 @@
<?xml version="1.0" encoding="UTF-8"?>
<fpdoc-descriptions>
<package name="rxnew">
<module name="RxViewsPanel">
<topic name="TRxViewsPanelItem"/>
<element name="TRxViewsPanelItem">
<descr>Коллекция TRxViewsPanelItems содержит в себе элементы "Кнопки" для переключателя представлений</descr>
</element>
<element name="TRxViewsPanelItem.Create"/>
<element name="TRxViewsPanelItem.Destroy"/>
<element name="TRxViewsPanelItem.Action"/>
<element name="TRxViewsPanelItem.Visible"/>
<element name="TRxViewsPanelItem.Caption"/>
<element name="TRxViewsPanelItem.Tag"/>
<element name="TRxViewsPanelItem.ImageIndex"/>
<element name="TRxViewsPanelItems">
<short>Коллекция TRxViewsPanelItems содержит в себе элементы "Кнопки" для переключателя представлений</short>
<descr>Коллекция TRxViewsPanelItems содержит в себе элементы "Кнопки" для переключателя представлений</descr>
</element>
<element name="TRxViewsPanelItems.Create"/>
<element name="TRxViewsPanelItems.Items"/>
<element name="TRxViewsPanelItems.UpdateImages"/>
<element name="TRxViewsPanel">
<short>Класс TRxViewsPanel представляет собой визуальный компонент в стиле переключателя представления из MS Project или Gnome Planer.</short>
<descr>Класс TRxViewsPanel представляет собой визуальный компонент в стиле переключателя представления из MS Project или Gnome Planer.</descr>
</element>
<short>Модуль RxViewsPanel содержит визуальный компонент для переключения представлений</short>
<descr>Модуль RxViewsPanel содержит визуальный компонент для переключения представлений</descr>
<element name="TRxViewsPanel.Create">
<short>Создаёт экземпляр</short>
</element>
<element name="TRxViewsPanel.Destroy"/>
<element name="TRxViewsPanel.ButtonHeght">
<short>Свойство определяет высоту кнопки в панели</short>
<descr>Свойство определяет высоту кнопки в панели</descr>
</element>
<element name="TRxViewsPanel.Color">
<short>Цвет фона панели</short>
<descr>Цвет фона панели</descr>
</element>
<element name="TRxViewsPanel.Items"/>
<element name="TRxViewsPanel.ImageList">
<short>Указатель на изображения для кнопок</short>
<descr>Указатель на изображения для кнопок на панели.</descr>
</element>
<element name="TRxViewsPanel.OnSelectViewEvent"/>
<element name="TRxViewsPanel.ItemIndex"/>
<element name="TSelectViewEvent">
<short>Событие возникает при нажатии на кнопку переключения вида</short>
<descr>
<p>Событие возникает при нажатии на кнопку переключения вида.
</p>
<table>
<tr>
<td>ItemIndex</td>
<td>Порядковый номер кнопку</td>
</tr>
<tr>
<td>Item</td>
<td>указатель на кнопку</td>
</tr>
</table>
</descr>
<example file="/usr/local/share/lazarus/components/rxnew/Demos/RxViewsPanel/unit1.pas"/>
</element>
</module>
</package>
</fpdoc-descriptions>

View File

@@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit rxdbgrid_print;
{$warn 5023 off : no warning about unused units}
interface
uses
RxDBGridPrintGrid, RxDBGridPrintGrid_SetupUnit, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('RxDBGridPrintGrid', @RxDBGridPrintGrid.Register);
end;
initialization
RegisterPackage('rxdbgrid_print', @Register);
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 993 B

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 848 B

View File

@@ -0,0 +1,175 @@
object Form1: TForm1
Left = 516
Height = 581
Top = 190
Width = 603
Caption = 'Form1'
ClientHeight = 581
ClientWidth = 603
LCLVersion = '1.9.0.0'
object Label1: TLabel
AnchorSideLeft.Control = RxRangeSelector1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = RxRangeSelector1
AnchorSideTop.Side = asrBottom
Left = 289
Height = 13
Top = 146
Width = 31
BorderSpacing.Around = 6
Caption = 'Label1'
ParentColor = False
end
object RadioGroup1: TRadioGroup
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Owner
Left = 256
Height = 69
Top = 6
Width = 90
AutoFill = True
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Style'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 51
ClientWidth = 86
ItemIndex = 1
Items.Strings = (
'rxrsSimple'
'rxrsLazarus'
'rxrsNative'
)
OnClick = RadioGroup1Click
TabOrder = 0
end
object RxRangeSelector1: TRxRangeSelector
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 104
Height = 60
Top = 80
Width = 400
Min = 0
Max = 100
SelectedStart = 0
SelectedEnd = 50
Style = rxrsLazarus
OnChange = RxRangeSelector1Change
ThumbTopGlyph.Data = {
26040000424D260400000000000036000000280000000E000000120000000100
200000000000F003000064000000640000000000000000000000F0F1F200F0F1
F200F0F1F200F0F1F2008080FF024476F3294777F14B4777F14B4979ED2A8080
FF02F0F1F200F0F1F200F0F1F200F0F1F200F0F1F200F0F1F200F0F1F2004D80
E60A4778F14888A1DBB95675C2FC5675C2FC89A0DEB74778F1484D80E60AF0F1
F200F0F1F200F0F1F200F0F1F200F0F1F2004070EF104C7BEF51718CCEF0496C
C0FFC2CDE5FFC2CDE5FF486CBFFF728DCFEF4C7BEF514070EF10F0F1F200F0F1
F200F0F1F200496DED0E5F86EA616583CBF76483CAFFEAECF1FFF0F0F0FFF0F0
F0FFE9EBF1FF6483CAFF6584CBF75B86EC5F496DED0EF0F1F2000000FF014678
F042718DD0F37993D1FFF0F1F3FFF0F0F0FFEFEFEFFFEFEFEFFFF0F0F0FFF0F1
F3FF7993D1FF718DD1F34678F0420000FF01467BED1D8EA6E1BE5778C9FFEFF1
F3FFF1F1F1FFF0F0F0FFF0F0F0FFF0F0F0FFF0F0F0FFF1F1F1FFEFF1F3FF5778
C9FF8EA6E1BE467BED1D487AEE2E7995D5F2B9C6E7FFF4F4F4FFF1F1F1FFF1F1
F1FFF1F1F1FFF1F1F1FFF1F1F1FFF1F1F1FFF4F4F4FFB9C6E7FF7995D5F2487A
EE2E4775EE3D6584D0FBD6DDEFFFF3F3F3FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2
F2FFF2F2F2FFF2F2F2FFF3F3F3FFD6DDEFFF6584D0FB4775EE3D4777EE4B4B70
CAFFEEF0F6FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3
F3FFF3F3F3FFEEF0F6FF4B70CAFF4777EE4B4676F2504068C9FFF8F8F8FFF4F4
F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF8F8
F8FF4068C9FF4676F2504677F24D486FCEFFF4F5F8FFF5F5F5FFF5F5F5FFF5F5
F5FFF5F5F5FFF5F5F5FFF5F5F5FFF5F5F5FFF5F5F5FFF4F5F8FF486FCEFF4677
F24D4777F14B5075D1FFF1F3F8FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6
F6FFF6F6F6FFF6F6F6FFF6F6F6FFF1F3F8FF5075D1FF4777F14B4778F148577B
D4FFEEF1F8FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7
F7FFF7F7F7FFEEF1F8FF577BD4FF4778F1484776EF416B8BDCFDE2E7F6FFF9F9
F9FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF9F9F9FFE2E7
F6FF6B8BDCFD4776EF414777ED2B90A9E6EDC1CEF0FFFBFBFBFFF9F9F9FFF9F9
F9FFF9F9F9FFF9F9F9FFF9F9F9FFF9F9F9FFFBFBFBFFC1CEF0FF90A9E6ED4777
ED2B4D73F2149DB1EDAB6B8BDFFFCAD5F3FFEAEEF9FFF2F4FAFFFAFAFCFFFAFA
FCFFF2F4FAFFEAEEF9FFCAD5F3FF6B8BDFFF9DB1EDAB4D73F21400FFFF014878
F13592ADF08887A2E7F77392E3FD678AE1FE5C81DEFF5C81DEFF678AE1FE7392
E3FD87A2E7F792ADF0884878F13500FFFF01F0F1F20000FFFF014976ED1C4678
F0334677F23A4776EF414877F1474877F1474776EF414677F23A4678F0334976
ED1C00FFFF01F0F1F200
}
ThumbBottomGlyph.Data = {
26040000424D260400000000000036000000280000000E000000120000000100
200000000000F0030000640000006400000000000000000000000000000000FF
FF014976ED1C4678F0334677F23A4776EF414877F1474877F1474776EF414677
F23A4678F0334976ED1C00FFFF010000000000FFFF014878F13592ADF08887A2
E7F77392E3FD678AE1FE5C81DEFF5C81DEFF678AE1FE7392E3FD87A2E7F792AD
F0884878F13500FFFF014D73F2149DB1EDAB6B8BDFFFCAD5F3FFEAEEF9FFF2F4
FAFFFAFAFCFFFAFAFCFFF2F4FAFFEAEEF9FFCAD5F3FF6B8BDFFF9DB1EDAB4D73
F2144777ED2B90A9E6EDC1CEF0FFFBFBFBFFF9F9F9FFF9F9F9FFF9F9F9FFF9F9
F9FFF9F9F9FFF9F9F9FFFBFBFBFFC1CEF0FF90A9E6ED4777ED2B4776EF416B8B
DCFDE2E7F6FFF9F9F9FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8
F8FFF9F9F9FFE2E7F6FF6B8BDCFD4776EF414778F148577BD4FFEEF1F8FFF7F7
F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFEEF1
F8FF577BD4FF4778F1484777F14B5075D1FFF1F3F8FFF6F6F6FFF6F6F6FFF6F6
F6FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6F6FFF6F6F6FFF1F3F8FF5075D1FF4777
F14B4677F24D486FCEFFF4F5F8FFF5F5F5FFF5F5F5FFF5F5F5FFF5F5F5FFF5F5
F5FFF5F5F5FFF5F5F5FFF5F5F5FFF4F5F8FF486FCEFF4677F24D4676F2504068
C9FFF8F8F8FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4
F4FFF4F4F4FFF8F8F8FF4068C9FF4676F2504777EE4B4B70CAFFEEF0F6FFF3F3
F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFEEF0
F6FF4B70CAFF4777EE4B4775EE3D6584D0FBD6DDEFFFF3F3F3FFF2F2F2FFF2F2
F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF3F3F3FFD6DDEFFF6584D0FB4775
EE3D487AEE2E7995D5F2B9C6E7FFF4F4F4FFF1F1F1FFF1F1F1FFF1F1F1FFF1F1
F1FFF1F1F1FFF1F1F1FFF4F4F4FFB9C6E7FF7995D5F2487AEE2E467BED1D8EA6
E1BE5778C9FFEFF1F3FFF1F1F1FFF0F0F0FFF0F0F0FFF0F0F0FFF0F0F0FFF1F1
F1FFEFF1F3FF5778C9FF8EA6E1BE467BED1D0000FF014678F042718DD0F37993
D1FFF0F1F3FFF0F0F0FFEFEFEFFFEFEFEFFFF0F0F0FFF0F1F3FF7993D1FF718D
D1F34678F0420000FF0100000000496DED0E5F86EA616583CBF76483CAFFEAEC
F1FFF0F0F0FFF0F0F0FFE9EBF1FF6483CAFF6584CBF75B86EC5F496DED0E0000
000000000000000000004070EF104C7BEF51718CCEF0496CC0FFC2CDE5FFC2CD
E5FF486CBFFF728DCFEF4C7BEF514070EF100000000000000000000000000000
0000000000004D80E60A4778F14888A1DBB95675C2FC5675C2FC89A0DEB74778
F1484D80E60A0000000000000000000000000000000000000000000000000000
00008080FF024476F3294777F14B4777F14B4979ED2A8080FF02000000000000
00000000000000000000
}
SelectedGlyph.Data = {
BA000000424DBA000000000000003600000028000000030000000B0000000100
20000000000084000000640000006400000000000000000000005778CAFF5879
CBFF5879CBFF5B82E2FF5B82E2FF5B82E2FF537CE0FF537CE0FF537CE0FF4B76
DFFF4B76DFFF4B76DFFF4470DDFF4470DDFF4470DDFF3C6ADBFF3C6ADBFF3C6A
DBFF3464D9FF3464D9FF3464D9FF2C5FD8FF2C5FD8FF2C5FD8FF2559D6FF2559
D6FF2559D6FF1D53D4FF1D53D4FF1D53D3FF0F3A9EFF0F3A9FFF103BA1FF
}
end
object RadioGroup2: TRadioGroup
AnchorSideLeft.Control = RadioGroup1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner
Left = 352
Height = 52
Top = 6
Width = 90
AutoFill = True
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Orientation'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 34
ClientWidth = 86
Items.Strings = (
'trHorizontal'
'trVertical'
)
OnClick = RadioGroup2Click
TabOrder = 2
end
end

View File

@@ -0,0 +1,434 @@
object Form1: TForm1
Left = 469
Height = 537
Top = 245
Width = 898
Caption = 'RxDBGrid demo - SelectedFont'
ClientHeight = 537
ClientWidth = 898
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 698
Height = 537
Top = 0
Width = 200
Align = alRight
ClientHeight = 537
ClientWidth = 200
TabOrder = 0
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = ColorBox1
AnchorSideTop.Side = asrBottom
Left = 7
Height = 20
Top = 105
Width = 87
BorderSpacing.Around = 6
Caption = 'Selected font'
ParentColor = False
end
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 7
Height = 24
Top = 7
Width = 97
BorderSpacing.Around = 6
Caption = 'Row select'
OnChange = CheckBox1Change
TabOrder = 0
end
object Label2: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideBottom.Control = SpinEdit1
AnchorSideBottom.Side = asrBottom
Left = 7
Height = 20
Top = 217
Width = 58
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 6
Caption = 'Font size'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = CheckBox1
AnchorSideTop.Side = asrBottom
Left = 7
Height = 20
Top = 37
Width = 93
BorderSpacing.Around = 6
Caption = 'Selected color'
ParentColor = False
end
object ColorBox1: TColorBox
AnchorSideLeft.Control = Label3
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 13
Height = 36
Top = 63
Width = 180
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeDefault, cbCustomColor, cbPrettyNames, cbCustomColors]
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ItemHeight = 0
OnChange = CheckBox1Change
TabOrder = 1
end
object Label4: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
Left = 7
Height = 20
Top = 131
Width = 68
BorderSpacing.Around = 6
Caption = 'Font name'
ParentColor = False
end
object EditButton1: TEditButton
AnchorSideLeft.Control = Label4
AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 13
Height = 37
Top = 157
Width = 180
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ButtonWidth = 23
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00E69B6266E69A61FFE5975EFFE2945BFFE3935AFFE3915733FFFF
FF00E38F5499E28D53FFE28C51FFE28A50FFE28A50FFE28A5099FFFFFF00FFFF
FF00FFFFFF00E79F6611E79C6477E8A573FFDB915FFEDC905DA9E5945B10FFFF
FF00E3915722E3905677E59A68FFEAAD83FFE4945EFFE28A5044FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00E79E6666E5A575FFDD9868FFDA905E2DFFFF
FF00FFFFFF00FFFFFF00E39057FFE9A77AFFE28D54CCFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E7A16888E1A579FFDC9462F5DB91
61BDDA905EBDD88D5BBDDF9A6CFFE9A779FFE39056BBFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E9A36A11E6A169E3E3AA80FFDC95
64ADDB946203FFFFFF00E5975DFFE9A676FFE3935A99FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E9A56D33E5A472FFDF9B
68FAE59C6653E79C6477E9A673FFE8A572FFE5955D77FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00419149E539853FFF317A37FF2A702FFF86864AFBE4AA
7CFFDF9C69D1E7A16879EAAA79FFE9A876FFE69A6177FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00419149F99BD2A2FF95D09DFF2A702FF8E7A6
70DBE2A16DF9E29F6ABAEDB487FFE9A672FFE79C6444FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF0051A75A8A71B67AFFA6D8ADFF9ED3A5FF317A37FCEAAA
7322E5A670FAE3A26FFCEEBC95FFEAA975FFE7A16844FFFFFF00DB7423DDD970
1EFFD86B1BCC84A052CA80C588FFB0DCB6FF75B87CFF419149F539853FFBE5A9
76E7E5A874F4EABB92FFE9BA93FFE7B489FFE09E6CE8FFFFFF00E49555FFDB77
25EEDB701F778CA453F288CB90FF83C68BFF619F52BF499C5203419149E1E6AC
788AE5AA7791E7A976D4E6A974E2E5A671E2E2A27094FFFFFF00E18E42FFDF7E
2EEEDB792733DB74235592AA5DFF85A151F958B16203FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E28B3A55DF85
35DDE18C41FFDD7B2ACCE7A36CFFDE813AFFD86C1B44FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E2904022E28D
3CBBE1873977DF843177DF7E2ECCE49859FFDB742388FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E6954722E698
4EFFE28E40DDE28B3A11DF853588E69F60FFDD7B2ABBFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E697
4755E49445DDE39344FFE69A52FFE28E43FFDF843188FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
MaxLength = 0
NumGlyphs = 1
OnButtonClick = EditButton1ButtonClick
PasswordChar = #0
Spacing = 0
TabOrder = 2
Text = 'EditButton1'
end
object SpinEdit1: TSpinEdit
AnchorSideLeft.Control = Label2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = EditButton1
AnchorSideTop.Side = asrBottom
Left = 71
Height = 37
Top = 200
Width = 89
BorderSpacing.Around = 6
OnChange = CheckBox1Change
TabOrder = 3
Value = 1
end
object CheckBox2: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = SpinEdit1
AnchorSideTop.Side = asrBottom
Left = 7
Height = 24
Top = 243
Width = 55
BorderSpacing.Around = 6
Caption = 'Bold'
OnChange = CheckBox1Change
TabOrder = 4
end
object CheckBox3: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = CheckBox2
AnchorSideTop.Side = asrBottom
Left = 7
Height = 24
Top = 273
Width = 56
BorderSpacing.Around = 6
Caption = 'Italic'
TabOrder = 5
end
object CheckBox4: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = CheckBox3
AnchorSideTop.Side = asrBottom
Left = 7
Height = 24
Top = 303
Width = 88
BorderSpacing.Around = 6
Caption = 'Underline'
TabOrder = 6
end
object CheckBox5: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = CheckBox4
AnchorSideTop.Side = asrBottom
Left = 7
Height = 24
Top = 333
Width = 87
BorderSpacing.Around = 6
Caption = 'StrikeOut'
OnChange = CheckBox1Change
TabOrder = 7
end
object Label5: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = CheckBox5
AnchorSideTop.Side = asrBottom
Left = 7
Height = 20
Top = 363
Width = 65
BorderSpacing.Around = 6
Caption = 'Font color'
ParentColor = False
end
object ColorBox2: TColorBox
AnchorSideLeft.Control = Label3
AnchorSideTop.Control = Label5
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 13
Height = 36
Top = 389
Width = 180
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeDefault, cbCustomColor, cbPrettyNames, cbCustomColors]
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ItemHeight = 0
OnChange = CheckBox1Change
TabOrder = 8
end
end
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 537
Top = 0
Width = 698
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID'
Width = 60
FieldName = 'ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Caption'
Width = 450
FieldName = 'Caption'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'EditDate'
Width = 150
FieldName = 'EditDate'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.DrawFullLine = False
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter]
Align = alClient
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = dsData
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
TabOrder = 1
end
object rxData: TRxMemoryData
FieldDefs = <
item
Name = 'ID'
DataType = ftInteger
end
item
Name = 'Caption'
DataType = ftString
Size = 250
end
item
Name = 'EditDate'
DataType = ftDateTime
end>
PacketRecords = 0
Left = 224
Top = 80
object rxDataID: TLongintField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataCaption: TStringField
FieldKind = fkData
FieldName = 'Caption'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 250
end
object rxDataEditDate: TDateTimeField
FieldKind = fkData
FieldName = 'EditDate'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
end
object dsData: TDataSource
DataSet = rxData
Left = 184
Top = 80
end
object FontDialog1: TFontDialog
Width = 459
Height = 359
MinFontSize = 0
MaxFontSize = 0
Left = 784
Top = 136
end
end

View File

@@ -0,0 +1,202 @@
object Form1: TForm1
Left = 369
Height = 500
Top = 228
Width = 536
ActiveControl = RadioGroup1.RadioButton4
Caption = 'Form1'
ClientHeight = 500
ClientWidth = 536
OnCreate = FormCreate
SessionProperties = 'Edit1.Text'
LCLVersion = '1.7'
object PaintBox1: TPaintBox
Left = 16
Height = 129
Top = 16
Width = 184
OnPaint = PaintBox1Paint
end
object Edit1: TEdit
Left = 8
Height = 37
Top = 152
Width = 192
OnChange = Edit1Change
TabOrder = 0
Text = 'Edit1'
end
object RadioGroup1: TRadioGroup
Left = 208
Height = 153
Top = 8
Width = 78
AutoFill = True
AutoSize = True
Caption = 'Direction'
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 = 132
ClientWidth = 76
ItemIndex = 4
Items.Strings = (
'0 %'
'90 %'
'180 %'
'270 %'
'360 %'
)
OnClick = CheckBox1Change
TabOrder = 1
end
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 308
Top = 192
Width = 536
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = False
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'DEMO_1'
FieldName = 'DEMO_1'
EditButtons = <>
Filter.IsNull = False
Filter.IsAll = True
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.DrawFullLine = False
OptionsRx = []
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = Datasource1
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
ParentColor = False
TabOrder = 2
TitleStyle = tsNative
end
object RxMemoryData1: TRxMemoryData
AutoCalcFields = False
FieldDefs = <
item
Name = 'DEMO_1'
DataType = ftInteger
Precision = -1
end
item
Name = 'Demo2'
DataType = ftString
Precision = -1
Size = 40
end>
PacketRecords = 0
left = 312
top = 64
object RxMemoryData1DEMO_11: TLongintField
DisplayWidth = 10
FieldKind = fkData
FieldName = 'DEMO_1'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object RxMemoryData1Demo21: TStringField
DisplayWidth = 40
FieldKind = fkData
FieldName = 'Demo2'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 40
end
end
object Datasource1: TDataSource
DataSet = RxMemoryData1
left = 312
top = 32
end
object IniPropStorage1: TIniPropStorage
StoredValues = <>
left = 447
top = 19
end
end

View File

@@ -0,0 +1,120 @@
{ RxStrUtils unit
Copyright (C) 2005-2017 Lagunov Aleksey alexs@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 rxutils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
procedure SwapValues (var X, Y : Byte); inline; overload;
procedure SwapValues (var X, Y : Word); inline; overload;
procedure SwapValues (var X, Y : Integer); inline; overload;
//procedure SwapValues (var X, Y : Longint); inline; overload;
procedure SwapValues (var X, Y : Cardinal); inline; overload;
procedure SwapValues (var X, Y : QWord); inline; overload;
procedure SwapValues (var X, Y : Int64); inline; overload;
{procedure Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_word];
function swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_long];
function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_long];
function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_qword];
function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_swap_qword];
}
implementation
procedure SwapValues(var X, Y: Byte);
var
T: Byte;
begin
T:=X;
X:=Y;
Y:=T;
end;
procedure SwapValues(var X, Y: Word);
var
T: Word;
begin
T:=X;
X:=Y;
Y:=T;
end;
procedure SwapValues(var X, Y: Integer);
var
T: Integer;
begin
T:=X;
X:=Y;
Y:=T;
end;
{
procedure SwapValues(var X, Y: Longint);
var
T: LongInt;
begin
T:=X;
X:=Y;
Y:=T;
end;
}
procedure SwapValues(var X, Y: Cardinal);
var
T: Cardinal;
begin
T:=X;
X:=Y;
Y:=T;
end;
procedure SwapValues(var X, Y: QWord);
var
T: QWord;
begin
T:=X;
X:=Y;
Y:=T;
end;
procedure SwapValues(var X, Y: Int64);
var
T: Int64;
begin
T:=X;
X:=Y;
Y:=T;
end;
end.

View File

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

View File

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

View File

@@ -0,0 +1,15 @@
program project1;
{$mode objfpc}{$H+}
uses
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, Unit1, rxnew;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EDatabaseError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

View File

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

View File

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

View File

@@ -0,0 +1,17 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>
<description>Your application description here.</description>
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>
</dependentAssembly>
</dependency>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
<security>
<requestedPrivileges>
<requestedExecutionLevel level="asInvoker" uiAccess="false"/>
</requestedPrivileges>
</security>
</trustInfo>
</assembly>

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<fpdoc-descriptions>
<package name="rxnew">
<module name="rxdice">
<element name="TRxDice">
<short>Компонента позволяющая вам использовать в формах изображения игральных костей в различных положениях.</short>
<descr>
<p>Компонента из числа "безделушек", позволяющая вам использовать в формах изображения игральных костей в различных положениях. </p>
<p>Текущее состояние компоненты (положение игральной кости) задается свойством <link id="TRxDice.Value">Value</link>, которое может изменяться от 1 до 6. Вы можете установить свойство <link id="TRxDice.Value">Value</link> в случайное значение, вызвав метод <link id="TRxDice.RandomValue">RandomValue</link>. Если вы установите свойство <link id="TRxDice.Rotate">Rotate</link> в значение True, изображение игральной кости начнет случайным образом "вращаться", изменяя значение <link id="TRxDice.Value">Value</link>, с частотой, задаваемой свойством <link id="TRxDice.Interval">Interval</link>. Остановить вращение можно, присвоив значение False свойству <printshort id="TRxDice.Rotate"/>. Если свойство <link id="TRxDice.AutoStopInterval">AutoStopInterval</link> отлично от 0, то по прошествии этого времени вращение будет остановлено автоматически. </p>
<p>При изменении значения Value происходит событие OnChange.</p>
</descr>
</element>
<element name="TRxDice.Create"/>
<element name="TRxDice.Destroy"/>
<element name="TRxDice.RandomValue">
<short>procedure RandomValue;</short>
<descr>Вызов метода RandomValue позволяет установить значение свойства Value компоненты TrxDice случайным образом (в диапазоне целых чисел от 1 до 6).</descr>
</element>
<element name="TRxDice.Align"/>
<element name="TRxDice.AutoSize"/>
<element name="TRxDice.AutoStopInterval">
<short>Свойство задает интервал (в мсек), по прошествии которого после установки свойства Rotate в значение True вращение игральной кости будет остановлено</short>
<descr>
<p>Свойство задает интервал (в мсек), по прошествии которого после установки свойства <link id="TRxDice.Rotate">Rotate</link> в значение True вращение игральной кости будет остановлено. </p>
<p>Если значение AutoStopInterval = 0, то вращение автоматически не останавливается и может быть прекращено присваиванием <link id="TRxDice.Rotate">Rotate</link> = False.</p>
</descr>
</element>
<element name="TRxDice.Color"/>
<element name="TRxDice.Cursor"/>
<element name="TRxDice.DragMode"/>
<element name="TRxDice.DragCursor"/>
<element name="TRxDice.Enabled"/>
<element name="TRxDice.Interval">
<short>Свойство определяет временной интервал (в милисекундах), с которым происходит смена изображений в компоненте.</short>
<descr>
<p>Свойство определяет временной интервал (в милисекундах), с которым происходит смена изображений в компоненте. </p>
<p>при <link id="TRxDice.Rotate">Rotate</link> = True это частота смены битовых изображений.</p>
</descr>
<seealso>
<link id="TRxDice.Rotate"/>
</seealso>
</element>
<element name="TRxDice.ParentColor"/>
<element name="TRxDice.ParentShowHint"/>
<element name="TRxDice.PopupMenu"/>
<element name="TRxDice.Rotate">
<short>property Rotate: Boolean;</short>
<descr>Если вы установите свойство Rotate в значение True, изображение игральной кости начнет случайным образом "вращаться", изменяя значение Value, с частотой, задаваемой свойством Interval. Остановить вращение можно, присвоив свойству Rotate значение False.</descr>
</element>
<element name="TRxDice.ShowFocus"/>
<element name="TRxDice.ShowHint"/>
<element name="TRxDice.Anchors"/>
<element name="TRxDice.Constraints"/>
<element name="TRxDice.DragKind"/>
<element name="TRxDice.TabOrder"/>
<element name="TRxDice.TabStop"/>
<element name="TRxDice.Value">
<short>property Value: TrxDiceValue;</short>
<descr>Свойство задает текущее состояние (положение игральной кости) для компоненты TRxDice.</descr>
</element>
<element name="TRxDice.Visible"/>
<element name="TRxDice.OnClick"/>
<element name="TRxDice.OnDblClick"/>
<element name="TRxDice.OnEnter"/>
<element name="TRxDice.OnExit"/>
<element name="TRxDice.OnMouseMove"/>
<element name="TRxDice.OnMouseDown"/>
<element name="TRxDice.OnMouseUp"/>
<element name="TRxDice.OnKeyDown"/>
<element name="TRxDice.OnKeyUp"/>
<element name="TRxDice.OnKeyPress"/>
<element name="TRxDice.OnDragOver"/>
<element name="TRxDice.OnDragDrop"/>
<element name="TRxDice.OnEndDrag"/>
<element name="TRxDice.OnStartDrag"/>
<element name="TRxDice.OnContextPopup"/>
<element name="TRxDice.OnChange"/>
<element name="TRxDice.OnStart"/>
<element name="TRxDice.OnStop"/>
<element name="TRxDice.OnEndDock"/>
<element name="TRxDice.OnStartDock"/>
</module>
</package>
</fpdoc-descriptions>

View File

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

View File

@@ -0,0 +1,272 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="16">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<UsageCount Value="28"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="45"/>
<CursorPos X="26" Y="58"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../rxhistorynavigator.pas"/>
<UnitName Value="RxHistoryNavigator"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="179"/>
<CursorPos X="3" Y="181"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="/home/alexs/install/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="102"/>
<CursorPos X="55" Y="120"/>
<UsageCount Value="12"/>
</Unit3>
<Unit4>
<Filename Value="/home/alexs/work/makosh/trunk/MakoshShared/system/makoshnavigateobjectunit.pas"/>
<UnitName Value="makoshNavigateObjectUnit"/>
<WindowIndex Value="0"/>
<TopLine Value="37"/>
<CursorPos X="1" Y="38"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="../../../../lcl/actnlist.pas"/>
<UnitName Value="ActnList"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="14" Y="22"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="../../rxtoolbar.pas"/>
<UnitName Value="rxtoolbar"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="31"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../../../lcl/include/control.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1398"/>
<CursorPos X="1" Y="1416"/>
<UsageCount Value="10"/>
</Unit7>
<Unit8>
<Filename Value="../../../../lcl/include/customaction.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="104"/>
<CursorPos X="1" Y="134"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<Filename Value="../../../../lcl/include/controlactionlink.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="31"/>
<CursorPos X="1" Y="50"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="../../../../lcl/include/actionlink.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="3"/>
<CursorPos X="1" Y="33"/>
<UsageCount Value="10"/>
</Unit10>
<Unit11>
<Filename Value="../../registerrxdb.pas"/>
<UnitName Value="RegisterRxDB"/>
<WindowIndex Value="0"/>
<TopLine Value="45"/>
<CursorPos X="47" Y="62"/>
<UsageCount Value="10"/>
</Unit11>
<Unit12>
<Filename Value="../../../../ideintf/dbpropedits.pas"/>
<UnitName Value="DBPropEdits"/>
<WindowIndex Value="0"/>
<TopLine Value="115"/>
<CursorPos X="1" Y="146"/>
<UsageCount Value="10"/>
</Unit12>
<Unit13>
<Filename Value="../../../../ideintf/propedits.pp"/>
<UnitName Value="PropEdits"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="15" Y="26"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="../../registerrx.pas"/>
<UnitName Value="registerrx"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="65"/>
<CursorPos X="1" Y="84"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit14>
<Unit15>
<Filename Value="../../rxconst.pas"/>
<UnitName Value="rxconst"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="89"/>
<CursorPos X="1" Y="119"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit15>
</Units>
<General>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="../../rxtoolbar.pas"/>
<Caret Line="35" Column="1" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="4" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="32" Column="6" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="3" Column="26" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="241" Column="1" TopLine="223"/>
</Position5>
<Position6>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="272" Column="1" TopLine="254"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="57" Column="6" TopLine="39"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="56" Column="26" TopLine="39"/>
</Position8>
<Position9>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="387" Column="13" TopLine="367"/>
</Position9>
<Position10>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="103" Column="89" TopLine="77"/>
</Position10>
<Position11>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="104" Column="76" TopLine="86"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="49" Column="7" TopLine="38"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="51" Column="7" TopLine="40"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="72" Column="7" TopLine="46"/>
</Position14>
<Position15>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="333" Column="26" TopLine="324"/>
</Position15>
<Position16>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="338" Column="1" TopLine="324"/>
</Position16>
<Position17>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="98" Column="1" TopLine="90"/>
</Position17>
<Position18>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="160" Column="1" TopLine="126"/>
</Position18>
<Position19>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="110" Column="25" TopLine="94"/>
</Position19>
<Position20>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="122" Column="15" TopLine="100"/>
</Position20>
<Position21>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="185" Column="1" TopLine="156"/>
</Position21>
<Position22>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="113" Column="1" TopLine="99"/>
</Position22>
<Position23>
<Filename Value="../../registerrx.pas"/>
<Caret Line="55" Column="7" TopLine="54"/>
</Position23>
<Position24>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="109" Column="14" TopLine="100"/>
</Position24>
<Position25>
<Filename Value="../../registerrx.pas"/>
<Caret Line="128" Column="1" TopLine="92"/>
</Position25>
<Position26>
<Filename Value="../../registerrx.pas"/>
<Caret Line="118" Column="36" TopLine="100"/>
</Position26>
<Position27>
<Filename Value="../../registerrx.pas"/>
<Caret Line="120" Column="29" TopLine="102"/>
</Position27>
<Position28>
<Filename Value="../../registerrx.pas"/>
<Caret Line="122" Column="31" TopLine="104"/>
</Position28>
<Position29>
<Filename Value="unit1.pas"/>
<Caret Line="58" Column="26" TopLine="45"/>
</Position29>
<Position30>
<Filename Value="../../rxhistorynavigator.pas"/>
<Caret Line="378" Column="10" TopLine="358"/>
</Position30>
</JumpHistory>
</ProjectSession>
</CONFIG>

View File

@@ -0,0 +1,35 @@
/* XPM */
static char *TRxDbLookupList[]={
"24 24 8 1",
". c None",
"# c #000000",
"c c #000080",
"e c #800000",
"f c #808080",
"d c #c0c0c0",
"b c #ff0000",
"a c #ffffff",
"..##....................",
".#aa#b.........c........",
"#daaa#b.......cc........",
"#ddaaa#......ccccccc....",
".#ddaaa##.....cc....c...",
"..#ddaaaa###...c....c...",
"...#ddaabbbb#.......c...",
"....#ddebbb#........c...",
"..c.#feeeb#d###########.",
"..c..#eef#aaaaaaaa#aad#.",
"..c..#ef#dcccccaaa#a#d#.",
"..c..#e#aaaaaaaaaa#ddd#.",
"..c...#daaccccccaa#####.",
"..c....#aaaaaaaaaa#ddd#.",
"..c....#accccccaaa#ddd#.",
"..c.c..#cccccccccc#ddd#.",
"..c.cc.#caaaaaaacc#ddd#.",
"...cccc#cccccccccc#ddd#.",
"....cc.#accccccaaa#####.",
"....c..#aaaaaaaaaa#add#.",
".......#acccccccaa#a#d#.",
".......#aaaaaaaaaa#ddd#.",
".......################.",
"........................"};

View File

@@ -0,0 +1,71 @@
/* XPM */
static char *DICE3[]={
"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####.........................",
"...........................##########...........................",
"..............................####..............................",
"................................................................"};

View File

@@ -0,0 +1,20 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, rxnew, Unit2, Unit3, Unit4;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 334 B

View File

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

View File

@@ -0,0 +1,186 @@
object Form1: TForm1
Left = 697
Height = 391
Top = 481
Width = 441
Caption = 'Form1'
ClientHeight = 391
ClientWidth = 441
OnCreate = FormCreate
LCLVersion = '1.7'
object Button1: TButton
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 335
Height = 23
Top = 6
Width = 100
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Get information'
OnClick = Button1Click
TabOrder = 0
end
object Edit1: TEdit
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
Height = 21
Top = 54
Width = 423
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
Color = clSkyBlue
ReadOnly = True
TabOrder = 1
end
object Edit2: TEdit
AnchorSideLeft.Control = Label2
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
Height = 21
Top = 100
Width = 423
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
Color = clSkyBlue
ReadOnly = True
TabOrder = 2
end
object Edit3: TEdit
AnchorSideLeft.Control = Label4
AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 10
Height = 21
Top = 211
Width = 425
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
Color = clSkyBlue
ReadOnly = True
TabOrder = 3
end
object Edit4: TEdit
AnchorSideLeft.Control = Label5
AnchorSideTop.Control = Label5
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
Height = 21
Top = 257
Width = 423
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
Color = clSkyBlue
ReadOnly = True
TabOrder = 4
end
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Button1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 13
Top = 35
Width = 188
BorderSpacing.Around = 6
Caption = 'User name (from environment variable)'
ParentColor = False
end
object Label2: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Edit1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 13
Top = 81
Width = 59
BorderSpacing.Around = 6
Caption = 'User domain'
ParentColor = False
end
object Label3: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = DividerBevel1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 13
Top = 146
Width = 40
BorderSpacing.Around = 6
Caption = 'File info:'
ParentColor = False
end
object DividerBevel1: TDividerBevel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Edit2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 0
Height = 13
Top = 127
Width = 441
Caption = 'File owner'
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
BorderSpacing.Bottom = 6
Font.Style = [fsBold]
ParentFont = False
end
object FileNameEdit1: TFileNameEdit
AnchorSideLeft.Control = Label3
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
Height = 21
Top = 165
Width = 423
FilterIndex = 0
HideDirectories = False
ButtonWidth = 23
NumGlyphs = 1
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
MaxLength = 0
Spacing = 0
TabOrder = 5
end
object Label4: TLabel
AnchorSideTop.Control = FileNameEdit1
AnchorSideTop.Side = asrBottom
Left = 4
Height = 13
Top = 192
Width = 61
BorderSpacing.Around = 6
Caption = 'Owner name'
ParentColor = False
end
object Label5: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Edit3
AnchorSideTop.Side = asrBottom
Left = 6
Height = 13
Top = 238
Width = 69
BorderSpacing.Around = 6
Caption = 'Owner domain'
ParentColor = False
end
end

View File

@@ -0,0 +1,770 @@
msgid ""
msgstr ""
"Content-Type: text/plain; charset=UTF-8\n"
"Project-Id-Version: \n"
"POT-Creation-Date: \n"
"PO-Revision-Date: \n"
"Last-Translator: \n"
"Language-Team: \n"
"MIME-Version: 1.0\n"
"Content-Transfer-Encoding: 8bit\n"
"X-Generator: Poedit 1.5.4\n"
#: rxdconst.sallvalues
msgid "All values"
msgstr ""
#: rxdconst.sapptitlelabel
msgid "Application \"%s\""
msgstr "Програма \"%s\""
#: rxdconst.sascending
msgid "Ascending"
msgstr ""
#: rxdconst.sblobtext
msgid "(blob)"
msgstr ""
#: rxdconst.sbottomcaption
msgid "Bottom"
msgstr "Вниз"
#: rxdconst.sbrowsedata
msgid "browse"
msgstr "перегляд"
#: rxdconst.scalcfieldsdata
msgid "calc"
msgstr "обчислення"
#: rxdconst.scapturefilter
msgid "Control locked by filter"
msgstr "Елементи управління захоплені фільтром"
#: rxdconst.schangepassword
msgid "Change password"
msgstr "Змінити пароль"
#: rxdconst.scirculardatalink
msgid "Circular data link"
msgstr "Перехресне посилання даних"
#: rxdconst.sclearfilter
#, fuzzy
msgctxt "rxdconst.sclearfilter"
msgid "Clear filter"
msgstr "Очистити фільтр"
#: rxdconst.scollumnname
msgid "Column name"
msgstr "Назва стовпця"
#: rxdconst.scompressfonts
msgid "Compress fonts"
msgstr "Ущільнені шрифти"
#: rxdconst.scompressimages
msgid "Compress images"
msgstr "Ущільнені зображення"
#: rxdconst.scompresstext
msgid "Compress text"
msgstr "Ущільнений текс"
#: rxdconst.sconfirmpasswordlabel
msgid "&Confirm:"
msgstr "&Підтвердження:"
#: rxdconst.sconfirmsave
msgid "Data changed. Save?"
msgstr "Дані були змінені. Зберегти?"
#: rxdconst.sdatabasename
msgid "Database locked: %s"
msgstr "База даних блокована: %s"
#: rxdconst.sdbcomboboxfieldnotassigned
msgid "%s:TDBComboBox - DataField not assigned"
msgstr "%s:TDBComboBox - Не присвоєно властивість DataField"
#: rxdconst.sdbexceptcaption
msgid "Error in DB engine"
msgstr "Помилка ядра БД"
#: rxdconst.sdeletemultiplerecords
msgid "Delete all selected records?"
msgstr "Видалити всі виділені записи"
#: rxdconst.sdeleterecordquestion
msgid "Delete record?"
msgstr "Видалити запис"
#: rxdconst.sdescending
#, fuzzy
msgctxt "rxdconst.sdescending"
msgid "Descending"
msgstr "За зменшенням"
#: rxdconst.seditdata
msgid "editing"
msgstr "Редагування"
#: rxdconst.semptyvalues
msgid "Empty values"
msgstr ""
#: rxdconst.serrormsglabel
msgid "Error message"
msgstr "Повідомлення про помилку"
#: rxdconst.sexportcellcolors
msgid "Export cell colors"
msgstr "Експортувати колір стовпців"
#: rxdconst.sexportcolumnfooter
msgid "Export column footer"
msgstr "Експортувати підсумки стовпців"
#: rxdconst.sexportcolumnheader
msgid "Export column header"
msgstr "Експортувати заголовки стовпців"
#: rxdconst.sexportfilename
msgid "Export file name"
msgstr "Експортувати назву файлу"
#: rxdconst.sexportformula
msgid "Export footer formula"
msgstr "Експортувати підсумкову формулу"
#: rxdconst.sexportgroupdata
msgid "Export group data"
msgstr ""
#: rxdconst.sexporthidezerovalues
#, fuzzy
msgctxt "rxdconst.sexporthidezerovalues"
msgid "Hide zero values"
msgstr "Ховати нульові значення"
#: rxdconst.sexportimages
msgid "Export images"
msgstr "Експортувати зображення"
#: rxdconst.sexportparams
msgid "Export params"
msgstr "Експортувати параметри"
#: rxdconst.sexportselectedrows
msgid "Export only selected rows"
msgstr ""
# msgid "Compare opertion need fielad and const"
#: rxdconst.sexprbadcompare
msgid "Compare opertion needs field and const"
msgstr "Операції порівняння вимагають наявності поля і константи"
#: rxdconst.sexprbadfield
msgid "Field '%s' not used in filter expression"
msgstr "Поле '%s' не може бути використане в виразі фільтрації"
#: rxdconst.sexprbadnulltest
msgid "NULL-values enabled in '=' and '<>'"
msgstr "NULL-значення дозволені тільки у виразах '=' і '<>'"
#: rxdconst.sexprexpected
msgid "Error %s"
msgstr "Очікували вираз, а зустріли %s"
#: rxdconst.sexprincorrect
msgid "Error in filter expression"
msgstr "Помилка у виразі фільтра"
#: rxdconst.sexprinvalidchar
msgid "Error symbol in expression: '%s'"
msgstr "Помилковий символ у виразі: '%s'"
#: rxdconst.sexprnameerror
msgid "Error in filed name"
msgstr "Помилка в імені поля"
#: rxdconst.sexprnorparen
msgid "Error ')', error: %s"
msgstr "Очікували ')', а зустріли: %s"
#: rxdconst.sexprnotboolean
msgid "Field '%s' is not boolean"
msgstr "Поле '%s' не логічного типу"
#: rxdconst.sexprstringerror
msgid "Error in string const"
msgstr "Помилка в строковій константі"
#: rxdconst.sexprtermination
msgid "Error in filter end"
msgstr "Помилка в закінченні виразу фільтра"
#: rxdconst.sfieldreadonly
msgid "SFieldReadOnly %s"
msgstr "Поле %s лише для читання"
#: rxdconst.sfieldrequired
msgid "Field '%s' must have a value"
msgstr "Поле '%s' очікує значення"
#: rxdconst.sfieldtypemismatch
msgid "Type mismatch for field '%s', expecting: %s actual: %s"
msgstr "Неспівпадіння типів для стовпця '%s', необхідно: %s введено: %s"
#: rxdconst.sfooterrowcolor
msgid "Footer row color"
msgstr "Колір підсумкового рядка"
#: rxdconst.sfunction
msgid "Function"
msgstr "Функція"
#: rxdconst.sfvtavg
msgid "AVG"
msgstr "Середнє"
#: rxdconst.sfvtcount
msgid "Count"
msgstr "Кількість"
#: rxdconst.sfvtfieldvalue
msgid "Field value"
msgstr "Значення поля"
#: rxdconst.sfvtmax
msgid "Max value"
msgstr "Максимальне значення"
#: rxdconst.sfvtmin
msgid "Min value"
msgstr "Мінімальне значення"
#: rxdconst.sfvtnon
msgid "None"
msgstr "Без"
#: rxdconst.sfvtrecno
msgid "Record no"
msgstr "Номер запису"
#: rxdconst.sfvtstatictext
msgid "Static text"
msgstr "Статичний текст"
#: rxdconst.sfvtsum
msgid "Sum"
msgstr "Сума"
#: rxdconst.sglobal
msgid "Global"
msgstr "Загальний"
#: rxdconst.shidezerovalues
msgctxt "rxdconst.shidezerovalues"
msgid "Hide zero values"
msgstr "Ховати нульові значення"
#: rxdconst.shinthideonlycurrentitem
msgid "Hide only current item"
msgstr ""
#: rxdconst.shintlabel
msgid "Enter your user name and password"
msgstr "Введіть ваші ім'я користувача та пароль"
#: rxdconst.shintshowonlycurrentitem
msgid "Show only current item"
msgstr ""
#: rxdconst.sinactivedata
msgid "inactive"
msgstr "бездіяльний"
#: rxdconst.sinsertdata
msgid "append"
msgstr "вставка"
#: rxdconst.sinvaliddate
msgid "Invalid Date"
msgstr "Помилкова дата"
#: rxdconst.sinvalidfields
msgid "No fields defined"
msgstr "Немає оголошення полів"
#: rxdconst.sinvalidusername
msgid "User name or password is not valid"
msgstr "Помилка в імені користувача або паролі"
#: rxdconst.slandscape
msgid "Landscape"
msgstr "Ландшафт"
#: rxdconst.sleftcaption
msgid "Left"
msgstr "Вліво"
#: rxdconst.slocaldatabase
msgid "Unable complete this operation on local dataset"
msgstr "Неможливо провести цю операцію з локальною базою даних"
#: rxdconst.smemnorecords
msgid "No data found"
msgstr "Даних не знайдено"
#: rxdconst.smergecells
msgid "Merge cell's"
msgstr ""
#: rxdconst.smore1
msgid "&More >>"
msgstr "&Більше >>"
#: rxdconst.smore2
msgid "&Less <<"
msgstr "&Менше <<"
#: rxdconst.snewpasswordlabel
msgid "&New password:"
msgstr "&Новий пароль:"
#: rxdconst.snextbutton
msgid "&Next"
msgstr "&Далі"
#: rxdconst.snotcapturefilter
msgid "Control needs to be locked by filter"
msgstr "Елементи управління повинні бути захоплені фільтром"
#: rxdconst.snotediting
msgid "Dataset not in edit or insert mode"
msgstr "Набір даних не в режимі редагування або вставки"
#: rxdconst.snotempty
msgid "Not empty"
msgstr ""
#: rxdconst.soldpasswordlabel
msgid "&Old password:"
msgstr "&Старий пароль"
#: rxdconst.sopenafterexport
msgid "Open after export"
msgstr "Відкрити після експортування"
#: rxdconst.sorientation
msgid "Orientation"
msgstr "Орієнтація"
#: rxdconst.sotheroptions
msgid "Other options"
msgstr "Інші налаштування"
#: rxdconst.soutline
msgid "Out line"
msgstr "Поза межами"
#: rxdconst.soverwriteexisting
msgid "Overwrite existing"
msgstr "Переписати існуючий"
#: rxdconst.spagemargins
msgid "Page margins"
msgstr "Межі сторінки"
#: rxdconst.spagename
msgid "Page name"
msgstr "Назва сторінки"
#: rxdconst.spapertype
msgid "Paper type"
msgstr "Тип листка"
#: rxdconst.spasswordchanged
msgid "Password changed"
msgstr "Пароль змінено"
#: rxdconst.spasswordlabel
msgid "&Password:"
msgstr "&Пароль:"
#: rxdconst.spasswordnotchanged
msgid "Password not changed"
msgstr "Пароль не змінено"
#: rxdconst.spasswordsmismatch
msgid "New password and confirmation not equal"
msgstr "Новий пароль і підтвердження не співпадають"
#: rxdconst.spdfoptions
msgid "PDF options"
msgstr "PDF налаштування"
#: rxdconst.sportrait
msgid "Portrait"
msgstr "Книжна"
#: rxdconst.sprevbutton
msgid "&Prior"
msgstr "&Попередній"
#: rxdconst.sprintgrid
msgid "Print grid"
msgstr "Друк таблиці"
#: rxdconst.sprintoptions
msgid "Print options"
msgstr "Налаштування друку"
#: rxdconst.squickfilter
msgid "Quick filter"
msgstr ""
#: rxdconst.sregistration
msgid "Register"
msgstr "Реєстрація"
#: rxdconst.sreporttitle
msgid "Report title"
msgstr "Заголовок звіту"
#: rxdconst.sretrylogin
msgid "Retry to connect with database?"
msgstr "Ви хочете повторити спробу з'єднання з базою даних?"
#: rxdconst.srightcaption
msgid "Right"
msgstr "Вправо"
#: rxdconst.srxallfields
msgid "All fields"
msgstr "Усі поля"
#: rxdconst.srxascendign
msgid "Ascendign"
msgstr "По зростанню"
#: rxdconst.srxborrowstructure
msgid "Borrow structure..."
msgstr "Огляд структури ..."
#: rxdconst.srxcopyonlymetadata
msgid "Copy only metadata"
msgstr "Копіювати тільки метадані ..."
#: rxdconst.srxdbgridallfilter
msgid "(All values)"
msgstr "(Усі значення)"
#: rxdconst.srxdbgridcopycellvalue
msgid "Copy cell value"
msgstr "Копіювати значення комірки"
#: rxdconst.srxdbgridemptyfilter
#, fuzzy
msgctxt "rxdconst.srxdbgridemptyfilter"
msgid "(Empty)"
msgstr "(Немає)"
#: rxdconst.srxdbgridfilter
msgid "Filter data"
msgstr "Фільтр даних"
#: rxdconst.srxdbgridfilterclear
msgctxt "rxdconst.srxdbgridfilterclear"
msgid "Clear filter"
msgstr "Очистити фільтр"
#: rxdconst.srxdbgridfiltersimple
msgid "Filter in table"
msgstr "Фільтр в таблиці"
#: rxdconst.srxdbgridfind
msgctxt "rxdconst.srxdbgridfind"
msgid "Find data"
msgstr "Пошук даних"
#: rxdconst.srxdbgridfindcaption
msgctxt "rxdconst.srxdbgridfindcaption"
msgid "Find data"
msgstr "Пошук даних"
#: rxdconst.srxdbgridfindcasesens
msgid "Case sensetive"
msgstr "Регістрозалежно"
#: rxdconst.srxdbgridfinddirecion
msgid "Direction"
msgstr "Напрямок"
#: rxdconst.srxdbgridfindonfield
msgid "Find on field"
msgstr "Шукати по полю"
#: rxdconst.srxdbgridfindpartial
msgid "Partial key"
msgstr "Пошук по входженню"
#: rxdconst.srxdbgridfindrangeall
msgid "All"
msgstr "Всі"
#: rxdconst.srxdbgridfindrangeback
msgid "Backward"
msgstr "Назад"
#: rxdconst.srxdbgridfindrangeforw
msgid "Forward"
msgstr "Вперед"
#: rxdconst.srxdbgridfindtext
msgid "Text to find"
msgstr "Текст для пошуку"
#: rxdconst.srxdbgridnotemptyfilter
msgid "(Not empty)"
msgstr ""
#: rxdconst.srxdbgridoptimizecolwidth
msgid "Optimize column width"
msgstr "Оптимізувати ширину колонок"
#: rxdconst.srxdbgridselapplycaption
msgctxt "rxdconst.srxdbgridselapplycaption"
msgid "Apply"
msgstr "Застосувати"
#: rxdconst.srxdbgridselapplyhint
msgid "Apply current column settings"
msgstr "Застосувати налаштування поточного стовпця"
#: rxdconst.srxdbgridselcolcaption
msgid "Grid columns"
msgstr "Поля таблиці"
#: rxdconst.srxdbgridselcolhint1
msgid "Move selected column up"
msgstr "Перемістити вибране поле вище"
#: rxdconst.srxdbgridselcolhint2
msgid "Move selected column down"
msgstr "Перемістити вибране поле нижче"
#: rxdconst.srxdbgridselectallrows
msgid "Select all rows"
msgstr "Виділити всі рядки"
# msgid "Select visible collumns"
#: rxdconst.srxdbgridselectcolumns
msgid "Select visible columns"
msgstr "Вибір стовпців для відображення"
#: rxdconst.srxdbgridsortbycolumns
msgid "Sort data for columns"
msgstr "Сортувати дані по колонках"
#: rxdconst.srxdbgridtoolscaption
msgid "Totals row"
msgstr "Підсумковий рядок"
#: rxdconst.srxdescending
msgctxt "rxdconst.srxdescending"
msgid "Descending"
msgstr "За зменшенням"
#: rxdconst.srxfieldslookupdisplay
msgid "Fields as LookupDisplay"
msgstr "Поле як LookupDisplay"
#: rxdconst.srxfillfieldslookupdisp
msgid "Fill fields in LookupDisplay property"
msgstr "Заповнити поля в LookupDisplay властивостях"
#: rxdconst.srxfillsortfieldsdisp
msgid "Fill fields in SortField property"
msgstr "Заповнити поля в SortField властивостях"
#: rxdconst.srxfilterformapply
msgctxt "rxdconst.srxfilterformapply"
msgid "Apply"
msgstr "Застосувати"
#: rxdconst.srxfilterformcancel
msgid "Cancel"
msgstr "Скасувати"
#: rxdconst.srxfilterformcaption
msgid "Filter conditions"
msgstr "Вираз фільтра"
#: rxdconst.srxfilterformclear
msgctxt "rxdconst.srxfilterformclear"
msgid "Clear filter"
msgstr "Очистити фільтр"
#: rxdconst.srxfilterformcondition
msgid "Condition :"
msgstr "Вираз :"
#: rxdconst.srxfilterformend
msgid "end."
msgstr "кінець."
#: rxdconst.srxfilterformonfield
msgid "On field :"
msgstr "На поле :"
#: rxdconst.srxfilterformoperaion
msgid "Operation :"
msgstr "Операція :"
#: rxdconst.srxfilterformoperand
msgid "Operand :"
msgstr "Операнд :"
#: rxdconst.srxfilterformselectexp
msgid "Enter filter expression for data in table:"
msgstr "Введіть вираз фільтрації даних в таблиці:"
#: rxdconst.srxfindmore
msgid "Find more"
msgstr "Шукати далі"
#: rxdconst.srxselectdatasetstruct
msgid "Select dataset to copy to"
msgstr "Виберіть таблицю для копіювання"
#: rxdconst.srxsortbyformaddfield
msgid "&Add field"
msgstr "&Додати поле"
#: rxdconst.srxsortbyformallfields
msgid "&Fields in dataset:"
msgstr "&Поля в таблиці"
#: rxdconst.srxsortbyformcaption
msgid "Sort on field"
msgstr "Сортувати по полях"
#: rxdconst.srxsortbyformcaseinsens
msgid "&Case insensitive sort"
msgstr "&Сортування без урахування регістра"
#: rxdconst.srxsortbyformmovednfield
msgid "&Down"
msgstr "&Вниз"
#: rxdconst.srxsortbyformmoveupfield
msgid "&Up"
msgstr "&Вгору"
#: rxdconst.srxsortbyformremovefield
msgid "&Remove"
msgstr "&Видалити"
#: rxdconst.srxsortbyformsortfields
msgid "&Selected fields:"
msgstr "&Вибрані поля"
#: rxdconst.srxsortbyformsortorder
msgid "Select f&ield for sort data:"
msgstr "Вкажіть поля для сортування даних :"
#: rxdconst.srxsortfieldsdisplay
msgid "Fields as SortField"
msgstr ""
#: rxdconst.srxsourcedataset
msgid "Source dataset"
msgstr "Джерело даних"
#: rxdconst.sservererrorlabel
msgid "Server error"
msgstr "Помилка сервера"
#: rxdconst.ssetkeydata
msgid "find"
msgstr "Пошук"
#: rxdconst.ssetuptotalrow
msgid "Setup total row"
msgstr "Налаштувати підсумковий рядок"
#: rxdconst.sshowcolumnheaderonallpage
msgid "Show column header on all pages"
msgstr "Виводити заголовок стовпців на всіх сторінках"
#: rxdconst.sshowfooter
msgid "Show footer"
msgstr "Показати підсумок"
#: rxdconst.sshowfootercolor
msgid "Show footer color"
msgstr "Показати колір пісумку"
#: rxdconst.sshowgridcolor
msgid "Show grid color"
msgstr "Показати колір таблиці"
#: rxdconst.sshowreporttitle
msgid "Show report title"
msgstr "Показати заголовок звіту"
#: rxdconst.sshowtitle
msgid "Show column title"
msgstr "Показати заголовок стовпця"
#: rxdconst.ssorting
msgid "Sorting"
msgstr ""
#: rxdconst.sstandartfilter
msgid "Standart filter"
msgstr ""
#: rxdconst.stitlecolor
msgid "Title color"
msgstr "Колір заголовка"
#: rxdconst.stoolsexportpdf
msgid "Export to PDF file"
msgstr "Експорт до PDF файлу"
#: rxdconst.stoolsexportspeadsheet
msgid "Export to speadsheet"
msgstr "Експорт до електронної таблиці"
#: rxdconst.stopcaption
msgid "Top"
msgstr "Вверх"
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr "Не визначений тип даних для поля %s"
#: rxdconst.sunknownxmldatasetformat
msgid "Unknown XML Dataset format"
msgstr "Не відомий формат XML даних"
#: rxdconst.sunlockcaption
msgid "Unlock"
msgstr "Розблокувати"
#: rxdconst.sunlockhint
msgid "Enter your password"
msgstr "Введіть ваш пароль"
#: rxdconst.suserawjpeg
msgid "Use raw JPEG"
msgstr "Використати необроблений JPEG"
#: rxdconst.susernamelabel
msgid "&User name:"
msgstr "&Ім'я користувача"

View File

@@ -0,0 +1,270 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<MainUnit Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="rxnew"/>
<MinVersion Major="1" Release="11" Build="35" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item3>
</RequiredPackages>
<Units Count="26">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="26"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<CursorPos X="34" Y="9"/>
<UsageCount Value="26"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="C:\lazarus\lcl\extctrls.pp"/>
<UnitName Value="ExtCtrls"/>
<TopLine Value="451"/>
<CursorPos X="83" Y="456"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="C:\lazarus\lcl\controls.pp"/>
<UnitName Value="Controls"/>
<TopLine Value="224"/>
<CursorPos X="26" Y="228"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="C:\lazarus\lcl\graphics.pp"/>
<UnitName Value="Graphics"/>
<TopLine Value="586"/>
<CursorPos X="102" Y="589"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="C:\lazarus\lcl\lclproc.pas"/>
<UnitName Value="LCLProc"/>
<TopLine Value="577"/>
<CursorPos X="70" Y="578"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="C:\lazarus\lcl\include\canvas.inc"/>
<TopLine Value="771"/>
<CursorPos X="58" Y="776"/>
<UsageCount Value="10"/>
</Unit6>
<Unit7>
<Filename Value="C:\lazarus\lcl\include\paintbox.inc"/>
<TopLine Value="16"/>
<CursorPos X="81" Y="18"/>
<UsageCount Value="10"/>
</Unit7>
<Unit8>
<Filename Value="C:\lazarus\lcl\include\graphiccontrol.inc"/>
<TopLine Value="21"/>
<CursorPos X="101" Y="26"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<Filename Value="C:\lazarus\lcl\include\controlcanvas.inc"/>
<TopLine Value="36"/>
<CursorPos X="59" Y="43"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="C:\lazarus\lcl\include\bitmap.inc"/>
<TopLine Value="138"/>
<CursorPos X="29" Y="141"/>
<UsageCount Value="10"/>
</Unit10>
<Unit11>
<Filename Value="C:\lazarus\fpcsrc\rtl\objpas\classes\classes.inc"/>
<TopLine Value="238"/>
<CursorPos X="69" Y="241"/>
<UsageCount Value="10"/>
</Unit11>
<Unit12>
<Filename Value="C:\lazarus\lcl\include\brush.inc"/>
<TopLine Value="178"/>
<CursorPos X="56" Y="181"/>
<UsageCount Value="10"/>
</Unit12>
<Unit13>
<Filename Value="C:\lazarus\lcl\include\winapi.inc"/>
<TopLine Value="226"/>
<CursorPos X="52" Y="228"/>
<UsageCount Value="10"/>
</Unit13>
<Unit14>
<Filename Value="C:\lazarus\lcl\interfaces\win32\win32winapi.inc"/>
<TopLine Value="1316"/>
<CursorPos X="67" Y="1319"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="C:\lazarus\fpcsrc\fcl\image\fpcanvas.pp"/>
<UnitName Value="FPCanvas"/>
<TopLine Value="117"/>
<CursorPos X="101" Y="117"/>
<UsageCount Value="10"/>
</Unit15>
<Unit16>
<Filename Value="C:\lazarus\components\lazreport\source\LR_BarC.pas"/>
<ComponentName Value="frBarCodeForm"/>
<HasResources Value="True"/>
<TopLine Value="400"/>
<CursorPos X="57" Y="405"/>
<UsageCount Value="10"/>
</Unit16>
<Unit17>
<Filename Value="C:\lazarus\components\lazreport\source\Barcode.pas"/>
<TopLine Value="149"/>
<CursorPos X="38" Y="150"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="C:\lazarus\components\lazreport\source\LR_Class.pas"/>
<TopLine Value="210"/>
<CursorPos Y="228"/>
<UsageCount Value="10"/>
</Unit18>
<Unit19>
<Filename Value="C:\lazarus\components\rxnew\rxdbgrid.pas"/>
<TopLine Value="931"/>
<CursorPos X="46" Y="954"/>
<UsageCount Value="11"/>
</Unit19>
<Unit20>
<Filename Value="C:\lazarus\components\rxnew\vclutils.pas"/>
<CursorPos X="22" Y="27"/>
<UsageCount Value="11"/>
</Unit20>
<Unit21>
<Filename Value="C:\lazarus\lcl\dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<TopLine Value="151"/>
<CursorPos X="23" Y="152"/>
<UsageCount Value="11"/>
</Unit21>
<Unit22>
<Filename Value="C:\lazarus\lcl\grids.pas"/>
<UnitName Value="Grids"/>
<TopLine Value="3715"/>
<CursorPos X="3" Y="3719"/>
<UsageCount Value="11"/>
</Unit22>
<Unit23>
<Filename Value="..\..\vclutils.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="286"/>
<CursorPos X="30" Y="289"/>
<UsageCount Value="10"/>
</Unit23>
<Unit24>
<Filename Value="..\..\rxdbgrid.pas"/>
<TopLine Value="1105"/>
<CursorPos X="75" Y="1122"/>
<UsageCount Value="10"/>
</Unit24>
<Unit25>
<Filename Value="..\..\rx.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="18"/>
<CursorPos Y="52"/>
<UsageCount Value="10"/>
</Unit25>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="46" Column="47" TopLine="27"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="56" Column="12" TopLine="39"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="71" Column="52" TopLine="51"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="71" Column="52" TopLine="29"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="40" TopLine="40"/>
</Position5>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

View File

@@ -0,0 +1,43 @@
unit Unit2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
{ TForm2 }
TForm2 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Panel1: TPanel;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
private
{ private declarations }
public
{ public declarations }
end;
var
Form2: TForm2 = nil;
implementation
{$R *.lfm}
{ TForm2 }
procedure TForm2.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:=caFree;
Form2:=nil;
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.1 KiB

View File

@@ -0,0 +1,287 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<MainUnit Value="0"/>
<Title Value="RxViewsPanel demo"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="LazControls"/>
<MinVersion Valid="True"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
<MinVersion Major="2" Minor="1" Release="2" Build="105" Valid="True"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="14">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos Y="15"/>
<UsageCount Value="23"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="15"/>
<CursorPos X="7" Y="34"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../rxviewspanel.pas"/>
<UnitName Value="RxViewsPanel"/>
<EditorIndex Value="-1"/>
<TopLine Value="167"/>
<CursorPos X="36" Y="201"/>
<UsageCount Value="11"/>
<Bookmarks Count="2">
<Item0 Y="295" ID="1"/>
<Item1 X="3" Y="330" ID="2"/>
</Bookmarks>
</Unit2>
<Unit3>
<Filename Value="../../registerrx.pas"/>
<TopLine Value="40"/>
<CursorPos X="30" Y="50"/>
<UsageCount Value="11"/>
</Unit3>
<Unit4>
<Filename Value="../../rxtoolbar.pas"/>
<TopLine Value="1113"/>
<CursorPos X="45" Y="1143"/>
<UsageCount Value="11"/>
</Unit4>
<Unit5>
<Filename Value="../../rxaboutdialog.pas"/>
<UnitName Value="RxAboutDialog"/>
<TopLine Value="27"/>
<CursorPos X="3" Y="46"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="../../../../lcl/extctrls.pp"/>
<UnitName Value="ExtCtrls"/>
<TopLine Value="1147"/>
<CursorPos X="13" Y="1179"/>
<UsageCount Value="10"/>
</Unit6>
<Unit7>
<Filename Value="../../../../lcl/buttons.pp"/>
<UnitName Value="Buttons"/>
<TopLine Value="331"/>
<CursorPos X="17" Y="350"/>
<UsageCount Value="10"/>
</Unit7>
<Unit8>
<Filename Value="../../../../lcl/stdctrls.pp"/>
<UnitName Value="StdCtrls"/>
<TopLine Value="1420"/>
<CursorPos X="3" Y="1439"/>
<UsageCount Value="11"/>
</Unit8>
<Unit9>
<Filename Value="../../../install/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<TopLine Value="411"/>
<CursorPos X="24" Y="435"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="../../../install/fpcsrc/rtl/objpas/classes/collect.inc"/>
<TopLine Value="18"/>
<CursorPos X="3" Y="21"/>
<UsageCount Value="10"/>
</Unit10>
<Unit11>
<Filename Value="../../../../lcl/controls.pp"/>
<UnitName Value="Controls"/>
<TopLine Value="1265"/>
<CursorPos X="15" Y="1280"/>
<UsageCount Value="10"/>
</Unit11>
<Unit12>
<Filename Value="../../../../lcl/include/control.inc"/>
<TopLine Value="3131"/>
<CursorPos Y="3151"/>
<UsageCount Value="10"/>
</Unit12>
<Unit13>
<Filename Value="../../../../lcl/include/untabbednotebook.inc"/>
<TopLine Value="176"/>
<CursorPos X="17" Y="204"/>
<UsageCount Value="10"/>
</Unit13>
</Units>
<JumpHistory Count="27" HistoryIndex="26">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="18" Column="29"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="18" Column="29"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="40" Column="3" TopLine="15"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="41" Column="3" TopLine="15"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="42" Column="3" TopLine="15"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="43" Column="3" TopLine="15"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="42" Column="3" TopLine="15"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="36" Column="3" TopLine="7"/>
</Position8>
<Position9>
<Filename Value="unit1.pas"/>
<Caret Line="42" Column="41" TopLine="17"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="43" Column="41" TopLine="17"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="44" Column="41" TopLine="17"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="45" Column="41" TopLine="17"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="46" Column="41" TopLine="17"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="47" Column="41" TopLine="18"/>
</Position14>
<Position15>
<Filename Value="unit1.pas"/>
<Caret Line="48" Column="41" TopLine="19"/>
</Position15>
<Position16>
<Filename Value="unit1.pas"/>
<Caret Line="49" Column="41" TopLine="20"/>
</Position16>
<Position17>
<Filename Value="unit1.pas"/>
<Caret Line="50" Column="41" TopLine="21"/>
</Position17>
<Position18>
<Filename Value="unit1.pas"/>
<Caret Line="51" Column="41" TopLine="22"/>
</Position18>
<Position19>
<Filename Value="unit1.pas"/>
<Caret Line="52" Column="41" TopLine="27"/>
</Position19>
<Position20>
<Filename Value="unit1.pas"/>
<Caret Line="58" Column="29" TopLine="33"/>
</Position20>
<Position21>
<Filename Value="unit1.pas"/>
<Caret Line="58" Column="29" TopLine="9"/>
</Position21>
<Position22>
<Filename Value="unit1.pas"/>
<Caret Line="53" Column="3" TopLine="50"/>
</Position22>
<Position23>
<Filename Value="unit1.pas"/>
<Caret Line="54" Column="3" TopLine="51"/>
</Position23>
<Position24>
<Filename Value="unit1.pas"/>
<Caret Line="55" Column="3" TopLine="13"/>
</Position24>
<Position25>
<Filename Value="unit1.pas"/>
<Caret Line="56" Column="3" TopLine="24"/>
</Position25>
<Position26>
<Filename Value="unit1.pas"/>
<Caret Line="57" Column="3" TopLine="25"/>
</Position26>
<Position27>
<Filename Value="unit1.pas"/>
<Caret Line="33" Column="7" TopLine="16"/>
</Position27>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@@ -0,0 +1,170 @@
{ ex_rx_datapacket 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 ex_rx_datapacket;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,db;
type
TRowStateValue = (rsvOriginal, rsvDeleted, rsvInserted, rsvUpdated, rsvDetailUpdates);
TRowState = set of TRowStateValue;
type
TRxDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny);
type
{ TRxDatapacketReader }
TRxDatapacketReaderClass = class of TRxDatapacketReader;
TRxDatapacketReader = class(TObject)
FStream : TStream;
protected
class function RowStateToByte(const ARowState : TRowState) : byte;
class function ByteToRowState(const AByte : Byte) : TRowState;
public
constructor create(AStream : TStream); virtual;
// Load a dataset from stream:
// Load the field-definitions from a stream.
procedure LoadFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
// Is called before the records are loaded
procedure InitLoadRecords; virtual; abstract;
// Return the RowState of the current record, and the order of the update
function GetRecordRowState(out AUpdOrder : Integer) : TRowState; virtual; abstract;
// Returns if there is at least one more record available in the stream
function GetCurrentRecord : boolean; virtual; abstract;
// Store a record from stream in the current record-buffer
procedure RestoreRecord(ADataset : TDataset); virtual; abstract;
// Move the stream to the next record
procedure GotoNextRecord; virtual; abstract;
// Store a dataset to stream:
// Save the field-definitions to a stream.
procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
// Save a record from the current record-buffer to the stream
procedure StoreRecord(ADataset : TDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
// Is called after all records are stored
procedure FinalizeStoreRecords; virtual; abstract;
// Checks if the provided stream is of the right format for this class
class function RecognizeStream(AStream : TStream) : boolean; virtual; abstract;
property Stream: TStream read FStream;
end;
type
TRxDatapacketReaderRegistration = record
ReaderClass : TRxDatapacketReaderClass;
Format : TRxDatapacketFormat;
end;
function GetRegisterDatapacketReader(AStream : TStream; AFormat : TRxDatapacketFormat; var ADataReaderClass : TRxDatapacketReaderRegistration) : boolean;
procedure RegisterDatapacketReader(ADatapacketReaderClass : TRxDatapacketReaderClass; AFormat : TRxDatapacketFormat);
implementation
var
RxRegisteredDatapacketReaders : Array of TRxDatapacketReaderRegistration;
function GetRegisterDatapacketReader(AStream: TStream;
AFormat: TRxDatapacketFormat;
var ADataReaderClass: TRxDatapacketReaderRegistration): boolean;
var i : integer;
begin
Result := False;
for i := 0 to length(RxRegisteredDatapacketReaders)-1 do if ((AFormat=dfAny) or (AFormat=RxRegisteredDatapacketReaders[i].Format)) then
begin
if (AStream <> nil) then
AStream.Seek(0,soFromBeginning); // ensure at start of stream to check value
if (AStream=nil) or (RxRegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
begin
ADataReaderClass := RxRegisteredDatapacketReaders[i];
Result := True;
if (AStream <> nil) then
AStream.Seek(0,soFromBeginning);
break;
end;
end;
end;
procedure RegisterDatapacketReader(
ADatapacketReaderClass: TRxDatapacketReaderClass; AFormat: TRxDatapacketFormat
);
begin
setlength(RxRegisteredDatapacketReaders,length(RxRegisteredDatapacketReaders)+1);
with RxRegisteredDatapacketReaders[length(RxRegisteredDatapacketReaders)-1] do
begin
Readerclass := ADatapacketReaderClass;
Format := AFormat;
end;
end;
{ TRxDatapacketReader }
class function TRxDatapacketReader.RowStateToByte(const ARowState: TRowState
): byte;
var RowStateInt : Byte;
begin
RowStateInt:=0;
if rsvOriginal in ARowState then RowStateInt := RowStateInt+1;
if rsvDeleted in ARowState then RowStateInt := RowStateInt+2;
if rsvInserted in ARowState then RowStateInt := RowStateInt+4;
if rsvUpdated in ARowState then RowStateInt := RowStateInt+8;
Result := RowStateInt;
end;
class function TRxDatapacketReader.ByteToRowState(const AByte: Byte
): TRowState;
begin
result := [];
if (AByte and 1)=1 then Result := Result+[rsvOriginal];
if (AByte and 2)=2 then Result := Result+[rsvDeleted];
if (AByte and 4)=4 then Result := Result+[rsvInserted];
if (AByte and 8)=8 then Result := Result+[rsvUpdated];
end;
constructor TRxDatapacketReader.create(AStream: TStream);
begin
FStream := AStream;
end;
initialization
setlength(RxRegisteredDatapacketReaders,0);
finalization
setlength(RxRegisteredDatapacketReaders,0);
end.

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

View File

@@ -0,0 +1,230 @@
object Form1: TForm1
Left = 585
Height = 610
Top = 311
Width = 874
Caption = 'Form1'
ClientHeight = 610
ClientWidth = 874
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 560
Top = 50
Width = 874
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID'
Width = 60
FieldName = 'ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Value = 'Current:'
Footer.ValueType = fvtStaticText
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'NAME'
Width = 350
FieldName = 'NAME'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.FieldName = 'NAME'
Footer.ValueType = fvtFieldValue
Footers = <>
WordWrap = True
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'CODE'
Width = 90
FieldName = 'CODE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Alignment = taRightJustify
Footer.FieldName = 'CODE'
Footer.ValueType = fvtSum
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.Active = True
FooterOptions.Color = clYellow
FooterOptions.RowCount = 1
FooterOptions.DrawFullLine = True
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OnCalcRowHeight = RxDBGrid1CalcRowHeight
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgFooterRows, rdgAllowQuickFilter]
FooterColor = clYellow
FooterRowCount = 1
Align = alClient
Color = clWindow
DrawFullLine = True
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = DataSource1
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
ReadOnly = True
TabOrder = 0
end
object Panel1: TPanel
Left = 0
Height = 50
Top = 0
Width = 874
Align = alTop
Caption = 'Panel1'
ClientHeight = 50
ClientWidth = 874
TabOrder = 1
object CheckBox1: TCheckBox
Left = 16
Height = 24
Top = 8
Width = 96
Caption = 'Word wrap'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 0
end
object CheckBox2: TCheckBox
Left = 152
Height = 24
Top = 8
Width = 105
Caption = 'Show footer'
OnChange = CheckBox1Change
TabOrder = 1
end
end
object DataSource1: TDataSource
DataSet = RxMemoryData1
Left = 328
Top = 134
end
object RxMemoryData1: TRxMemoryData
FieldDefs = <
item
Name = 'ID'
DataType = ftInteger
end
item
Name = 'NAME'
DataType = ftString
Size = 500
end
item
Name = 'CODE'
DataType = ftInteger
end>
PacketRecords = 0
Left = 360
Top = 134
object RxMemoryData1ID: TLongintField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object RxMemoryData1NAME: TStringField
FieldKind = fkData
FieldName = 'NAME'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 500
end
object RxMemoryData1CODE: TLongintField
FieldKind = fkData
FieldName = 'CODE'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
end
end

View File

@@ -0,0 +1,71 @@
/* XPM */
static char *DICE4[]={
"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####.........................",
"...........................##########...........................",
"..............................####..............................",
"................................................................"};

View File

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

View File

@@ -0,0 +1,19 @@
object Form1: TForm1
Left = 385
Height = 322
Top = 265
Width = 486
Caption = 'Form1'
ClientHeight = 322
ClientWidth = 486
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object RxSwitch1: TRxSwitch
Left = 192
Height = 92
Top = 72
Width = 58
Caption = 'RxSwitch1'
TabOrder = 0
end
end

View File

@@ -0,0 +1,369 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:osb="http://www.openswatchbook.org/uri/2009/osb"
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
width="24"
height="24"
viewBox="0 0 24 24"
id="svg4225"
version="1.1"
inkscape:version="0.92.3 (2405546, 2018-03-11)"
sodipodi:docname="tdblookupedit_rx.svg"
inkscape:export-filename="D:\temp\rx\work\tdblookupedit_rx.png"
inkscape:export-xdpi="96"
inkscape:export-ydpi="96">
<defs
id="defs4227">
<linearGradient
osb:paint="solid"
id="linearGradient826">
<stop
id="stop824"
offset="0"
style="stop-color:#e6e6e6;stop-opacity:1;" />
</linearGradient>
<linearGradient
gradientUnits="userSpaceOnUse"
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
id="linearGradient908"
xlink:href="#linearGradient914"
inkscape:collect="always"
gradientTransform="matrix(4,0,0,4,-36.919643,-3107.1068)" />
<linearGradient
inkscape:collect="always"
id="linearGradient914">
<stop
style="stop-color:#4276c4;stop-opacity:1;"
offset="0"
id="stop910" />
<stop
id="stop916"
offset="0.34375"
style="stop-color:#80b3ff;stop-opacity:1" />
<stop
style="stop-color:#0044aa;stop-opacity:1"
offset="1"
id="stop912" />
</linearGradient>
<linearGradient
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientTransform="matrix(4,0,0,4,-36.919643,-3131.1064)"
gradientUnits="userSpaceOnUse"
id="linearGradient936"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
gradientTransform="matrix(4,0,0,4,-36.919643,-3119.1068)"
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientUnits="userSpaceOnUse"
id="linearGradient932"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient876"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-36.919643,-3107.1068)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
</defs>
<sodipodi:namedview
id="base"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageopacity="0.0"
inkscape:pageshadow="2"
inkscape:zoom="21.208333"
inkscape:cx="12"
inkscape:cy="12"
inkscape:document-units="px"
inkscape:current-layer="layer11"
showgrid="true"
inkscape:snap-bbox="true"
inkscape:bbox-paths="true"
inkscape:bbox-nodes="true"
inkscape:snap-bbox-edge-midpoints="true"
inkscape:snap-bbox-midpoints="true"
inkscape:object-paths="true"
inkscape:snap-intersection-paths="true"
inkscape:object-nodes="true"
inkscape:snap-smooth-nodes="true"
inkscape:snap-midpoints="true"
inkscape:snap-object-midpoints="true"
inkscape:snap-center="true"
units="px"
inkscape:window-width="1366"
inkscape:window-height="706"
inkscape:window-x="-8"
inkscape:window-y="-8"
inkscape:window-maximized="1">
<inkscape:grid
type="xygrid"
id="grid4241" />
</sodipodi:namedview>
<metadata
id="metadata4230">
<rdf:RDF>
<cc:Work
rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
<dc:title />
</cc:Work>
</rdf:RDF>
</metadata>
<g
inkscape:groupmode="layer"
id="layer3"
inkscape:label="base"
transform="translate(0,-24)">
<rect
style="fill:none;fill-rule:evenodd;stroke-width:0.5"
id="rect2101"
width="24"
height="24"
x="0"
y="24" />
</g>
<g
inkscape:label="db"
inkscape:groupmode="layer"
id="layer1"
transform="translate(0,-1028.3622)"
style="display:inline">
<g
id="g899"
transform="matrix(0.5,0,0,0.5,18.459822,526.3406)">
<ellipse
ry="3"
rx="10"
cy="1030.1925"
cx="-20.919643"
id="ellipse880"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient876);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1026.2755"
cx="-20.919643"
id="ellipse878"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient932);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse930"
cx="-20.919643"
cy="1024.1925"
rx="10"
ry="3" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse874"
cx="-20.919643"
cy="1020.2756"
rx="10.988618"
ry="3.9169633" />
<ellipse
ry="3"
rx="10"
cy="1018.1926"
cx="-20.919643"
id="ellipse934"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient936);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1014.2756"
cx="-20.919643"
id="ellipse858"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#80b3ff;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient908);stroke-width:1.99999988;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse868"
cx="-20.919643"
cy="1012.1926"
rx="11"
ry="4" />
</g>
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846"
transform="matrix(0.5,0,0,0.5,-49.916347,514.0452)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-8"
transform="matrix(0.5,0,0,0.5,-62.925585,511.6925)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-2"
transform="matrix(0.5,0,0,0.5,-71.60414,515.42715)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-8-8"
transform="matrix(0.5,0,0,0.5,-84.613375,513.07444)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-6"
transform="matrix(0.5,0,0,0.5,-58.231865,515.68991)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-8-1"
transform="matrix(0.5,0,0,0.5,-71.2411,513.3372)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-4"
transform="matrix(0.5,0,0,0.5,-67.59445,510.86817)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-8-4"
transform="matrix(0.5,0,0,0.5,-80.60369,508.51547)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-5"
transform="matrix(0.5,0,0,0.5,-95.610425,509.16817)" />
<g
aria-label="7"
style="font-style:normal;font-weight:normal;font-size:10.66666698px;line-height:25px;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
id="text846-8-2"
transform="matrix(0.5,0,0,0.5,-108.61966,506.81546)" />
</g>
<g
inkscape:groupmode="layer"
id="layer10"
inkscape:label="arrow"
style="display:inline"
transform="translate(0,-24)">
<g
id="g8355"
transform="matrix(0.49936706,0,0,0.4984168,-14.956193,21.958932)">
<g
id="g1038"
transform="translate(40.500075,-1010.7032)"
style="display:inline;fill:#a02c2c;stroke:#a02c2c;stroke-width:2;stroke-miterlimit:4;stroke-dasharray:none">
<path
style="fill:#a02c2c;fill-rule:evenodd;stroke:#a02c2c;stroke-width:2;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 27.5,1018.8622 6,6"
id="path1032"
inkscape:connector-curvature="0"
sodipodi:nodetypes="cc" />
<path
sodipodi:nodetypes="cc"
inkscape:connector-curvature="0"
id="path1034"
d="m 27.499925,1018.8525 3.000075,0.01"
style="fill:#a02c2c;fill-rule:evenodd;stroke:#a02c2c;stroke-width:2;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
<path
style="fill:#a02c2c;fill-rule:evenodd;stroke:#a02c2c;stroke-width:2;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 27.499925,1018.8525 7.5e-5,3.0097"
id="path1036"
inkscape:connector-curvature="0"
sodipodi:nodetypes="cc" />
</g>
<g
id="g1046"
transform="rotate(-180,48.25,518.50592)"
style="display:inline;fill:#a02c2c;stroke:#a02c2c;stroke-width:2;stroke-miterlimit:4;stroke-dasharray:none">
<path
sodipodi:nodetypes="cc"
inkscape:connector-curvature="0"
id="path1040"
d="m 27.5,1018.8622 6,6"
style="fill:#a02c2c;fill-rule:evenodd;stroke:#a02c2c;stroke-width:2;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
<path
style="fill:#a02c2c;fill-rule:evenodd;stroke:#a02c2c;stroke-width:2;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 27.499925,1018.8525 3.000075,0.01"
id="path1042"
inkscape:connector-curvature="0"
sodipodi:nodetypes="cc" />
<path
sodipodi:nodetypes="cc"
inkscape:connector-curvature="0"
id="path1044"
d="m 27.499925,1018.8525 7.5e-5,3.0097"
style="fill:#a02c2c;fill-rule:evenodd;stroke:#a02c2c;stroke-width:2;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
</g>
</g>
</g>
<g
inkscape:groupmode="layer"
id="layer9"
inkscape:label="lookup"
transform="translate(0,-24)">
<rect
y="39.457691"
x="17.515484"
height="4.0000172"
width="4"
id="rect891"
style="opacity:1;fill:#ffffff;fill-opacity:1;stroke:#4d4d4d;stroke-width:1;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal;stroke-linejoin:round" />
<rect
style="opacity:1;fill:#ffffff;fill-opacity:1;stroke:#4d4d4d;stroke-width:0.99999994;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal;stroke-linejoin:round"
id="rect893"
width="10"
height="4.0000176"
x="7.515491"
y="39.457691" />
<path
style="fill:none;fill-rule:evenodd;stroke:#000000;stroke-width:0.99999988px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="m 9.015487,41.457706 h 6.999995"
id="path903"
inkscape:connector-curvature="0" />
<path
style="fill:none;fill-rule:evenodd;stroke:#000000;stroke-width:0.5px;stroke-linecap:square;stroke-linejoin:miter;stroke-opacity:1"
d="m 18.765707,40.911256 0.749776,0.8465 0.750224,-0.8465"
id="path920"
inkscape:connector-curvature="0"
sodipodi:nodetypes="ccc" />
</g>
<g
inkscape:groupmode="layer"
id="layer11"
inkscape:label="text"
transform="translate(0,-24)">
<flowRoot
xml:space="preserve"
id="flowRoot914-84"
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:12px;line-height:1.25;font-family:'Arial Unicode MS';-inkscape-font-specification:'Arial Unicode MS';letter-spacing:0px;word-spacing:0px;fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"
transform="matrix(0.46354284,0,0,0.55114772,-1.2832947,23.859648)"><flowRegion
id="flowRegion916-4"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"><rect
id="rect918-7"
width="38.14209"
height="34.674625"
x="3.4674628"
y="-1.8781176"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill" /></flowRegion><flowPara
id="flowPara920-5"
style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:21.33333397px;font-family:Arial;-inkscape-font-specification:'Arial Bold';stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill">Rx</flowPara></flowRoot> </g>
</svg>

After

Width:  |  Height:  |  Size: 17 KiB

View File

@@ -0,0 +1,21 @@
program WordWrapDemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, rxnew
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@@ -0,0 +1,95 @@
{ RxDBGridExportSpreadSheet_ParamsUnit unit
Copyright (C) 2005-2017 Lagunov Aleksey alexs@yandex.ru
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 RxDBGridExportSpreadSheet_ParamsUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
EditBtn, ButtonPanel;
type
{ TRxDBGridExportSpreadSheet_ParamsForm }
TRxDBGridExportSpreadSheet_ParamsForm = class(TForm)
ButtonPanel1: TButtonPanel;
cbExportSelectedRows: TCheckBox;
cbExportFormula: TCheckBox;
cbExportColumnFooter: TCheckBox;
cbExportGrpData: TCheckBox;
cbMergeCells: TCheckBox;
cbOpenAfterExport: TCheckBox;
cbExportColumnHeader: TCheckBox;
cbExportCellColors: TCheckBox;
cbOverwriteExisting: TCheckBox;
cbHideZeroValues: TCheckBox;
edtPageName: TEdit;
FileNameEdit1: TFileNameEdit;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
implementation
uses rxdconst;
{$R *.lfm}
{ TRxDBGridExportSpreadSheet_ParamsForm }
procedure TRxDBGridExportSpreadSheet_ParamsForm.FormCreate(Sender: TObject);
begin
Caption:=sExportParams;
Label1.Caption:=sExportFileName;
Label3.Caption:=sPageName;
cbOpenAfterExport.Caption:=sOpenAfterExport;
cbExportColumnHeader.Caption:=sExportColumnHeader;
cbExportColumnFooter.Caption:=sExportColumnFooter;
cbExportCellColors.Caption:=sExportCellColors;
cbOverwriteExisting.Caption:=sOverwriteExisting;
cbExportFormula.Caption:=sExportFormula;
cbExportSelectedRows.Caption:=sExportSelectedRows;
cbHideZeroValues.Caption:=sExportHideZeroValues;
cbMergeCells.Caption:=sMergeCells;
cbExportGrpData.Caption:=sExportGroupData;
end;
end.

View File

@@ -0,0 +1,340 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

View File

@@ -0,0 +1,179 @@
object Form1: TForm1
Left = 527
Height = 435
Top = 222
Width = 613
Caption = 'MainForm'
ClientHeight = 407
ClientWidth = 613
Menu = MainMenu1
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
WindowState = wsMaximized
object ToolPanel1: TToolPanel
Left = 0
Height = 31
Top = 0
Width = 613
Items = <>
Options = []
CustomizeShortCut = False
Align = alTop
BorderWidth = 4
ClientHeight = 31
ClientWidth = 613
TabOrder = 0
object RxMDICloseButton1: TRxMDICloseButton
AnchorSideTop.Control = ToolPanel1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = ToolPanel1
AnchorSideRight.Side = asrBottom
Left = 585
Height = 22
Top = 4
Width = 23
Anchors = [akTop, akRight]
Glyph.Data = {
1A020000424D1A0200000000000036000000280000000B0000000B0000000100
200000000000E401000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000FF0000
00FF00000000000000000000000000000000000000FF000000FF000000000000
00000000000000000000000000FF000000FF0000000000000000000000FF0000
00FF000000000000000000000000000000000000000000000000000000FF0000
00FF000000FF000000FF00000000000000000000000000000000000000000000
00000000000000000000000000FF000000FF0000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000FF0000
00FF0000000000000000000000FF000000FF0000000000000000000000000000
0000000000FF000000FF00000000000000000000000000000000000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000
}
ShowInfoLabel = False
end
end
object RxMDITasks1: TRxMDITasks
Left = 0
Height = 25
Top = 360
Width = 613
Align = alBottom
FlatButton = True
Options = [rxtoMidleClickClose]
end
object StatusBar1: TStatusBar
Left = 0
Height = 22
Top = 385
Width = 613
Panels = <
item
Width = 100
end
item
Width = 150
end>
SimplePanel = False
end
object RxMDIPanel1: TRxMDIPanel
Left = 0
Height = 329
Top = 31
Width = 613
CloseButton = RxMDICloseButton1
TaskPanel = RxMDITasks1
Align = alClient
BevelOuter = bvLowered
HideCloseButton = False
OnChangeCurrentChild = RxMDIPanel1ChangeCurrentChild
end
object ActionList1: TActionList
Left = 440
Top = 72
object sysClose: TAction
Category = 'System'
Caption = 'Close'
OnExecute = sysCloseExecute
end
object Action1: TAction
Category = 'MDI forms'
Caption = 'Form # 1'
OnExecute = Action1Execute
end
object Action2: TAction
Category = 'MDI forms'
Caption = 'Form # 2'
OnExecute = Action2Execute
end
object Action3: TAction
Category = 'MDI forms'
Caption = 'New single MDI form'
OnExecute = Action3Execute
end
object optShowInfoLabel: TAction
Category = 'Options'
Caption = 'Show info label'
Checked = True
OnExecute = optShowInfoLabelExecute
end
object optMidleMouseClickClose: TAction
Category = 'Options'
Caption = 'Midle mouse button close form'
Checked = True
OnExecute = optMidleMouseClickCloseExecute
end
object optHideCloseButton: TAction
Category = 'Options'
Caption = 'Hide close button'
Checked = True
OnExecute = optHideCloseButtonExecute
end
end
object MainMenu1: TMainMenu
Left = 408
Top = 72
object MenuItem1: TMenuItem
Caption = 'System'
object MenuItem2: TMenuItem
Action = sysClose
end
end
object MenuItem8: TMenuItem
Caption = 'Options'
object MenuItem9: TMenuItem
Action = optShowInfoLabel
end
object MenuItem10: TMenuItem
Action = optMidleMouseClickClose
end
object MenuItem11: TMenuItem
Action = optHideCloseButton
end
end
object MenuItem3: TMenuItem
Caption = 'MDI forms'
object MenuItem4: TMenuItem
Action = Action1
end
object MenuItem5: TMenuItem
Action = Action2
end
object MenuItem7: TMenuItem
Caption = '-'
end
object MenuItem6: TMenuItem
Action = Action3
end
end
end
object Timer1: TTimer
Interval = 500
OnTimer = Timer1Timer
Left = 451
Top = 117
end
end

View File

@@ -0,0 +1,219 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TRxLoginForm','FORMDATA',[
'TPF0'#12'TRxLoginForm'#11'RxLoginForm'#6'Cursor'#7#7'crArrow'#4'Left'#3#202#1
+#6'Height'#3#203#0#3'Top'#3#193#0#5'Width'#3#199#1#13'ActiveControl'#7#12'Us'
+'erNameEdit'#11'BorderIcons'#11#12'biSystemMenu'#6'biHelp'#0#7'Caption'#6#11
+'RxLoginForm'#12'ClientHeight'#3#203#0#11'ClientWidth'#3#199#1#9'FormStyle'#7
+#11'fsStayOnTop'#8'OnCreate'#7#10'FormCreate'#6'OnShow'#7#8'FormShow'#8'Posi'
+'tion'#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.29'#0#6'TImage'#7'AppIcon'
+#22'AnchorSideLeft.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#5'Owner'#4
+'Left'#2#6#6'Height'#2' '#3'Top'#2#6#5'Width'#2' '#8'AutoSize'#9#20'BorderSp'
+'acing.Around'#2#6#0#0#6'TImage'#8'KeyImage'#22'AnchorSideLeft.Control'#7#5
+'Owner'#21'AnchorSideTop.Control'#7#5'Owner'#4'Left'#2#6#6'Height'#2' '#3'To'
+'p'#2#6#5'Width'#2' '#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#12'Picture.'
+'Data'#10#200#16#0#0#5'TIcon'#190#16#0#0#0#0#1#0#1#0' '#0#0#1#0' '#0#168#16
+#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1#0' '#0#0#0#0#0#0#16#0#0'd'#0#0#0
+'d'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0
+#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0
+#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#128#128#128#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#0#0#0#255#0#0#0#255#255#255#255#255#0#0#0#255#0#0#0#255#255#255
+#255#255#255#255#255#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128
+#255#255#255#255#255#255#255#255#255#128#128#128#255#0#0#0#255#0#0#0#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#0#0#0#255#0#0#0#255#255#255#255#255#0#0#0#255#0#0#0#255#255#255#255#255#255
+#255#255#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#255#255
+#255#255#128#128#128#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#0#0#0
+#255#255#255#255#255#0#0#0#255#0#0#0#255#255#255#255#255#255#255#255#255#0#0
+#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#255#255#255#255#0#0#0#255
+#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0
+#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255
+#255#255#255#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#255
+#255#255#255#0#0#0#255#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255#0
+#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0
+#255#0#0#0#255#0#0#0#255#255#255#255#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#128#128#128#255#255#255#255#255#128#128#128#255#0#0#0#255#128#128#128#255
+#0#0#0#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#128#128#128#255#255#255#255#255#255#255#255#255#128#128#128#255#0#0#0
+#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#128#128#128#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#128#128#128#255
+#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128
+#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128
+#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128
+#128#128#255#128#128#128#255#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#6'TLabel'#9'HintLabel'#22
+'AnchorSideLeft.Control'#7#7'AppIcon'#19'AnchorSideLeft.Side'#7#9'asrBottom'
+#21'AnchorSideTop.Control'#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'
+#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#2','#6'Height'#2#18#3'Top'#2
+#6#5'Width'#3#149#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#20'BorderS'
+'pacing.Around'#2#6#7'Caption'#6#9'HintLabel'#11'ParentColor'#8#13'ShowAccel'
+'Char'#8#0#0#6'TLabel'#13'UserNameLabel'#22'AnchorSideLeft.Control'#7#5'Owne'
+'r'#24'AnchorSideBottom.Control'#7#12'UserNameEdit'#21'AnchorSideBottom.Side'
+#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#18#3'Top'#2'A'#5'Width'#2'I'#7'Ancho'
+'rs'#11#6'akLeft'#8'akBottom'#0#18'BorderSpacing.Left'#2#6#7'Caption'#6#8'Us'
+'erName'#12'FocusControl'#7#12'UserNameEdit'#11'ParentColor'#8#0#0#6'TLabel'
+#13'PasswordLabel'#22'AnchorSideLeft.Control'#7#5'Owner'#24'AnchorSideBottom'
+'.Control'#7#12'PasswordEdit'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Lef'
+'t'#2#6#6'Height'#2#18#3'Top'#2'd'#5'Width'#2'C'#7'Anchors'#11#6'akLeft'#8'a'
+'kBottom'#0#18'BorderSpacing.Left'#2#6#7'Caption'#6#8'Password'#12'FocusCont'
+'rol'#7#12'PasswordEdit'#11'ParentColor'#8#0#0#6'TLabel'#13'AppTitleLabel'#22
+'AnchorSideLeft.Control'#7#7'AppIcon'#19'AnchorSideLeft.Side'#7#9'asrBottom'
+#21'AnchorSideTop.Control'#7#9'HintLabel'#18'AnchorSideTop.Side'#7#9'asrBott'
+'om'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asr'
+'Bottom'#4'Left'#2','#6'Height'#2#18#3'Top'#2#30#5'Width'#3#149#1#7'Anchors'
+#11#5'akTop'#6'akLeft'#7'akRight'#0#20'BorderSpacing.Around'#2#6#7'Caption'#6
+#13'AppTitleLabel'#11'ParentColor'#8#13'ShowAccelChar'#8#0#0#6'TLabel'#13'Da'
+'taBaseLabel'#22'AnchorSideLeft.Control'#7#5'Owner'#24'AnchorSideBottom.Cont'
+'rol'#7#11'CustomCombo'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6
+#6'Height'#2#18#3'Top'#3#137#0#5'Width'#2'C'#7'Anchors'#11#6'akLeft'#8'akBot'
+'tom'#0#18'BorderSpacing.Left'#2#6#7'Caption'#6#8'Database'#12'FocusControl'
+#7#11'CustomCombo'#11'ParentColor'#8#0#0#5'TEdit'#12'UserNameEdit'#22'Anchor'
+'SideLeft.Control'#7#13'UserNameLabel'#19'AnchorSideLeft.Side'#7#9'asrBottom'
+#21'AnchorSideTop.Control'#7#13'AppTitleLabel'#18'AnchorSideTop.Side'#7#9'as'
+'rBottom'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9
+'asrBottom'#6'Cursor'#7#7'crIBeam'#4'Left'#2'a'#6'Height'#2#29#3'Top'#2'6'#5
+'Width'#3'`'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#18'BorderSpacin'
+'g.Left'#2#12#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#0#0#5'TEdit'#12'P'
+'asswordEdit'#22'AnchorSideLeft.Control'#7#12'UserNameEdit'#21'AnchorSideTop'
+'.Control'#7#12'UserNameEdit'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'Ancho'
+'rSideRight.Control'#7#12'UserNameEdit'#20'AnchorSideRight.Side'#7#9'asrBott'
+'om'#6'Cursor'#7#7'crIBeam'#4'Left'#2'a'#6'Height'#2#29#3'Top'#2'Y'#5'Width'
+#3'`'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#17'BorderSpacing.Top'#2
+#6#8'EchoMode'#7#10'emPassword'#12'PasswordChar'#6#1'*'#8'TabOrder'#2#1#0#0#9
+'TComboBox'#11'CustomCombo'#22'AnchorSideLeft.Control'#7#12'UserNameEdit'#21
+'AnchorSideTop.Control'#7#12'PasswordEdit'#18'AnchorSideTop.Side'#7#9'asrBot'
+'tom'#23'AnchorSideRight.Control'#7#12'UserNameEdit'#20'AnchorSideRight.Side'
+#7#9'asrBottom'#4'Left'#2'a'#6'Height'#2#31#3'Top'#2'|'#5'Width'#3'`'#1#7'An'
+'chors'#11#5'akTop'#6'akLeft'#7'akRight'#0#17'BorderSpacing.Top'#2#6#10'Item'
+'Height'#2#0#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#2#0#0#7'TBitBtn'#5
+'btnOK'#22'AnchorSideLeft.Control'#7#12'PasswordEdit'#21'AnchorSideTop.Contr'
+'ol'#7#9'btnCancel'#23'AnchorSideRight.Control'#7#9'btnCancel'#24'AnchorSide'
+'Bottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'
+#3#187#0#6'Height'#2'$'#3'Top'#3#161#0#5'Width'#2'<'#7'Anchors'#11#5'akTop'#7
+'akRight'#8'akBottom'#0#8'AutoSize'#9#19'BorderSpacing.Right'#2#6#20'BorderS'
,'pacing.Bottom'#2#6#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#5'&'#208
+#158#208#154#7'Default'#9#4'Kind'#7#4'bkOK'#11'ModalResult'#2#1#7'OnClick'#7
+#10'btnOKClick'#8'TabOrder'#2#3#0#0#7'TBitBtn'#9'btnCancel'#21'AnchorSideTop'
+'.Control'#7#11'CustomCombo'#18'AnchorSideTop.Side'#7#9'asrBottom'#23'Anchor'
+'SideRight.Control'#7#7'btnHelp'#24'AnchorSideBottom.Control'#7#5'Owner'#21
+'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3#253#0#6'Height'#2'$'#3'Top'
+#3#161#0#5'Width'#2'_'#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSize'#9
+#20'BorderSpacing.Around'#2#6#25'BorderSpacing.InnerBorder'#2#2#6'Cancel'#9#7
+'Caption'#6#12#208#158#209#130#208#188#208#181#208#189#208#176#4'Kind'#7#8'b'
+'kCancel'#11'ModalResult'#2#2#8'TabOrder'#2#4#0#0#7'TBitBtn'#7'btnHelp'#21'A'
+'nchorSideTop.Control'#7#9'btnCancel'#23'AnchorSideRight.Control'#7#5'Owner'
+#20'AnchorSideRight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#5'Ow'
+'ner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3'b'#1#6'Height'#2'$'
+#3'Top'#3#161#0#5'Width'#2'_'#7'Anchors'#11#5'akTop'#7'akRight'#8'akBottom'#0
+#8'AutoSize'#9#19'BorderSpacing.Right'#2#6#20'BorderSpacing.Bottom'#2#6#7'Ca'
+'ption'#6#15'&'#208#161#208#191#209#128#208#176#208#178#208#186#208#176#4'Ki'
+'nd'#7#6'bkHelp'#8'TabOrder'#2#5#0#0#7'TBitBtn'#7'btnMore'#22'AnchorSideLeft'
+'.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#9'btnCancel'#24'AnchorSide'
+'Bottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'
+#2#6#6'Height'#2'$'#3'Top'#3#161#0#5'Width'#2'N'#7'Anchors'#11#5'akTop'#6'ak'
+'Left'#8'akBottom'#0#8'AutoSize'#9#18'BorderSpacing.Left'#2#6#20'BorderSpaci'
+'ng.Bottom'#2#6#7'Caption'#6#7'More >>'#7'OnClick'#7#12'btnMoreClick'#8'TabO'
+'rder'#2#6#0#0#0
]);

Binary file not shown.

After

Width:  |  Height:  |  Size: 278 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 149 B

View File

@@ -0,0 +1,32 @@
/* XPM */
static char *TRXSWITCH[]={
"24 24 5 1",
". c None",
"# c #000000",
"b c #808080",
"c c #ff0000",
"a c #ffffff",
"........................",
"........................",
".....##############.....",
".....##############.....",
".....###aaaaaaa#b##.....",
".....##aaaaaaa#bb##.....",
".....#aaaaaaa#bbb##.....",
".....#########bbb##.....",
".....#aaaaaaa#bbb##.....",
".....#aaaaaaaa#bb##.....",
".....##aaaaaaa#bb##.....",
".....##aaaaaaaa#b##.....",
".....###########b##.....",
".....##aaaaaaaa#b##.....",
".....##a######a#b##.....",
".....##a#cccc#a#b##.....",
".....##a######a#b##.....",
".....##aaaaaaaa#b##.....",
".....###########b##.....",
".....###bbbbbbbb###.....",
".....##############.....",
".....##############.....",
"........................",
"........................"};

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.3 KiB

View File

@@ -0,0 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<fpdoc-descriptions><package name="rx_sort_zeos"><module name="RxSortZeos"><short>Модуль содержит визуальный компонент для подключения модуля сортировки ZEOS</short><descr>Модуль содержит визуальный компонент для подключения модуля сортировки данных, предоставляемых библиотекой ZEOS в RxDBGrid</descr><element name="TRxSortZeos"><short>Визуальный компонент для подключения модуля сортировки данных, предоставляемых библиотекой ZEOS в RxDBGrid</short>
</element>
</module>
</package>
</fpdoc-descriptions>

View File

@@ -0,0 +1,466 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Creator: CorelDRAW 2017 -->
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xml:space="preserve"
width="24"
height="24"
version="1.1"
style="clip-rule:evenodd;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
viewBox="0 0 24 24.000001"
id="svg182"
sodipodi:docname="tdbcalcedit_rx.svg"
inkscape:version="0.92.3 (2405546, 2018-03-11)"
inkscape:export-filename="D:\temp\rx\work\tdbcalcedit_rx.png"
inkscape:export-xdpi="96"
inkscape:export-ydpi="96"><metadata
id="metadata186"><rdf:RDF><cc:Work
rdf:about=""><dc:format>image/svg+xml</dc:format><dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" /><dc:title /></cc:Work></rdf:RDF></metadata><sodipodi:namedview
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1"
objecttolerance="10"
gridtolerance="10"
guidetolerance="10"
inkscape:pageopacity="0"
inkscape:pageshadow="2"
inkscape:window-width="1920"
inkscape:window-height="1018"
id="namedview184"
showgrid="true"
units="px"
inkscape:zoom="34.208333"
inkscape:cx="11.254568"
inkscape:cy="12"
inkscape:window-x="-8"
inkscape:window-y="-8"
inkscape:window-maximized="1"
inkscape:current-layer="layer2"
showguides="true"
inkscape:guide-bbox="true"><inkscape:grid
type="xygrid"
id="grid899" /></sodipodi:namedview>
<defs
id="defs115">
<style
type="text/css"
id="style99">
<![CDATA[
.str0 {stroke:#2A2720;stroke-width:428.56}
.fil0 {fill:none}
.fil11 {fill:#2A59A1}
.fil13 {fill:#483737}
.fil2 {fill:#80B3FF}
.fil14 {fill:#D45500}
.fil9 {fill:#E3DEDB}
.fil12 {fill:red}
.fil6 {fill:white}
.fil10 {fill:#2A59A1;fill-rule:nonzero}
.fil8 {fill:#527596;fill-rule:nonzero}
.fil7 {fill:#595959;fill-rule:nonzero}
.fil15 {fill:#CC3399;fill-rule:nonzero}
.fil3 {fill:url(#id0)}
.fil4 {fill:url(#id1)}
.fil5 {fill:url(#id2)}
.fil1 {fill:url(#id3)}
]]>
</style>
<linearGradient
id="id0"
gradientUnits="userSpaceOnUse"
x1="2673"
y1="7004"
x2="9704"
y2="7004">
<stop
offset="0"
style="stop-opacity:1; stop-color:#4579C7"
id="stop101" />
<stop
offset="0.2"
style="stop-opacity:1; stop-color:#5487D5"
id="stop103" />
<stop
offset="0.368627"
style="stop-opacity:1; stop-color:#7BAEFB"
id="stop105" />
<stop
offset="0.619608"
style="stop-opacity:1; stop-color:#5487D5"
id="stop107" />
<stop
offset="1"
style="stop-opacity:1; stop-color:#4579C7"
id="stop109" />
</linearGradient>
<linearGradient
id="id1"
gradientUnits="userSpaceOnUse"
xlink:href="#id0"
x1="2672"
y1="8577"
x2="9704"
y2="8577">
</linearGradient>
<linearGradient
id="id2"
gradientUnits="userSpaceOnUse"
xlink:href="#id0"
x1="2672"
y1="10157"
x2="9704"
y2="10157">
</linearGradient>
<linearGradient
id="id3"
gradientUnits="userSpaceOnUse"
xlink:href="#id0"
x1="2669"
y1="11738"
x2="9700"
y2="11738">
</linearGradient>
<linearGradient
id="id3-8"
gradientUnits="userSpaceOnUse"
xlink:href="#id0"
x1="2669"
y1="11738"
x2="9700"
y2="11738" /><linearGradient
id="id1-4"
gradientUnits="userSpaceOnUse"
xlink:href="#id0"
x1="2672"
y1="8577"
x2="9704"
y2="8577" /><linearGradient
id="id2-2"
gradientUnits="userSpaceOnUse"
xlink:href="#id0"
x1="2672"
y1="10157"
x2="9704"
y2="10157" /><linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient529"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-38.924643,-3108.2401)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" /><linearGradient
inkscape:collect="always"
id="linearGradient914"><stop
style="stop-color:#4276c4;stop-opacity:1;"
offset="0"
id="stop910" /><stop
id="stop916"
offset="0.34375"
style="stop-color:#80b3ff;stop-opacity:1" /><stop
style="stop-color:#0044aa;stop-opacity:1"
offset="1"
id="stop912" /></linearGradient><linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient531"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-38.924643,-3120.2401)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" /><linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient533"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-38.924643,-3132.2398)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" /><linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient1051"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-38.924643,-3108.2401)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" /></defs>
<g
inkscape:groupmode="layer"
id="layer4"
inkscape:label="base"
style="display:inline"
transform="translate(0,-24)"><rect
style="fill:none;fill-rule:evenodd;stroke-width:0.60474312"
id="rect919"
width="24"
height="24"
x="0"
y="24" /></g><g
inkscape:groupmode="layer"
id="layer6"
inkscape:label="db"
transform="translate(0,-24)"><g
style="clip-rule:evenodd;display:inline;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="g899-2"
transform="matrix(0.5,0,0,0.5,17.457321,-478.58825)"><ellipse
ry="3"
rx="10"
cy="1030.1925"
cx="-20.919643"
id="ellipse880-3"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient1051);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" /><ellipse
ry="3.9169633"
rx="10.988618"
cy="1026.2755"
cx="-20.919643"
id="ellipse878-6"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" /><ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient531);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse930-3"
cx="-20.919643"
cy="1024.1925"
rx="10"
ry="3" /><ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse874-6"
cx="-20.919643"
cy="1020.2756"
rx="10.988618"
ry="3.9169633" /><ellipse
ry="3"
rx="10"
cy="1018.1926"
cx="-20.919643"
id="ellipse934-5"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient533);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" /><ellipse
ry="3.9169633"
rx="10.988618"
cy="1014.2756"
cx="-20.919643"
id="ellipse858-5"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" /><ellipse
style="opacity:1;fill:#80b3ff;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient529);stroke-width:1.99999988;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse868-5"
cx="-20.919643"
cy="1012.1926"
rx="11"
ry="4" /></g></g><g
inkscape:groupmode="layer"
id="layer13"
inkscape:label="combo_right"
transform="translate(0,-24)"><g
style="clip-rule:evenodd;display:inline;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="g139-3-7"
transform="matrix(0.00144041,0,0,0.00144041,-1.9945067,17.081448)"><polygon
style="fill:#ffffff"
id="polygon136-9-7"
points="17097,13927 13858,13927 13858,10715 17097,10715 "
class="fil6" /><path
style="fill:#595959;fill-rule:nonzero"
inkscape:connector-curvature="0"
d="m 17097,10944 h -3240 v -457 h 3240 l 237,229 -237,229 z m 0,-457 c 131,0 237,102 237,229 0,126 -106,229 -237,229 v -457 z m -237,3440 v -3212 h 474 v 3212 l -237,229 z m 474,0 c 0,126 -106,229 -237,229 -131,0 -237,-102 -237,-229 z m -3476,-229 h 3240 v 457 h -3240 l -237,-229 237,-229 z m 0,457 c -131,0 -237,-102 -237,-229 0,-126 106,-229 237,-229 v 457 z m 237,-3440 v 3212 h -474 v -3212 l 237,-229 z m -474,0 c 0,-126 106,-229 237,-229 131,0 237,102 237,229 z"
class="fil7"
id="1-7-9" /></g><polyline
style="clip-rule:evenodd;display:inline;fill:none;fill-rule:evenodd;stroke:#2a2720;stroke-width:428.55999756;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polyline153-5-5"
points="14525,11816 15485,12757 16400,11816 "
class="fil0 str0"
transform="matrix(0.00144041,0,0,0.00144041,-1.9945067,16.468478)" /></g><g
inkscape:groupmode="layer"
id="layer12"
inkscape:label="combo_left"
transform="translate(0,-24)"><g
style="clip-rule:evenodd;display:inline;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="g145-0-6"
transform="matrix(0.00144041,0,0,0.00144041,-1.9796157,17.071872)"><polygon
style="fill:#ffffff"
id="polygon141-2-8"
points="13877,13919 7460,13919 7460,10722 13877,10722 "
class="fil6" /><path
style="fill:#527596;fill-rule:nonzero"
inkscape:connector-curvature="0"
d="M 13877,10959 H 7460 v -475 h 6417 l 237,237 -237,237 z m 0,-475 c 131,0 237,106 237,237 0,131 -106,237 -237,237 v -475 z m -237,3435 v -3198 h 473 v 3198 l -237,237 -237,-237 z m 473,0 c 0,131 -106,237 -237,237 -131,0 -237,-106 -237,-237 h 473 z m -6653,-237 h 6417 v 475 H 7460 l -237,-237 237,-237 z m 0,475 c -131,0 -237,-106 -237,-237 0,-131 106,-237 237,-237 v 475 z m 237,-3435 v 3198 h -473 v -3198 l 237,-237 237,237 z m -473,0 c 0,-131 106,-237 237,-237 131,0 237,106 237,237 h -473 z"
class="fil8"
id="path143-5-2" /></g></g><g
inkscape:groupmode="layer"
id="layer7"
inkscape:label="calc 1"
style="display:inline"
transform="translate(0,-24)"><rect
style="fill:#e0e0e0;fill-opacity:1;fill-rule:evenodd;stroke:#2a59a1;stroke-width:0.75;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:normal"
id="rect894"
width="10.486398"
height="9.8193197"
x="9.1635008"
y="35.780254" /></g><g
inkscape:groupmode="layer"
id="layer8"
inkscape:label="calc 2"
style="display:inline"
transform="translate(0,-24)"><rect
style="fill:#2a59a1;fill-opacity:1;fill-rule:evenodd;stroke-width:0.55446738"
id="rect907"
width="10.265626"
height="1.796875"
x="9.2157078"
y="35.699528" /></g><g
inkscape:groupmode="layer"
id="layer9"
inkscape:label="calc 3"
style="display:inline"
transform="translate(0,-24)"><rect
style="fill:#ffffff;fill-rule:evenodd;stroke-width:0.5"
id="rect910"
width="7.5376391"
height="1.5469948"
x="10.627177"
y="38.074669" /></g><g
inkscape:groupmode="layer"
id="layer10"
inkscape:label="calc 4"
style="display:inline"
transform="translate(0,-24)"><rect
style="fill:#ff0000;fill-rule:evenodd;stroke-width:0.5"
id="rect913"
width="0.66690749"
height="0.66690749"
x="9.4777346"
y="36.102757" /></g><g
inkscape:groupmode="layer"
id="layer11"
inkscape:label="calc_sqr_big"
style="display:inline"
transform="translate(0,-24)"><polygon
style="clip-rule:evenodd;display:inline;fill:#483737;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0"
points="9410,16749 10318,16749 10318,17684 9410,17684 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,-2.9227096,16.562135)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#483737;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-4"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,-2.9227096,18.623355)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#483737;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-8"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,-0.86293033,16.562135)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#483737;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-7"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,-0.86148993,18.623355)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#483737;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-3"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,1.2155739,16.562135)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#483737;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-1"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,1.2184548,18.623355)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#d45500;fill-opacity:1;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-5"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,3.3041612,16.562135)" /><polygon
style="clip-rule:evenodd;display:inline;fill:#ff0000;fill-opacity:1;fill-rule:evenodd;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="polygon161-3-0-57"
points="10318,16749 10318,17684 9410,17684 9410,16749 "
class="fil13"
transform="matrix(0.00144041,0,0,0.00144041,3.3041612,18.623355)" /></g><g
inkscape:groupmode="layer"
id="layer1"
inkscape:label="calc_sqr_small"
style="display:none"
transform="translate(0,-24)"><rect
style="fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859"
id="rect899"
width="0.649728"
height="0.649728"
x="16.855944"
y="40.686085" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-2"
width="0.649728"
height="0.649728"
x="16.855944"
y="42.744507" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-21"
width="0.649728"
height="0.649728"
x="14.766273"
y="40.686085" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-5"
width="0.649728"
height="0.649728"
x="14.771102"
y="42.746429" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-3"
width="0.649728"
height="0.649728"
x="12.689289"
y="40.686085" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-217"
width="0.649728"
height="0.649728"
x="12.692027"
y="42.746429" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-1"
width="0.649728"
height="0.649728"
x="10.631672"
y="42.746429" /><rect
style="clip-rule:evenodd;fill:#ffffff;fill-rule:evenodd;stroke-width:0.59165859;image-rendering:optimizeQuality;shape-rendering:geometricPrecision;text-rendering:geometricPrecision"
id="rect899-7"
width="0.649728"
height="0.649728"
x="10.631672"
y="40.686085" /></g><g
inkscape:groupmode="layer"
id="layer2"
inkscape:label="text"
transform="translate(0,-24)">
<flowRoot
xml:space="preserve"
id="flowRoot914-84"
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:12px;line-height:1.25;font-family:'Arial Unicode MS';-inkscape-font-specification:'Arial Unicode MS';letter-spacing:0px;word-spacing:0px;fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"
transform="matrix(0.46354284,0,0,0.55114772,-1.2832947,23.859648)"><flowRegion
id="flowRegion916-4"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"><rect
id="rect918-7"
width="38.14209"
height="34.674625"
x="3.4674628"
y="-1.8781176"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill" /></flowRegion><flowPara
id="flowPara920-5"
style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:21.33333397px;font-family:Arial;-inkscape-font-specification:'Arial Bold';stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill">Rx</flowPara></flowRoot></g></svg>

After

Width:  |  Height:  |  Size: 20 KiB

View File

@@ -0,0 +1,33 @@
/* XPM */
static char *TCURRENCYEDIT[]={
"24 24 6 1",
". c None",
"a c #000000",
"d c #0000ff",
"# c #808080",
"c c #c0c0c0",
"b c #ffffff",
"........................",
"........................",
"........................",
"........................",
"#######################.",
"#aaaaaaaaaaaaaaaaaaaaab.",
"#abbbbbbbbbbbbbbbbbbbcb.",
"#abbbbbbbbbbbbbaabaabcb.",
"#abbbbbbbbbbbbbbbabbbcb.",
"#abbbbdbbbbbdbbbbabbbcb.",
"#abbbddddbbddbbbbabbbcb.",
"#abbdbdbbbbbdbbbbabbbcb.",
"#abbbdddbbbbdbbbbabbbcb.",
"#abbbbdbdbbbdbbbbabbbcb.",
"#abbddddbbbbdbbbbabbbcb.",
"#abbbbdbbbbdddbbbabbbcb.",
"#abbbbbbbbbbbbbaabaabcb.",
"#abbbbbbbbbbbbbbbbbbbcb.",
"#accccccccccccccccccccb.",
"#bbbbbbbbbbbbbbbbbbbbbb.",
"........................",
"........................",
"........................",
"........................"};

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.2 KiB

View File

@@ -0,0 +1,34 @@
unit AboutUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
StdCtrls;
type
{ TAboutForm }
TAboutForm = class(TForm)
BitBtn1: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
private
{ private declarations }
public
{ public declarations }
end;
var
AboutForm: TAboutForm;
implementation
{$R *.lfm}
end.

View File

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

View File

@@ -0,0 +1,231 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="11">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos Y="20"/>
<UsageCount Value="34"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<TopLine Value="3"/>
<CursorPos X="105" Y="24"/>
<UsageCount Value="34"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../fpspreadsheet/fpspreadsheet.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="874"/>
<CursorPos X="78" Y="863"/>
<UsageCount Value="15"/>
</Unit2>
<Unit3>
<Filename Value="unit1.lfm"/>
<EditorIndex Value="-1"/>
<TopLine Value="223"/>
<CursorPos X="56" Y="250"/>
<UsageCount Value="9"/>
<DefaultSyntaxHighlighter Value="LFM"/>
</Unit3>
<Unit4>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<UnitName Value="RxDBGridExportSpreadSheet"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="197"/>
<CursorPos X="37" Y="210"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../rxdbgrid.pas"/>
<EditorIndex Value="4"/>
<TopLine Value="4700"/>
<CursorPos Y="4718"/>
<UsageCount Value="16"/>
<Bookmarks Count="2">
<Item0 X="14" Y="822" ID="1"/>
<Item1 X="48" Y="622" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="../../../fpspreadsheet/fpsstrings.pas"/>
<UnitName Value="fpsStrings"/>
<EditorIndex Value="-1"/>
<CursorPos X="88" Y="14"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="../../rxdbgridexportspreadsheet_paramsunit.pas"/>
<ComponentName Value="RxDBGridExportSpreadSheet_ParamsForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="RxDBGridExportSpreadSheet_ParamsUnit"/>
<EditorIndex Value="2"/>
<TopLine Value="51"/>
<CursorPos X="33" Y="85"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit7>
<Unit8>
<Filename Value="../../rxdconst.pas"/>
<EditorIndex Value="3"/>
<TopLine Value="173"/>
<CursorPos X="21" Y="185"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="../../../../lcl/include/control.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1075"/>
<CursorPos Y="1091"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="../../../../lcl/controls.pp"/>
<UnitName Value="Controls"/>
<EditorIndex Value="-1"/>
<TopLine Value="316"/>
<CursorPos X="5" Y="330"/>
<UsageCount Value="10"/>
</Unit10>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="22" Column="5" TopLine="3"/>
</Position1>
<Position2>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="443" Column="3" TopLine="439"/>
</Position2>
<Position3>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="63" Column="30" TopLine="54"/>
</Position3>
<Position4>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="504" Column="3" TopLine="500"/>
</Position4>
<Position5>
<Filename Value="../../rxdbgridexportspreadsheet_paramsunit.pas"/>
<Caret Line="46" Column="3" TopLine="27"/>
</Position5>
<Position6>
<Filename Value="../../rxdbgridexportspreadsheet_paramsunit.pas"/>
<Caret Line="85" Column="33" TopLine="51"/>
</Position6>
<Position7>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="504" Column="3" TopLine="500"/>
</Position7>
<Position8>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="47" Column="7" TopLine="23"/>
</Position8>
<Position9>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="273" TopLine="250"/>
</Position9>
<Position10>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="329" TopLine="323"/>
</Position10>
<Position11>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="204" Column="3" TopLine="173"/>
</Position11>
<Position12>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="129" Column="3" TopLine="108"/>
</Position12>
<Position13>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="135" Column="9" TopLine="115"/>
</Position13>
<Position14>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="138" Column="7" TopLine="118"/>
</Position14>
<Position15>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="140" Column="7" TopLine="120"/>
</Position15>
<Position16>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="146" Column="11" TopLine="127"/>
</Position16>
<Position17>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="149" Column="13" TopLine="131"/>
</Position17>
<Position18>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="173" Column="11" TopLine="154"/>
</Position18>
<Position19>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="224" Column="11" TopLine="194"/>
</Position19>
<Position20>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="227" Column="13" TopLine="209"/>
</Position20>
<Position21>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="63" Column="24" TopLine="45"/>
</Position21>
<Position22>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="134" TopLine="116"/>
</Position22>
<Position23>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="168" Column="9" TopLine="147"/>
</Position23>
<Position24>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="174" TopLine="164"/>
</Position24>
<Position25>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="126" Column="38" TopLine="107"/>
</Position25>
<Position26>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="63" Column="15" TopLine="44"/>
</Position26>
<Position27>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="171" Column="59" TopLine="152"/>
</Position27>
<Position28>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="134" TopLine="126"/>
</Position28>
<Position29>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="203" Column="16" TopLine="184"/>
</Position29>
<Position30>
<Filename Value="../../rxdbgridexportspreadsheet.pas"/>
<Caret Line="193" TopLine="193"/>
</Position30>
</JumpHistory>
</ProjectSession>
</CONFIG>

View File

@@ -0,0 +1,148 @@
<?xml version="1.0" encoding="UTF-8"?>
<fpdoc-descriptions><package name="rxnew">
<module name="rxlookup">
<element name="TRxLookupEdit">
<short>TRxLookupEdit Component</short>
<descr>
<p>Компонента TRxLookupEdit представляет собой редактор с возможностью как прямого ввода текста пользователем в строке редактирования, так и выбора текста из выпадающего списка, заполняемого значениями из базы данных. При открытом списке набор пользователем символов с клавиатуры приводит к позиционированию списка на ближайшую запись, совпадающую с введенным текстом. </p>
<p>Для заполнения выпадающего списка используются свойства LookupSource, LookupField, LookupDisplay и LookupDisplayIndex, аналогично списку компоненты TRxDBLookupCombo. </p>
<p>Введенное пользователем или выбранное из списка значение доступно через свойство Text.
Свойство LookupValue (read-only) позволяет получить значение ключевого поля из lookup-набора данных (заданного свойством LookupField), если пользвателем был сделан выбор из списка.</p>
</descr>
</element>
<element name="TRxLookupEdit.Create"/>
<element name="TRxLookupEdit.Destroy"/>
<element name="TRxLookupEdit.DropDownCount"/>
<element name="TRxLookupEdit.DropDownWidth"/>
<element name="TRxLookupEdit.LookupDisplay"/>
<element name="TRxLookupEdit.LookupDisplayIndex">
<descr>В случае, если свойство <link id="TRxLookupEdit.LookupDisplay">LookupDisplay</link> задает более одного поля для отображения в списке, значение свойства LookupDisplayIndex определяет номер поля, значение которого возвращается свойством DisplayValue.</descr>
</element>
<element name="TRxLookupEdit.LookupField"/>
<element name="TRxLookupEdit.LookupSource"/>
<element name="TRxLookupEdit.PopUpFormOptions"/>
<element name="TRxDBLookupCombo">
<short>TRxDBLookupCombo Component</short>
<descr>Unit
RxLookup
Description
Компонента TRxDBLookupCombo почти полностью аналогична стандартной компоненте из VCL TDBLookupCombo и имеет те же самые свойства, методы и события. Однако по сравнению с TDBLookupCombo у этой компоненты есть некоторые дополнительные возможности и свойства.
TRxDBLookupCombo позволяет использовать в качестве LookupSource любой источник данных - как TTable, так и TQuery, при этом свойство LookupField не обязательно должно быть индексированным полем.
Компонента TRxDBLookupCombo также позволяет производить поиск нужного термина при наборе первых букв этого термина.
Например, у вас имеется таблица или результат запроса, седержащий поля CustNo и CustName. Тогда вы можете указать поле CustName как значение свойства LookupDisplay. Если пользователь вашего приложения наберет первые буквы нужной ему фамилии (находящейся в поле CustName), то если компонента TRxDBLookupCombo имеет фокус ввода, автоматически выпадет список доступных значений и выделенный элемент в списке установится в значение, первые буквы которого совпадают с введенными пользователем.
Если свойство IgnoreCase установлено в True, то при наборе пользователем первых букв термина регистр символов не учитывается. Надо иметь в виду, что при работе с русскоязычными значениями в полях БД не все драйвера поддерживают преобразование регистра символов.
Свойство IndexSwitch определяет, будет ли при необходимости производиться переключение индексов таблицы (если источником данных служит таблица, а не результат запроса). В случае использования больших SQL-таблиц переключение индексов может занять длительное время, поэтому в таких случаях свойство желательно устанавливать в значение False.
Свойтсво DisplayEmpty позволяет задать текстовую строку для отображения в строке TRxDBLookupCombo, когда не сделано никакого выбора. Вызов метода ResetField приводит к очистке содержимого компоненты, устоновке значения Value в пустую строку, и отображению значения DisplayEmpty.
В дополнение к событию OnDropDown, имеющемуся у TDBLookupCombo, компонента имеет событие OnCloseUp, вызываемое при закрытии выпадающего списка. Метод IsDropDown позволяет определить текущее состояние выпадающего списка выбора. Событие OnChange происходит при смене значения cвойства Value.
Компонента также позволяет задать изображения для рисования в левой части каждой строки списка, в зависимости от содержимого полей БД, с помощью события OnGetImage.
В остальном компонента TRxDBLookupCombo полностью аналогична компоненте TDBLookupCombo.
ВНИМАНИЕ
При присвоении значений свойству Value или DisplayValue компонент TRxDBLookupCombo или TRxDBLookupList безошибочное позиционирование на соответствующую запись в списке произойдет только в том случае, если соответствующее поле в подмножестве записей, заданном источником данных DataSource, имеет только уникальные неповторяющиеся значения. В противном случае Вы получите несколько "выбранных" элементов в списке (причем реально будет выбран только один самый первый), значения полей в которых равны заданному. Избегайте таких ситуаций!
При работе с некоторыми SQL-серверами БД установка свойств IndexSwitch или IgnoreCase в значение True может приводить к неожиданному поведению компоненты. В этом случае постарайтесь добиться "правильного" поведения за счет комбинирования разных значений свойств IgnoreCase и IndexSwitch.</descr>
</element>
<element name="TRxDBLookupCombo.PopupVisible"/>
<element name="TRxDBLookupCombo.Value"/>
<element name="TRxDBLookupCombo.KeyValue"/>
<element name="TRxDBLookupCombo.AutoSize"/>
<element name="TRxDBLookupCombo.Align"/>
<element name="TRxDBLookupCombo.Anchors"/>
<element name="TRxDBLookupCombo.BorderSpacing"/>
<element name="TRxDBLookupCombo.ButtonOnlyWhenFocused"/>
<element name="TRxDBLookupCombo.ButtonWidth"/>
<element name="TRxDBLookupCombo.Color"/>
<element name="TRxDBLookupCombo.DataField"/>
<element name="TRxDBLookupCombo.DataSource"/>
<element name="TRxDBLookupCombo.DirectInput"/>
<element name="TRxDBLookupCombo.DragCursor"/>
<element name="TRxDBLookupCombo.DragMode"/>
<element name="TRxDBLookupCombo.Enabled"/>
<element name="TRxDBLookupCombo.PopUpFormOptions"/>
<element name="TRxDBLookupCombo.Flat"/>
<element name="TRxDBLookupCombo.Font"/>
<element name="TRxDBLookupCombo.Glyph"/>
<element name="TRxDBLookupCombo.EmptyValue">
<short>property EmptyValue: string;</short>
<descr>Свойство задает значение, присвоение которого свойству Value будет восприниматься как присвоение "пустого" значения и приведет к очистке DataField. По умолчанию значение свойства есть пустая строка.</descr>
</element>
<element name="TRxDBLookupCombo.EmptyItemColor">
<short>property EmptyItemColor: TColor;</short>
<descr>Свойство задает значение цвета, которым будет рисоваться дополнительный нескролируемый элемент списка для "пустого" значения (т.е. которое совпадает с DisplayEmpty).</descr>
</element>
<element name="TRxDBLookupCombo.NumGlyphs"/>
<element name="TRxDBLookupCombo.OnButtonClick"/>
<element name="TRxDBLookupCombo.OnChange"/>
<element name="TRxDBLookupCombo.OnClick"/>
<element name="TRxDBLookupCombo.OnDblClick"/>
<element name="TRxDBLookupCombo.OnDragDrop"/>
<element name="TRxDBLookupCombo.OnDragOver"/>
<element name="TRxDBLookupCombo.OnEndDrag"/>
<element name="TRxDBLookupCombo.OnEnter"/>
<element name="TRxDBLookupCombo.OnExit"/>
<element name="TRxDBLookupCombo.OnKeyDown"/>
<element name="TRxDBLookupCombo.OnKeyPress"/>
<element name="TRxDBLookupCombo.OnKeyUp"/>
<element name="TRxDBLookupCombo.OnMouseDown"/>
<element name="TRxDBLookupCombo.OnMouseMove"/>
<element name="TRxDBLookupCombo.OnMouseUp"/>
<element name="TRxDBLookupCombo.OnStartDrag"/>
<element name="TRxDBLookupCombo.OnGetGridCellProps"/>
<element name="TRxDBLookupCombo.OnSelect"/>
<element name="TRxDBLookupCombo.ParentColor"/>
<element name="TRxDBLookupCombo.ParentFont"/>
<element name="TRxDBLookupCombo.ParentShowHint"/>
<element name="TRxDBLookupCombo.PopupMenu"/>
<element name="TRxDBLookupCombo.ReadOnly"/>
<element name="TRxDBLookupCombo.ShowHint"/>
<element name="TRxDBLookupCombo.TabOrder"/>
<element name="TRxDBLookupCombo.TabStop"/>
<element name="TRxDBLookupCombo.Visible"/>
<element name="TRxDBLookupCombo.DisplayAllFields"/>
<element name="TRxDBLookupCombo.DropDownCount"/>
<element name="TRxDBLookupCombo.DropDownWidth"/>
<element name="TRxDBLookupCombo.LookupDisplay"/>
<element name="TRxDBLookupCombo.LookupDisplayIndex"/>
<element name="TRxDBLookupCombo.LookupField"/>
<element name="TRxDBLookupCombo.LookupSource"/>
<element name="TRxDBLookupCombo.UnfindedValue"/>
<descr>
<p>The RxLookup unit contains the declarations for the certain components on the RX DBAware page of the Component palette and their associated objects, types, and constants.
When you add a component declared in this unit to a form, the unit is automatically added to the uses clause of that form's unit.</p>
</descr>
<element name="TRxLookupEdit.OnClosePopup">
<descr>Событие возникает при закрытии PopUp окна выбора данных.</descr>
</element>
<element name="TRxDBLookupCombo.OnClosePopup">
<descr>Событие возникает при закрытии PopUp окна выбора данных.</descr>
</element>
</module>
<module name="dbdateedit">
<element name="TDBDateEdit">
<descr>Компонента TDBDateEdit - ориентированная на работу с базами данных компонента для редактирования даты. Установленное значение свойства Date становится новым значением поля в БД, если значение свойства ReadOnly компоненты TDBDateEdit - False.
TDBDateEdit является наследником TDateEdit и имеет все те же свойства и методы, и дополнительно имеет свойства, необходимые для работы с полями базы данных.
Компонента TDBDateEdit может быть применена к тем полям наборов данных, которые позволяют чтение и присвоение значений через свойство AsDateTime.</descr>
</element>
<element name="TDBDateEdit.Create"/>
<element name="TDBDateEdit.Destroy"/>
<element name="TDBDateEdit.DataField"/>
<element name="TDBDateEdit.DataSource"/>
<element name="TDBDateEdit.ReadOnly"/>
<element name="TDBDateEdit.DefaultToday">
<descr>Свойство DialogTitle задает заголовок диалогового окна, появляющегося при нажатии на кнопку компоненты TFilenameEdit (TOpenDialog) или TDateEdit, TDBDateEdit (диалог выбора даты).</descr>
</element>
<element name="TRxDBCalcEdit">
<descr>Компонента TRxDBCalcEdit - ориентированная на работу с базами данных компонента для редактирования чисел с возможностью импользования выпадающего калькулятора. Установленное значение свойства Value становится новым значением поля в БД, если значение свойства ReadOnly - False.
TRxDBCalcEdit является наследником TDBCalcEdit и имеет все те же свойства и методы, и дополнительно имеет свойства, необходимые для работы с полями базы данных.
Компонента TRxDBCalcEdit может быть применена к тем полям данных, которые позволяют чтение и присвоение значений через свойства AsFloat, AsInteger.</descr>
</element>
<element name="TRxDBCalcEdit.Create"/>
<element name="TRxDBCalcEdit.Destroy"/>
<element name="TRxDBCalcEdit.DataField"/>
<element name="TRxDBCalcEdit.DataSource"/>
<element name="TRxDBCalcEdit.ReadOnly"/>
</module>
</package>
</fpdoc-descriptions>

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.2 KiB

View File

@@ -0,0 +1,417 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
width="36"
height="36"
viewBox="0 0 36 36"
version="1.1"
id="svg106"
inkscape:version="0.92.3 (2405546, 2018-03-11)"
sodipodi:docname="tdbgridfootertools_rx_150.svg"
inkscape:export-filename="D:\temp\rx\work\tdbgridfootertools_rx_200.png"
inkscape:export-xdpi="96"
inkscape:export-ydpi="96">
<defs
id="defs100">
<marker
inkscape:stockid="Arrow1Lstart"
orient="auto"
refY="0"
refX="0"
id="marker4874"
style="overflow:visible"
inkscape:isstock="true">
<path
id="path4872"
d="M 0,0 5,-5 -12.5,0 5,5 Z"
style="fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:1.00000003pt;stroke-opacity:1"
transform="matrix(0.8,0,0,0.8,10,0)"
inkscape:connector-curvature="0" />
</marker>
<marker
inkscape:stockid="Arrow1Lstart"
orient="auto"
refY="0"
refX="0"
id="Arrow1Lstart"
style="overflow:visible"
inkscape:isstock="true">
<path
id="path4596"
d="M 0,0 5,-5 -12.5,0 5,5 Z"
style="fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:1.00000003pt;stroke-opacity:1"
transform="matrix(0.8,0,0,0.8,10,0)"
inkscape:connector-curvature="0" />
</marker>
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient226"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(2.6738333,0,0,2.6668794,-36.876405,-1737.3306)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
<linearGradient
inkscape:collect="always"
id="linearGradient914">
<stop
style="stop-color:#4276c4;stop-opacity:1;"
offset="0"
id="stop910" />
<stop
id="stop916"
offset="0.34375"
style="stop-color:#80b3ff;stop-opacity:1" />
<stop
style="stop-color:#0044aa;stop-opacity:1"
offset="1"
id="stop912" />
</linearGradient>
<linearGradient
gradientTransform="matrix(2.6738333,0,0,2.6668794,-36.876405,-1745.3312)"
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientUnits="userSpaceOnUse"
id="linearGradient932"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientTransform="matrix(2.6738333,0,0,2.6668794,-36.876405,-1753.3316)"
gradientUnits="userSpaceOnUse"
id="linearGradient936"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient208"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(2.6738333,0,0,2.6668794,-36.876405,-1737.3306)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
<pattern
y="0"
x="0"
height="6"
width="6"
patternUnits="userSpaceOnUse"
id="EMFhbasepattern" />
<filter
inkscape:collect="always"
style="color-interpolation-filters:sRGB"
id="filter1132"
x="-0.052477613"
width="1.1049552"
y="-0.044226415"
height="1.0884528">
<feGaussianBlur
inkscape:collect="always"
stdDeviation="0.36625"
id="feGaussianBlur1134" />
</filter>
</defs>
<sodipodi:namedview
id="base"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageopacity="0.0"
inkscape:pageshadow="2"
inkscape:zoom="22.805556"
inkscape:cx="18"
inkscape:cy="18"
inkscape:document-units="px"
inkscape:current-layer="layer7"
showgrid="true"
units="px"
inkscape:window-width="1920"
inkscape:window-height="1018"
inkscape:window-x="-8"
inkscape:window-y="-8"
inkscape:window-maximized="1"
showguides="true"
inkscape:guide-bbox="true"
inkscape:snap-grids="false"
inkscape:snap-global="true"
inkscape:snap-nodes="false"
inkscape:snap-others="false"
inkscape:snap-to-guides="true">
<inkscape:grid
type="xygrid"
id="grid108" />
</sodipodi:namedview>
<metadata
id="metadata103">
<rdf:RDF>
<cc:Work
rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
<dc:title />
</cc:Work>
</rdf:RDF>
</metadata>
<g
inkscape:label="base"
inkscape:groupmode="layer"
id="layer1"
transform="translate(0,-296.29999)"
style="display:inline">
<rect
style="fill:none;fill-rule:evenodd;stroke-width:0.65635943"
id="rect110"
width="35.903511"
height="35.997128"
x="-0.0323417"
y="296.30386" />
</g>
<g
inkscape:groupmode="layer"
id="layer2"
inkscape:label="db"
style="display:inline"
transform="translate(0,-12)">
<g
style="display:inline"
id="g899"
transform="matrix(0.74798979,0,0,0.74994014,27.583175,-741.8303)">
<ellipse
ry="3"
rx="10"
cy="1030.1925"
cx="-20.919643"
id="ellipse880"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient208);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1026.2755"
cx="-20.919643"
id="ellipse878"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient932);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse930"
cx="-20.919643"
cy="1024.1925"
rx="10"
ry="3" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse874"
cx="-20.919643"
cy="1020.2756"
rx="10.988618"
ry="3.9169633" />
<ellipse
ry="3"
rx="10"
cy="1018.1926"
cx="-20.919643"
id="ellipse934"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient936);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1014.2756"
cx="-20.919643"
id="ellipse858"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#80b3ff;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient226);stroke-width:1.99999988;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse868"
cx="-20.919643"
cy="1012.1926"
rx="11"
ry="4" />
</g>
</g>
<g
inkscape:groupmode="layer"
id="layer3"
inkscape:label="dbgrid"
style="display:inline"
transform="translate(0,-12)">
<rect
style="fill:#ffffff;fill-rule:evenodd;stroke:#4d4d4d;stroke-width:1.49792862;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
id="rect861"
width="23.910383"
height="17.818579"
x="9.7584019"
y="27.919556" />
</g>
<g
inkscape:groupmode="layer"
id="layer8"
inkscape:label="dbgrid_vert"
style="display:inline;opacity:1"
transform="translate(0,-12)">
<rect
style="fill:#e6e6e6;fill-opacity:1;fill-rule:evenodd;stroke:#4d4d4d;stroke-width:1.4979285;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:normal"
id="rect863"
width="4.4729791"
height="17.817829"
x="9.7536087"
y="27.901461" />
</g>
<g
inkscape:groupmode="layer"
id="layer5"
inkscape:label="dbgrid_hor"
style="display:inline"
transform="translate(0,-12)">
<rect
style="opacity:1;fill:#e6e6e6;fill-rule:evenodd;stroke:#4d4d4d;stroke-width:1.49602759;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
id="rect896"
width="23.91214"
height="4.3560567"
x="9.7571468"
y="27.897907" />
</g>
<g
inkscape:groupmode="layer"
id="layer10"
inkscape:label="dbgrid_hor2"
style="display:inline"
transform="translate(0,-12)">
<path
style="fill:none;stroke:#000000;stroke-width:1.49792838;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 16.329935,35.123853 h 4.571457 v 0"
id="path869"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:1.49792838;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 16.329935,38.123606 h 4.571457 v 0"
id="path869-2"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:1.49792862;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 25.399311,35.128202 h 5.98392 v 0"
id="path869-7"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:1.49792874;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 25.399315,38.111174 h 4.413139 v 0"
id="path869-7-4"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer11"
inkscape:label="footer"
style="opacity:1"
transform="translate(0,-12)">
<rect
style="fill:#ffff00;fill-rule:evenodd;stroke-width:0.81352651"
id="rect974"
width="22.423237"
height="2.2355716"
x="10.497952"
y="42.730511" />
</g>
<g
inkscape:groupmode="layer"
id="layer12"
inkscape:label="footer_hor"
transform="translate(0,-12)">
<path
style="fill:none;stroke:#4d4d4d;stroke-width:1.49792874;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="M 9.2457628,42.060418 H 32.146348 v 0.01828"
id="path994"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer9"
inkscape:label="dbgrid_vert1"
style="display:inline"
transform="translate(0,-12)">
<path
style="fill:none;stroke:#4d4d4d;stroke-width:1.49792874;stroke-linecap:square;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="M 23.155342,32.252262 V 45.001245"
id="path866"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#4d4d4d;stroke-width:1.49792874;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 14.227545,42.400701 v 3.050457 0 0.100014"
id="path996"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer14"
inkscape:label="sign_matte"
transform="translate(0,-12)">
<rect
style="fill:#ffffff;fill-rule:evenodd;stroke-width:1.06829309;filter:url(#filter1132)"
id="rect1030"
width="16.75"
height="19.875"
x="0.75"
y="27.25"
rx="3.1653543"
ry="3.2448978"
transform="matrix(0.74798979,0,0,0.74994014,-0.0323417,12.003878)" />
</g>
<g
inkscape:groupmode="layer"
id="layer13"
inkscape:label="sign"
transform="translate(0,-12)">
<text
xml:space="preserve"
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:47.74591446px;line-height:1.25;font-family:Aharoni;-inkscape-font-specification:Aharoni;letter-spacing:0px;word-spacing:0px;fill:#ff0000;fill-opacity:1;stroke:#9f0303;stroke-width:1.05529428;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"
x="1.5872973"
y="46.481281"
id="text994"
transform="scale(1.0173988,0.98289872)"><tspan
sodipodi:role="line"
id="tspan992"
x="1.5872973"
y="46.481281"
style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:17.02051163px;font-family:'Book Antiqua';-inkscape-font-specification:'Book Antiqua Bold';fill:#ff0000;stroke:#9f0303;stroke-width:1.05529428;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill">Σ</tspan></text>
</g>
<g
inkscape:groupmode="layer"
id="layer7"
inkscape:label="text"
style="display:inline"
transform="translate(0,-12)">
<flowRoot
xml:space="preserve"
id="flowRoot914-8"
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:12px;line-height:1.25;font-family:'Arial Unicode MS';-inkscape-font-specification:'Arial Unicode MS';letter-spacing:0px;word-spacing:0px;fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"
transform="matrix(0.69531429,0,0,0.82672154,-2.2079422,11.788973)"
inkscape:export-xdpi="96"
inkscape:export-ydpi="96"><flowRegion
id="flowRegion916-5"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"><rect
id="rect918-0"
width="38.14209"
height="34.674625"
x="3.4674628"
y="-1.8781176"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill" /></flowRegion><flowPara
id="flowPara920-2"
style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:21.33333397px;font-family:Arial;-inkscape-font-specification:'Arial Bold';stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill">Rx</flowPara></flowRoot> </g>
</svg>

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 969 B

View File

@@ -0,0 +1,247 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="12">
<Unit0>
<Filename Value="WordWrapDemo.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="31"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<TopLine Value="57"/>
<CursorPos X="3" Y="63"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="504"/>
<CursorPos X="20" Y="518"/>
<UsageCount Value="16"/>
<Bookmarks Count="4">
<Item0 X="7" Y="4721" ID="3"/>
<Item1 Y="616" ID="4"/>
<Item2 X="3" Y="4998" ID="1"/>
<Item3 X="49" Y="362" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../../../../lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<EditorIndex Value="4"/>
<TopLine Value="2880"/>
<CursorPos Y="2901"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../../../../../lcl/grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="5"/>
<TopLine Value="2482"/>
<CursorPos X="3" Y="2484"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<EditorIndex Value="3"/>
<TopLine Value="1560"/>
<CursorPos X="15" Y="1578"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/datasource.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="199"/>
<CursorPos X="3" Y="202"/>
<UsageCount Value="8"/>
</Unit6>
<Unit7>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/dataset.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1284"/>
<CursorPos X="3" Y="1287"/>
<UsageCount Value="8"/>
</Unit7>
<Unit8>
<Filename Value="../../../../../lcl/include/wincontrol.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="5739"/>
<CursorPos Y="5757"/>
<UsageCount Value="8"/>
</Unit8>
<Unit9>
<Filename Value="../../../../../lcl/include/winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="929"/>
<CursorPos Y="949"/>
<UsageCount Value="8"/>
</Unit9>
<Unit10>
<Filename Value="/home/install/source/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="473"/>
<CursorPos X="3" Y="480"/>
<UsageCount Value="10"/>
</Unit10>
<Unit11>
<Filename Value="/home/install/source/fpcsrc/rtl/objpas/classes/collect.inc"/>
<EditorIndex Value="2"/>
<TopLine Value="289"/>
<CursorPos X="3" Y="291"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit11>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="6448" Column="54" TopLine="6435"/>
</Position1>
<Position2>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="5032" Column="9" TopLine="5000"/>
</Position2>
<Position3>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="4943" Column="17" TopLine="4928"/>
</Position3>
<Position4>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="5053" Column="3" TopLine="5021"/>
</Position4>
<Position5>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="5058" TopLine="5024"/>
</Position5>
<Position6>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="5051" Column="35" TopLine="5041"/>
</Position6>
<Position7>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="796" Column="15" TopLine="780"/>
</Position7>
<Position8>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="362" Column="49" TopLine="342"/>
</Position8>
<Position9>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="589" TopLine="570"/>
</Position9>
<Position10>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="362" Column="49" TopLine="343"/>
</Position10>
<Position11>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="5042" Column="33" TopLine="5037"/>
</Position11>
<Position12>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="5116" Column="40" TopLine="5038"/>
</Position12>
<Position13>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="515" Column="48" TopLine="490"/>
</Position13>
<Position14>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="522" Column="21" TopLine="496"/>
</Position14>
<Position15>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="525" Column="76" TopLine="493"/>
</Position15>
<Position16>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="1173" TopLine="1168"/>
</Position16>
<Position17>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="474" Column="49" TopLine="448"/>
</Position17>
<Position18>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="2057" Column="3" TopLine="2055"/>
</Position18>
<Position19>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="535" Column="56" TopLine="509"/>
</Position19>
<Position20>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="1176" Column="3" TopLine="1173"/>
</Position20>
<Position21>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="471" Column="15" TopLine="466"/>
</Position21>
<Position22>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="2063" TopLine="2060"/>
</Position22>
<Position23>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="535" Column="65" TopLine="470"/>
</Position23>
<Position24>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="530" Column="58" TopLine="528"/>
</Position24>
<Position25>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="1176" Column="3" TopLine="1174"/>
</Position25>
<Position26>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="471" Column="14" TopLine="453"/>
</Position26>
<Position27>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="2069" TopLine="2066"/>
</Position27>
<Position28>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="530" Column="14" TopLine="499"/>
</Position28>
<Position29>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="1176" Column="21" TopLine="1174"/>
</Position29>
<Position30>
<Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="529" Column="3" TopLine="512"/>
</Position30>
</JumpHistory>
</ProjectSession>
<Debugging>
<Watches Count="2">
<Item1>
<Expression Value="H1"/>
</Item1>
<Item2>
<Expression Value="H"/>
</Item2>
</Watches>
</Debugging>
</CONFIG>

View File

@@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, lazcontrols, Unit1
{ you can add units after this };
{$R *.res}
begin
Application.Title:='RxViewsPanel demo';
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@@ -0,0 +1,567 @@
object Form1: TForm1
Left = 558
Height = 397
Top = 319
Width = 1043
Caption = 'Form1'
ClientHeight = 397
ClientWidth = 1043
OnClose = FormClose
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 0
Height = 50
Top = 347
Width = 1043
Align = alBottom
AutoSize = True
ClientHeight = 50
ClientWidth = 1043
TabOrder = 0
object Button1: TButton
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Panel1
Left = 477
Height = 36
Top = 7
Width = 88
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Create PDF'
OnClick = Button1Click
TabOrder = 0
end
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Button1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 571
Height = 24
Top = 13
Width = 105
Caption = 'Enable tools'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 1
end
end
object PageControl1: TPageControl
Left = 0
Height = 347
Top = 0
Width = 1043
ActivePage = TabSheet1
Align = alClient
TabIndex = 0
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Test data'
ClientHeight = 313
ClientWidth = 1033
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 313
Top = 0
Width = 1033
ColumnDefValues.BlobText = '(данные)'
TitleButtons = True
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID'
Width = 50
FieldName = 'ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Color = clSkyBlue
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Дата поставки'
Width = 120
FieldName = 'PDATE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Color = clCream
Font.Color = clPurple
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Наименование продукта'
Width = 364
FieldName = 'NAME'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Alignment = taRightJustify
Footer.Value = 'Итого:'
Footer.ValueType = fvtStaticText
Footers = <
item
Alignment = taRightJustify
Value = 'Итого:'
ValueType = fvtStaticText
end
item
Alignment = taRightJustify
Value = 'Минимум:'
ValueType = fvtStaticText
end
item
Alignment = taRightJustify
Value = 'Максимум:'
ValueType = fvtStaticText
end>
WordWrap = True
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Сумма'
Width = 100
FieldName = 'SUM'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Alignment = taRightJustify
Footer.DisplayFormat = '#,##0.00'
Footer.FieldName = 'SUM'
Footer.ValueType = fvtSum
Footers = <
item
Alignment = taRightJustify
DisplayFormat = '#,##0.00'
FieldName = 'SUM'
ValueType = fvtSum
end
item
Alignment = taRightJustify
DisplayFormat = '#,##0.00'
FieldName = 'SUM'
ValueType = fvtMin
end
item
Alignment = taRightJustify
DisplayFormat = '#,##0.00'
FieldName = 'SUM'
ValueType = fvtMax
end>
end
item
Alignment = taCenter
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Статус'
Width = 60
FieldName = 'FLAG'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
ImageList = ImageList1
KeyList.Strings = (
'0=0'
'1=1'
'2=2'
'3=3'
)
end
item
Alignment = taCenter
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Адрес|Страна'
Width = 200
FieldName = 'Country'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'Адрес|Город'
Width = 200
FieldName = 'Sity'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.NotEmptyValue = '(Не пусто)'
Filter.AllValue = '(All values)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.Active = True
FooterOptions.Color = clYellow
FooterOptions.RowCount = 3
FooterOptions.DrawFullLine = True
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgFooterRows, rdgAllowQuickFilter, rdgAllowToolMenu, rdgWordWrap]
FooterColor = clYellow
FooterRowCount = 3
Align = alClient
Color = clWindow
DrawFullLine = True
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = DataSource1
Flat = True
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgHeaderPushedLook]
TabOrder = 0
TitleStyle = tsNative
end
end
object TabSheet2: TTabSheet
Caption = 'Debug window'
ClientHeight = 313
ClientWidth = 1033
object Memo1: TMemo
Left = 0
Height = 313
Top = 0
Width = 1033
Align = alClient
Lines.Strings = (
'Memo1'
)
TabOrder = 0
end
end
end
object RxMemoryData1: TRxMemoryData
FieldDefs = <
item
Name = 'ID'
DataType = ftAutoInc
Precision = -1
end
item
Name = 'NAME'
DataType = ftString
Precision = -1
Size = 220
end
item
Name = 'PDATE'
DataType = ftDate
Precision = -1
end
item
Name = 'SUM'
DataType = ftCurrency
Precision = 2
end
item
Name = 'Country'
DataType = ftString
Precision = -1
Size = 100
end
item
Name = 'Sity'
DataType = ftString
Precision = -1
Size = 100
end
item
Name = 'FLAG'
DataType = ftInteger
end>
PacketRecords = 0
Left = 136
Top = 88
object RxMemoryData1ID: TAutoIncField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object RxMemoryData1NAME: TStringField
FieldKind = fkData
FieldName = 'NAME'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 220
end
object RxMemoryData1PDATE: TDateField
FieldKind = fkData
FieldName = 'PDATE'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
DisplayFormat = 'dd.mm.yyyy'
end
object RxMemoryData1SUM: TCurrencyField
FieldKind = fkData
FieldName = 'SUM'
Index = 3
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Precision = 2
end
object RxMemoryData1Country: TStringField
FieldKind = fkData
FieldName = 'Country'
Index = 4
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 100
end
object RxMemoryData1Sity: TStringField
FieldKind = fkData
FieldName = 'Sity'
Index = 5
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 100
end
object RxMemoryData1FLAG: TLongintField
FieldKind = fkData
FieldName = 'FLAG'
Index = 6
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
end
object DataSource1: TDataSource
DataSet = RxMemoryData1
Left = 104
Top = 88
end
object RxDBGridExportPDF1: TRxDBGridExportPDF
RxDBGrid = RxDBGrid1
Caption = 'Export to PDF file'
Enabled = True
FileName = 'test111.pdf'
Options = [repExportTitle, repExportColors, repExportFooter, repOverwriteExisting, repExportImages]
PdfOptions.PaperOrientation = ppoLandscape
PdfOptions.Options = [poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG]
OpenAfterExport = True
AuthorPdf = 'Lagunov A.A.'
ProducerPdf = 'Test project'
PageMargin.Left = 40
PageMargin.Top = 40
PageMargin.Right = 40
PageMargin.Bottom = 40
Left = 112
Top = 160
end
object ImageList1: TImageList
Left = 112
Top = 224
Bitmap = {
4C6903000000100000001000000000000000000000FF000000FF000000000000
0000000000FF000000FF0000000000000000000000FF000000FF000000000000
000000000000000000000000000000000000000000FFFF0000FF000000FF0000
00FF800000FFFF0000FF000000FF000000FF800000FFFF0000FF000000FF0000
00FF000000FF000000FF000000000000000000000000000000FFFF0000FF8000
00FF800000FFFF0000FFFF0000FF800000FF800000FFFF0000FFFF0000FF8000
00FF000000FF00000000000000000000000000000000000000FFFF0000FF8000
00FF800000FFFF0000FFFF0000FF800000FF800000FFFF0000FFFF0000FF0000
00FF000000000000000000000000000000000000000000000000000000FFFF00
00FF800000FF800000FFFF0000FFFF0000FF800000FF800000FF000000FF0000
0000000000000000000000000000000000000000000000000000000000FFFF00
00FF800000FF800000FFFF0000FFFF0000FF000000FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FFFF0000FF800000FF000000FF000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FFFF0000FF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000FF0000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000000000
0000000000FF000000FF0000000000000000000000FF000000FF000000000000
000000000000000000000000000000000000000000FF0000FFFF000000FF0000
00FF000080FF0000FFFF000000FF000000FF000080FF0000FFFF000000FF0000
00FF000000FF000000FF000000000000000000000000000000FF0000FFFF0000
80FF000080FF0000FFFF0000FFFF000080FF000080FF0000FFFF0000FFFF0000
80FF000000FF00000000000000000000000000000000000000FF0000FFFF0000
80FF000080FF0000FFFF0000FFFF000080FF000080FF0000FFFF0000FFFF0000
00FF000000000000000000000000000000000000000000000000000000FF0000
FFFF000080FF000080FF0000FFFF0000FFFF000080FF000080FF000000FF0000
0000000000000000000000000000000000000000000000000000000000FF0000
FFFF000080FF000080FF0000FFFF0000FFFF000000FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FF0000FFFF000080FF000000FF000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FF0000FFFF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000FF0000000000000000000000000000
000000000000000000000000000000000000000000FF000000FF000000000000
0000000000FF000000FF0000000000000000000000FF000000FF000000000000
000000000000000000000000000000000000000000FF00FFFFFF000000FF0000
00FF008080FF00FFFFFF000000FF000000FF008080FF00FFFFFF000000FF0000
00FF000000FF000000FF000000000000000000000000000000FF00FFFFFF0080
80FF008080FF00FFFFFF00FFFFFF008080FF008080FF00FFFFFF00FFFFFF0080
80FF000000FF00000000000000000000000000000000000000FF00FFFFFF0080
80FF008080FF00FFFFFF00FFFFFF008080FF008080FF00FFFFFF00FFFFFF0000
00FF000000000000000000000000000000000000000000000000000000FF00FF
FFFF008080FF008080FF00FFFFFF00FFFFFF008080FF008080FF000000FF0000
0000000000000000000000000000000000000000000000000000000000FF00FF
FFFF008080FF008080FF00FFFFFF00FFFFFF000000FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FF00FFFFFF008080FF000000FF000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FF00FFFFFF000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000FF0000000000000000000000000000
0000000000000000000000000000
}
BitmapAdv = {
4C6900000000
}
end
end

View File

@@ -0,0 +1,345 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
width="24"
height="24"
viewBox="0 0 24 24"
version="1.1"
id="svg106"
inkscape:version="0.92.3 (2405546, 2018-03-11)"
sodipodi:docname="tdbverticalgrid_rx.svg"
inkscape:export-filename="D:\temp\rx\work\temp6.png"
inkscape:export-xdpi="96"
inkscape:export-ydpi="96">
<defs
id="defs100">
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient226"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-36.919643,-3108.2562)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
<linearGradient
inkscape:collect="always"
id="linearGradient914">
<stop
style="stop-color:#4276c4;stop-opacity:1;"
offset="0"
id="stop910" />
<stop
id="stop916"
offset="0.34375"
style="stop-color:#80b3ff;stop-opacity:1" />
<stop
style="stop-color:#0044aa;stop-opacity:1"
offset="1"
id="stop912" />
</linearGradient>
<linearGradient
gradientTransform="matrix(4,0,0,4,-36.919643,-3120.2562)"
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientUnits="userSpaceOnUse"
id="linearGradient932"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientTransform="matrix(4,0,0,4,-36.919643,-3132.2557)"
gradientUnits="userSpaceOnUse"
id="linearGradient936"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient208"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-36.919643,-3108.2562)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
<pattern
y="0"
x="0"
height="6"
width="6"
patternUnits="userSpaceOnUse"
id="EMFhbasepattern" />
<pattern
y="0"
x="0"
height="6"
width="6"
patternUnits="userSpaceOnUse"
id="EMFhbasepattern-8" />
</defs>
<sodipodi:namedview
id="base"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageopacity="0.0"
inkscape:pageshadow="2"
inkscape:zoom="8.5520833"
inkscape:cx="16.286193"
inkscape:cy="9.4708068"
inkscape:document-units="px"
inkscape:current-layer="layer7"
showgrid="true"
units="px"
inkscape:window-width="1920"
inkscape:window-height="1018"
inkscape:window-x="-8"
inkscape:window-y="-8"
inkscape:window-maximized="1"
inkscape:snap-global="false"
showguides="true"
inkscape:guide-bbox="true"
inkscape:snap-grids="false">
<inkscape:grid
type="xygrid"
id="grid108" />
</sodipodi:namedview>
<metadata
id="metadata103">
<rdf:RDF>
<cc:Work
rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
<dc:title />
</cc:Work>
</rdf:RDF>
</metadata>
<g
inkscape:label="base"
inkscape:groupmode="layer"
id="layer1"
transform="translate(0,-308.29999)"
sodipodi:insensitive="true"
style="display:inline">
<rect
style="fill:none;fill-rule:evenodd;stroke-width:0.43817803"
id="rect110"
width="24"
height="24"
x="0"
y="308.29999" />
</g>
<g
inkscape:groupmode="layer"
id="layer2"
inkscape:label="db"
transform="translate(0,-24)"
sodipodi:insensitive="true"
style="display:inline">
<g
style="display:inline"
id="g899"
transform="matrix(0.5,0,0,0.5,18.459821,-478.59625)">
<ellipse
ry="3"
rx="10"
cy="1030.1925"
cx="-20.919643"
id="ellipse880"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient208);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1026.2755"
cx="-20.919643"
id="ellipse878"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient932);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse930"
cx="-20.919643"
cy="1024.1925"
rx="10"
ry="3" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse874"
cx="-20.919643"
cy="1020.2756"
rx="10.988618"
ry="3.9169633" />
<ellipse
ry="3"
rx="10"
cy="1018.1926"
cx="-20.919643"
id="ellipse934"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient936);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1014.2756"
cx="-20.919643"
id="ellipse858"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#80b3ff;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient226);stroke-width:1.99999988;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse868"
cx="-20.919643"
cy="1012.1926"
rx="11"
ry="4" />
</g>
</g>
<g
inkscape:groupmode="layer"
id="layer3"
inkscape:label="vertgrid_left"
transform="translate(0,-24)"
sodipodi:insensitive="true"
style="opacity:1">
<rect
style="fill:#e5e5e5;fill-opacity:1;stroke:#4d4d4d;stroke-width:0.99999994;stroke-linecap:butt;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:normal"
id="rect853"
width="7.0082326"
height="14.007257"
x="6.5000005"
y="32.492744" />
</g>
<g
inkscape:groupmode="layer"
id="layer4"
inkscape:label="vertgrid_right"
transform="translate(0,-24)"
style="display:inline;opacity:1"
sodipodi:insensitive="true">
<rect
style="fill:#fcfdc9;fill-opacity:1;stroke:#4d4d4d;stroke-width:1;stroke-linecap:butt;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:normal"
id="rect853-1"
width="8.9849834"
height="13.986136"
x="13.499394"
y="32.513866" />
</g>
<g
inkscape:groupmode="layer"
id="layer6"
inkscape:label="string_left"
style="display:inline"
transform="translate(0,-24)"
sodipodi:insensitive="true">
<path
style="opacity:1;fill:none;stroke:#0070e9;stroke-width:1;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 6.9870816,33.481876 c 6.0125004,0 6.0125004,0 6.0125004,0"
id="path881"
inkscape:connector-curvature="0" />
<path
style="opacity:1;fill:none;stroke:#0070e9;stroke-width:0.99999994;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 6.9868351,39.46872 c 5.9986359,0 5.9986359,0 5.9986359,0"
id="path881-3"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer8"
inkscape:label="string_right"
style="display:inline"
transform="translate(0,-24)"
sodipodi:insensitive="true">
<path
style="opacity:1;fill:none;stroke:#0070e9;stroke-width:1;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 13.983442,33.48194 c 8.0045,0 8.0045,0 8.0045,0"
id="path881-0"
inkscape:connector-curvature="0" />
<path
style="opacity:1;fill:none;stroke:#0070e9;stroke-width:1;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 13.985135,39.468574 c 8.0045,0 8.0045,0 8.0045,0"
id="path881-1"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer10"
inkscape:label="string_hor_left"
style="display:inline"
transform="translate(0,-24)"
sodipodi:insensitive="true">
<path
style="fill:none;stroke:#000000;stroke-width:0.89999992;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 8.0048153,35.492402 3.9668477,0.0073 v 0"
id="path927"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:0.89999992;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 8.0047647,41.467105 3.9669713,0.0073 v 0"
id="path927-4"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer11"
inkscape:label="string_hor_roght"
style="display:inline"
transform="translate(0,-24)"
sodipodi:insensitive="true">
<path
style="fill:none;stroke:#000000;stroke-width:0.80000001;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 14.95241,35.473711 5.95189,0.0073 v 0"
id="path927-4-3"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:0.80000001;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 14.950286,41.401147 5.95209,0.0073 v 0"
id="path927-4-3-9"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:0.80000007;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 14.950282,43.401232 5.952939,0.0073 v 0"
id="path927-4-3-6"
inkscape:connector-curvature="0" />
<path
style="fill:none;stroke:#000000;stroke-width:0.80000001;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 14.95689,37.334501 4.093732,0.0073 v 0"
id="path927-4-3-0-97"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer7"
inkscape:label="text"
transform="translate(0,-24)"
style="display:inline">
<flowRoot
xml:space="preserve"
id="flowRoot914-84"
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:12px;line-height:1.25;font-family:'Arial Unicode MS';-inkscape-font-specification:'Arial Unicode MS';letter-spacing:0px;word-spacing:0px;fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"
transform="matrix(0.46354284,0,0,0.55114772,-1.2832947,23.859648)"><flowRegion
id="flowRegion916-4"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"><rect
id="rect918-7"
width="38.14209"
height="34.674625"
x="3.4674628"
y="-1.8781176"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill" /></flowRegion><flowPara
id="flowPara920-5"
style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:21.33333397px;font-family:Arial;-inkscape-font-specification:'Arial Bold';stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill">Rx</flowPara></flowRoot> </g>
</svg>

After

Width:  |  Height:  |  Size: 14 KiB

View File

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

View File

@@ -0,0 +1,292 @@
{ seldsfrm 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 rxseldsfrm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, ComponentEditors, DB, ButtonPanel;
type
{ TSelectDataSetForm }
TSelectDataSetForm = class(TForm)
ButtonPanel1: TButtonPanel;
CheckBox1: TCheckBox;
Label1: TLabel;
DataSetList: TListBox;
procedure CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure ListBox1KeyPress(Sender: TObject; var Key: char);
private
FDesigner: TComponentEditorDesigner;
FExclude: string;
procedure FillDataSetList(ExcludeDataSet: TDataSet);
procedure AddDataSet(const S: string);
public
{ public declarations }
end;
{ TMemDataSetEditor }
TMemDataSetEditor = class(TComponentEditor)
private
DefaultEditor: TBaseComponentEditor;
function UniqueName(Field: TField): string;
procedure BorrowStructure;
protected
function CopyStructure(Source, Dest: TDataSet): Boolean; virtual;
public
constructor Create(AComponent: TComponent; ADesigner: TComponentEditorDesigner); override;
destructor Destroy; override;
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
function SelectDataSet(ADesigner: TComponentEditorDesigner; const ACaption: string;
ExcludeDataSet: TDataSet): TDataSet;
var
SelectDataSetForm: TSelectDataSetForm;
implementation
uses rxmemds, rxdconst;
{$R *.lfm}
function SelectDataSet(ADesigner: TComponentEditorDesigner; const ACaption: string;
ExcludeDataSet: TDataSet): TDataSet;
begin
Result := nil;
with TSelectDataSetForm.Create(Application) do
try
if ACaption <> '' then Caption := ACaption;
FDesigner := ADesigner;
FillDataSetList(ExcludeDataSet);
if ShowModal = mrOk then
if DataSetList.ItemIndex >= 0 then
begin
with DataSetList do
Result := FDesigner.Form.FindComponent(Items[ItemIndex]) as TDataSet;
end;
finally
Free;
end;
end;
{ TSelectDataSetForm }
procedure TSelectDataSetForm.CheckBox1Change(Sender: TObject);
begin
Label1.Enabled:=not CheckBox1.Checked;
DataSetList.Enabled:=not CheckBox1.Checked;
end;
procedure TSelectDataSetForm.FormCreate(Sender: TObject);
begin
Caption:=sRxSelectDatasetStruct;
CheckBox1.Caption:=sRxCopyOnlyMetadata;
Label1.Caption:=sRxSourceDataset;
end;
procedure TSelectDataSetForm.ListBox1DblClick(Sender: TObject);
begin
if DataSetList.ItemIndex >= 0 then ModalResult := mrOk;
end;
procedure TSelectDataSetForm.ListBox1KeyPress(Sender: TObject; var Key: char);
begin
if (Key = #13) and (DataSetList.ItemIndex >= 0) then
ModalResult := mrOk;
end;
procedure TSelectDataSetForm.FillDataSetList(ExcludeDataSet: TDataSet);
var
I: Integer;
Component: TComponent;
begin
DataSetList.Items.BeginUpdate;
try
DataSetList.Clear;
FExclude := '';
if ExcludeDataSet <> nil then FExclude := ExcludeDataSet.Name;
for I := 0 to FDesigner.Form.ComponentCount - 1 do
begin
Component := FDesigner.Form.Components[I];
if (Component is TDataSet) and (Component <> ExcludeDataSet) then
AddDataSet(Component.Name);
end;
with DataSetList do
begin
if Items.Count > 0 then ItemIndex := 0;
Enabled := Items.Count > 0;
ButtonPanel1.OKButton.Enabled:= (ItemIndex >= 0);
end;
finally
DataSetList.Items.EndUpdate;
end;
end;
procedure TSelectDataSetForm.AddDataSet(const S: string);
begin
if (S <> '') and (S <> FExclude) then DataSetList.Items.Add(S);
end;
{ TMemDataSetEditor }
function TMemDataSetEditor.UniqueName(Field: TField): string;
const
AlphaNumeric = ['A'..'Z', 'a'..'z', '_'] + ['0'..'9'];
var
Temp: string;
Comp: TComponent;
I: Integer;
begin
Result := '';
if (Field <> nil) then begin
Temp := Field.FieldName;
for I := Length(Temp) downto 1 do
if not (Temp[I] in AlphaNumeric) then System.Delete(Temp, I, 1);
if (Temp = '') or not IsValidIdent(Temp) then begin
Temp := Field.ClassName;
if (UpCase(Temp[1]) = 'T') and (Length(Temp) > 1) then
System.Delete(Temp, 1, 1);
end;
end
else Exit;
Temp := Component.Name + Temp;
I := 0;
repeat
Result := Temp;
if I > 0 then Result := Result + IntToStr(I);
Comp := Designer.Form.FindComponent(Result);
Inc(I);
until (Comp = nil) or (Comp = Field);
end;
procedure TMemDataSetEditor.BorrowStructure;
var
DataSet: TDataSet;
I: Integer;
Caption: string;
begin
Caption := Component.Name;
if (Component.Owner <> nil) and (Component.Owner.Name <> '') then
Caption := Format('%s.%s', [Component.Owner.Name, Caption]);
DataSet := SelectDataSet(Designer, Caption, TDataSet(Component));
if DataSet <> nil then
begin
// StartWait;
try
if not CopyStructure(DataSet, Component as TDataSet) then Exit;
with TDataSet(Component) do
begin
for I := 0 to FieldCount - 1 do
if Fields[I].Name = '' then
Fields[I].Name := UniqueName(Fields[I]);
end;
Modified;
finally
// StopWait;
end;
Designer.Modified;
end;
end;
function TMemDataSetEditor.CopyStructure(Source, Dest: TDataSet): Boolean;
begin
Result := Dest is TRxMemoryData;
if Result then
TRxMemoryData(Dest).CopyStructure(Source);
end;
type
PClass = ^TClass;
constructor TMemDataSetEditor.Create(AComponent: TComponent;
ADesigner: TComponentEditorDesigner);
var
CompClass: TClass;
begin
inherited Create(AComponent, ADesigner);
CompClass := PClass(Acomponent)^;
try
PClass(AComponent)^ := TDataSet;
DefaultEditor := GetComponentEditor(AComponent, ADesigner);
finally
PClass(AComponent)^ := CompClass;
end;
end;
destructor TMemDataSetEditor.Destroy;
begin
DefaultEditor.Free;
inherited Destroy;
end;
procedure TMemDataSetEditor.ExecuteVerb(Index: Integer);
begin
if Index < DefaultEditor.GetVerbCount then
DefaultEditor.ExecuteVerb(Index)
else
begin
case Index - DefaultEditor.GetVerbCount of
0:BorrowStructure;
end;
end;
end;
function TMemDataSetEditor.GetVerb(Index: Integer): string;
begin
if Index < DefaultEditor.GetVerbCount then
Result := DefaultEditor.GetVerb(Index)
else
begin
case Index - DefaultEditor.GetVerbCount of
0:Result:=sRxBorrowStructure;
end;
end;
end;
function TMemDataSetEditor.GetVerbCount: Integer;
begin
Result:=DefaultEditor.GetVerbCount + 1;
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 124 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.2 KiB

View File

@@ -0,0 +1,20 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, rxnew, lazcontrols;
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@@ -0,0 +1,293 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
width="24"
height="24"
viewBox="0 0 24 24"
version="1.1"
id="svg106"
inkscape:version="0.92.3 (2405546, 2018-03-11)"
sodipodi:docname="tmemorydata_rx.svg"
inkscape:export-filename="D:\temp\rx\work\tmemorydata_rx.png"
inkscape:export-xdpi="96"
inkscape:export-ydpi="96">
<defs
id="defs100">
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient226"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-36.919643,-3108.2562)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
<linearGradient
inkscape:collect="always"
id="linearGradient914">
<stop
style="stop-color:#4276c4;stop-opacity:1"
offset="0"
id="stop910" />
<stop
id="stop916"
offset="0.34375"
style="stop-color:#80b3ff;stop-opacity:1" />
<stop
style="stop-color:#0044aa;stop-opacity:1"
offset="1"
id="stop912" />
</linearGradient>
<linearGradient
gradientTransform="matrix(4,0,0,4,-36.919643,-3120.2562)"
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientUnits="userSpaceOnUse"
id="linearGradient932"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
y2="1035.3622"
x2="12"
y1="1035.3622"
x1="3"
gradientTransform="matrix(4,0,0,4,-36.919643,-3132.2557)"
gradientUnits="userSpaceOnUse"
id="linearGradient936"
xlink:href="#linearGradient914"
inkscape:collect="always" />
<linearGradient
inkscape:collect="always"
xlink:href="#linearGradient914"
id="linearGradient208"
gradientUnits="userSpaceOnUse"
gradientTransform="matrix(4,0,0,4,-36.919643,-3108.2562)"
x1="3"
y1="1035.3622"
x2="12"
y2="1035.3622" />
<filter
inkscape:label="Apparition"
inkscape:menu="Blurs"
inkscape:menu-tooltip="Edges are partly feathered out"
style="color-interpolation-filters:sRGB"
id="filter1434">
<feMorphology
radius="4"
in="SourceGraphic"
result="result0"
id="feMorphology1428" />
<feGaussianBlur
in="result0"
stdDeviation="8"
result="result91"
id="feGaussianBlur1430" />
<feComposite
operator="in"
in="SourceGraphic"
in2="result91"
id="feComposite1432" />
</filter>
</defs>
<sodipodi:namedview
id="base"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
inkscape:pageopacity="0.0"
inkscape:pageshadow="2"
inkscape:zoom="7.9999999"
inkscape:cx="10.470445"
inkscape:cy="11.096427"
inkscape:document-units="px"
inkscape:current-layer="layer7"
showgrid="true"
units="px"
inkscape:window-width="1366"
inkscape:window-height="706"
inkscape:window-x="-8"
inkscape:window-y="-8"
inkscape:window-maximized="1"
showguides="true"
inkscape:guide-bbox="true"
inkscape:snap-global="false">
<inkscape:grid
type="xygrid"
id="grid108" />
</sodipodi:namedview>
<metadata
id="metadata103">
<rdf:RDF>
<cc:Work
rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
<dc:title></dc:title>
</cc:Work>
</rdf:RDF>
</metadata>
<g
inkscape:label="base"
inkscape:groupmode="layer"
id="layer1"
transform="translate(0,-308.29999)">
<rect
style="fill:none;fill-rule:evenodd;stroke-width:0.43817803"
id="rect110"
width="24"
height="24"
x="0"
y="308.29999" />
</g>
<g
inkscape:groupmode="layer"
id="layer2"
inkscape:label="db"
transform="translate(0,-24)">
<g
style="display:inline"
id="g899"
transform="matrix(0.5,0,0,0.5,18.459821,-478.59625)">
<ellipse
ry="3"
rx="10"
cy="1030.1925"
cx="-20.919643"
id="ellipse880"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient208);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1026.2755"
cx="-20.919643"
id="ellipse878"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient932);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse930"
cx="-20.919643"
cy="1024.1925"
rx="10"
ry="3" />
<ellipse
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse874"
cx="-20.919643"
cy="1020.2756"
rx="10.988618"
ry="3.9169633" />
<ellipse
ry="3"
rx="10"
cy="1018.1926"
cx="-20.919643"
id="ellipse934"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient936);stroke-width:3.99999976;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
ry="3.9169633"
rx="10.988618"
cy="1014.2756"
cx="-20.919643"
id="ellipse858"
style="opacity:1;fill:#bdd1ec;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:2;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal" />
<ellipse
style="opacity:1;fill:#80b3ff;fill-opacity:1;fill-rule:evenodd;stroke:url(#linearGradient226);stroke-width:1.99999988;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="ellipse868"
cx="-20.919643"
cy="1012.1926"
rx="11"
ry="4" />
</g>
</g>
<g
inkscape:groupmode="layer"
id="layer3"
inkscape:label="mem_basic"
style="display:inline"
transform="translate(0,-24)">
<rect
style="opacity:1;fill:#0060b0;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:3;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-dashoffset:0;stroke-opacity:1;paint-order:normal"
id="rect840"
width="20"
height="9"
x="2"
y="37.999989"
ry="2.5" />
</g>
<g
inkscape:groupmode="layer"
id="layer5"
inkscape:label="mem_text"
style="display:inline"
transform="translate(0,-24)">
<path
id="path840"
style="fill:none;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.96616817;stroke-linecap:square;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 12.032615,44.510329 h 1.449252 m -1.449252,-1.932332 h 1.449252 m 0,-1.932338 h -1.932334 v 3.86467"
inkscape:connector-curvature="0"
sodipodi:nodetypes="ccccccc" />
<path
inkscape:connector-curvature="0"
id="path845"
d="m 5.5727733,44.51691 4.89e-5,-3.864525 1.932288,2.173732 1.9323361,-2.173877 v 3.86467"
style="fill:none;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.96616817;stroke-linecap:square;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
sodipodi:nodetypes="ccccc" />
<path
sodipodi:nodetypes="ccccc"
style="fill:none;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.96616817;stroke-linecap:square;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
d="m 15.550958,44.516913 4.9e-5,-3.864525 1.932287,2.173732 1.932335,-2.173877 v 3.86467"
id="path899"
inkscape:connector-curvature="0" />
</g>
<g
inkscape:groupmode="layer"
id="layer4"
inkscape:label="arrow"
style="display:inline"
transform="translate(0,-24)">
<g
transform="matrix(0.5,0,0,0.5,0,-478.18105)"
id="g103"
style="fill:#80b3ff;fill-opacity:1;stroke:#0060b0;stroke-opacity:1">
<path
sodipodi:nodetypes="cccc"
inkscape:connector-curvature="0"
id="path905"
d="m 32,1010.3622 v 18 l 12,-9 z"
style="fill:#80b3ff;fill-opacity:1;fill-rule:evenodd;stroke:#0060b0;stroke-width:2px;stroke-linecap:butt;stroke-linejoin:round;stroke-opacity:1" />
</g>
</g>
<g
inkscape:groupmode="layer"
id="layer7"
inkscape:label="text"
transform="translate(0,-24)">
<flowRoot
xml:space="preserve"
id="flowRoot914-84"
style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:12px;line-height:1.25;font-family:'Arial Unicode MS';-inkscape-font-specification:'Arial Unicode MS';letter-spacing:0px;word-spacing:0px;fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"
transform="matrix(0.46354284,0,0,0.55114772,-1.2832947,23.859648)"><flowRegion
id="flowRegion916-4"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill"><rect
id="rect918-7"
width="38.14209"
height="34.674625"
x="3.4674628"
y="-1.8781176"
style="fill:#c500ab;fill-opacity:1;stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill" /></flowRegion><flowPara
id="flowPara920-5"
style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:21.33333397px;font-family:Arial;-inkscape-font-specification:'Arial Bold';stroke:#ffffff;stroke-width:2.96764684;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;paint-order:markers stroke fill">Rx</flowPara></flowRoot> </g>
</svg>

After

Width:  |  Height:  |  Size: 11 KiB

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.2 KiB

View File

@@ -0,0 +1,40 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<Name Value="rx_sort_sqldb"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<OtherUnitFiles Value="rx_sort_sqldb"/>
<UnitOutputDirectory Value="lib/rx_sort_sqldb/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Version Major="1" Minor="1" Release="1" Build="2"/>
<Files Count="2">
<Item1>
<Filename Value="rx_sort_sqldb/rxsortsqldb.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="RxSortSqlDB"/>
</Item1>
<Item2>
<Filename Value="rx_sort_sqldb/exsortsql.pas"/>
<UnitName Value="exsortsql"/>
</Item2>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="SQLDBLaz"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit dcl_rx_ctrl;
{$warn 5023 off : no warning about unused units}
interface
uses
register_rxctrl, rxceEditLookupFields, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('register_rxctrl', @register_rxctrl.Register);
end;
initialization
RegisterPackage('dcl_rx_ctrl', @Register);
end.

View File

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

View File

@@ -0,0 +1,140 @@
object MainForm: TMainForm
Left = 427
Height = 300
Top = 245
Width = 460
ActiveControl = Edit1
Caption = 'Main form'
ClientHeight = 272
ClientWidth = 460
Menu = MainMenu1
OnCreate = FormCreate
Position = poDesktopCenter
ShowHint = True
LCLVersion = '1.7'
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Edit1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 20
Top = 75
Width = 96
BorderSpacing.Around = 6
Caption = 'Folder for scan'
ParentColor = False
end
object Label2: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 6
Height = 20
Top = 6
Width = 72
BorderSpacing.Around = 6
Caption = 'Default ext'
ParentColor = False
end
object Button1: TButton
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = DirectoryEdit1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 36
Top = 144
Width = 47
Action = sysScan
AutoSize = True
BorderSpacing.Around = 6
TabOrder = 0
end
object DirectoryEdit1: TDirectoryEdit
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
Left = 12
Height = 37
Top = 101
Width = 417
Directory = 'C:\lazarus\components\'
ShowHidden = False
ButtonWidth = 23
NumGlyphs = 1
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
MaxLength = 0
TabOrder = 1
Text = 'C:\lazarus\components\'
end
object Edit1: TEdit
AnchorSideLeft.Control = Label2
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
Left = 12
Height = 37
Top = 32
Width = 80
BorderSpacing.Around = 6
TabOrder = 2
Text = '.pas'
end
object ActionList1: TActionList
left = 144
top = 112
object sysExit: TAction
Category = 'System'
Caption = 'Exit'
Enabled = False
Hint = 'Exit form demo app'
OnExecute = sysExitExecute
ShortCut = 32856
end
object hlpAbout: TAction
Category = 'Help'
Caption = 'About'
Hint = 'Information of app'
OnExecute = hlpAboutExecute
end
object sysScan: TAction
Category = 'System'
Caption = 'Scan'
Hint = 'Scan folder'
OnExecute = sysRescanExecute
end
end
object MainMenu1: TMainMenu
left = 144
top = 48
object SystemItems: TMenuItem
Caption = 'System'
object MenuItem3: TMenuItem
Action = sysScan
OnClick = sysRescanExecute
end
object MenuItem4: TMenuItem
Caption = '-'
end
object MenuItem2: TMenuItem
Action = sysExit
end
end
object FolderItems: TMenuItem
Caption = 'Folder'
end
object HelpItems: TMenuItem
Caption = 'Help'
object MenuItem1: TMenuItem
Action = hlpAbout
OnClick = hlpAboutExecute
end
end
end
object FolderLister1: TFolderLister
DefaultExt = '.pas'
OnExecuteItem = FolderLister1ExecuteItem
MenuItem = FolderItems
left = 144
top = 12
end
end

Some files were not shown because too many files have changed in this diff Show More