Стартовый пул
This commit is contained in:
@@ -0,0 +1,160 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, rxdbgrid,
|
||||
Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
DBGrids, Menus, ExtCtrls, DbCtrls, db, rxdbverticalgrid, rxmemds;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
CheckBox1: TCheckBox;
|
||||
CheckBox2: TCheckBox;
|
||||
dsData: TDataSource;
|
||||
ImageList1: TImageList;
|
||||
MenuItem1: TMenuItem;
|
||||
MenuItem10: TMenuItem;
|
||||
MenuItem11: TMenuItem;
|
||||
MenuItem12: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
MenuItem3: TMenuItem;
|
||||
MenuItem4: TMenuItem;
|
||||
MenuItem5: TMenuItem;
|
||||
MenuItem6: TMenuItem;
|
||||
MenuItem7: TMenuItem;
|
||||
MenuItem8: TMenuItem;
|
||||
MenuItem9: TMenuItem;
|
||||
Panel1: TPanel;
|
||||
PopupMenu1: TPopupMenu;
|
||||
PopupMenu2: TPopupMenu;
|
||||
PopupMenu3: TPopupMenu;
|
||||
RadioGroup1: TRadioGroup;
|
||||
rxDataCREATE_USER_DATE: TDateTimeField;
|
||||
rxDataCREATE_USER_NAME: TStringField;
|
||||
rxDataTB_CLEINT_CODE: TLongintField;
|
||||
rxDataTB_CLEINT_MEMO: TMemoField;
|
||||
rxDataTB_CLEINT_TYPE: TLongintField;
|
||||
rxDataTB_CLIENT_EMAIL: TStringField;
|
||||
rxDataTB_CLIENT_ID: TAutoIncField;
|
||||
rxDataTB_CLIENT_IMAGE: TBlobField;
|
||||
rxDataTB_CLIENT_INN: TStringField;
|
||||
rxDataTB_CLIENT_NAME: TStringField;
|
||||
rxDataTB_CLIENT_PHONE: TStringField;
|
||||
rxDataVIP: TBooleanField;
|
||||
RxDBGrid1: TRxDBGrid;
|
||||
RxDBVerticalGrid1: TRxDBVerticalGrid;
|
||||
rxData: TRxMemoryData;
|
||||
Splitter1: TSplitter;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure CheckBox1Change(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
procedure FillDataBase;
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
uses LazUTF8, LazFileUtils;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FillDataBase;
|
||||
CheckBox1.Checked:=rxvgColumnTitle in RxDBVerticalGrid1.Options;
|
||||
CheckBox2.Checked:=RxDBVerticalGrid1.Rows[11].ShowBlobImagesAndMemo;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
begin
|
||||
RxDBVerticalGrid1.DataSource:=nil;
|
||||
RxDBGrid1.DataSource:=nil;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button2Click(Sender: TObject);
|
||||
begin
|
||||
RxDBVerticalGrid1.DataSource:=dsData;
|
||||
RxDBGrid1.DataSource:=dsData;
|
||||
end;
|
||||
|
||||
procedure TForm1.CheckBox1Change(Sender: TObject);
|
||||
begin
|
||||
if CheckBox1.Checked then
|
||||
RxDBVerticalGrid1.Options:=RxDBVerticalGrid1.Options + [rxvgColumnTitle]
|
||||
else
|
||||
RxDBVerticalGrid1.Options:=RxDBVerticalGrid1.Options - [rxvgColumnTitle]
|
||||
;
|
||||
|
||||
case RadioGroup1.ItemIndex of
|
||||
0:RxDBVerticalGrid1.Rows[11].Alignment:=taLeftJustify;
|
||||
1:RxDBVerticalGrid1.Rows[11].Alignment:=taRightJustify;
|
||||
2:RxDBVerticalGrid1.Rows[11].Alignment:=taCenter;
|
||||
end;
|
||||
RxDBVerticalGrid1.Rows[11].ShowBlobImagesAndMemo:=CheckBox2.Checked;
|
||||
RxDBVerticalGrid1.Rows[12].ShowBlobImagesAndMemo:=CheckBox2.Checked;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm1.FillDataBase;
|
||||
|
||||
procedure AppendRecord(AType, ACode:Integer; AINN, AName, ADesc, AEmail, APhone, AUser:string; AVip:boolean; AImageName:string);
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
rxData.Append;
|
||||
rxDataTB_CLEINT_TYPE.AsInteger:=AType;
|
||||
rxDataTB_CLEINT_CODE.AsInteger:=ACode;
|
||||
rxDataTB_CLIENT_INN.AsString:=AINN;
|
||||
rxDataTB_CLIENT_NAME.AsString:=AName;
|
||||
rxDataTB_CLEINT_MEMO.AsString:=ADesc;
|
||||
rxDataTB_CLIENT_EMAIL.AsString:=AEmail;
|
||||
rxDataTB_CLIENT_PHONE.AsString:=APhone;
|
||||
rxDataVIP.AsBoolean:=AVip;
|
||||
|
||||
if AImageName <> '' then
|
||||
begin
|
||||
S:=AppendPathDelim(ExpandFileName(AppendPathDelim(ExtractFileDir(ParamStr(0))) + '..'+DirectorySeparator + '..'+DirectorySeparator + '..' + DirectorySeparator + '..')) + 'images' + DirectorySeparator;
|
||||
//ForceDirectories()
|
||||
// /usr/local/share/lazarus/components/rxnew/demos/RxDBVerticalGrid
|
||||
// /usr/local/share/lazarus/images
|
||||
if FileExistsUTF8(S + AImageName) then
|
||||
rxDataTB_CLIENT_IMAGE.LoadFromFile(S + AImageName);
|
||||
end;
|
||||
|
||||
rxDataCREATE_USER_NAME.AsString:=AUser;
|
||||
rxDataCREATE_USER_DATE.AsDateTime:=Now + (200-Random * 100);
|
||||
rxData.Post;
|
||||
end;
|
||||
|
||||
begin
|
||||
rxData.Open;
|
||||
AppendRecord(1, 1, '01000100101', 'JSC "BOOT"', 'Описание'#13'Строка 2'#13'Строка 3', 'test1@email.com', '5(555)-557-88-77', 'alexs', true, 'splash_logo.png');
|
||||
AppendRecord(2, 2, '02000100101', 'Wikimedia Foundation, Inc.', 'Описание', 'test2@email.com', '5(555)-557-88-77', 'boss', false, 'splash_logo.xpm');
|
||||
AppendRecord(3, 3, '03000100101', 'LLC Pilot ', 'Описание', 'test3@email.com', '5(555)-557-88-77', 'master', false, 'powered_by.png');
|
||||
AppendRecord(4, 4, '04000100101', 'Pilot, OOO', 'Описание', 'test4@email.com', '5(555)-557-88-77', 'onegin', false, 'folder.png');
|
||||
AppendRecord(5, 5, '05000100101', 'JSC "MS"', 'Описание', 'test5@email.com', '5(555)-557-88-77', 'alfred', false, 'splash_source'+DirectorySeparator + 'cheetah.jpg');
|
||||
AppendRecord(6, 11, '06000100101', 'JSC "AA"', 'Описание', 'test6@email.com', '5(555)-557-88-77', 'anna', false, 'mimetypes'+DirectorySeparator + 'text-lazarus-project-information.png');
|
||||
AppendRecord(7, 12, '07000100101', 'JSC "BBBB"', 'Описание', 'test7@email.com', '5(555)-557-88-77', 'tux', false, 'splash_source'+DirectorySeparator + 'paw.png');
|
||||
AppendRecord(8, 13, '08000100101', 'JSC "CCCC"', 'Описание', 'test8@email.com', '5(555)-557-88-77', 'x-man', false, '');
|
||||
AppendRecord(9, 14, '09000100101', 'JSC "DDD"', 'Описание', 'test9@email.com', '5(555)-557-88-77', 'arny', false, '');
|
||||
AppendRecord(10, 15, '101000200101', 'JSC "EEEE"', 'Описание', 'test10@email.com', '5(555)-557-88-77', 'andy', false, '');
|
||||
rxData.First;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@@ -0,0 +1,126 @@
|
||||
{ exsortzeos 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 exsortzeos;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DB, RxDBGrid, ZAbstractRODataset;
|
||||
|
||||
type
|
||||
|
||||
{ TZeosDataSetSortEngine }
|
||||
|
||||
TZeosDataSetSortEngine = class(TRxDBGridSortEngine)
|
||||
protected
|
||||
public
|
||||
procedure Sort(FieldName: string; ADataSet:TDataSet; Asc:boolean; SortOptions:TRxSortEngineOptions);override;
|
||||
procedure SortList(ListField: string; ADataSet: TDataSet; Asc: array of boolean; SortOptions: TRxSortEngineOptions); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses ZDbcIntfs, ZVariant;
|
||||
|
||||
function FixFieldName(S:string):string;inline;
|
||||
begin
|
||||
if not IsValidIdent(S) then
|
||||
Result:='"'+S+'"'
|
||||
else
|
||||
Result:=S;
|
||||
end;
|
||||
|
||||
procedure TZeosDataSetSortEngine.Sort(FieldName: string; ADataSet: TDataSet;
|
||||
Asc: boolean; SortOptions: TRxSortEngineOptions);
|
||||
begin
|
||||
if not Assigned(ADataSet) then exit;
|
||||
|
||||
if ADataSet is TZAbstractRODataset then
|
||||
begin
|
||||
if Asc then
|
||||
FieldName := FixFieldName(FieldName) + ' Asc'
|
||||
else
|
||||
FieldName := FixFieldName(FieldName) + ' Desc';
|
||||
TZAbstractRODataset(ADataSet).SortedFields:=FieldName;
|
||||
{
|
||||
|
||||
|
||||
if Asc then
|
||||
TZAbstractRODataset(ADataSet).SortType:=stAscending
|
||||
else
|
||||
TZAbstractRODataset(ADataSet).SortType:=stDescending;}
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TZeosDataSetSortEngine.SortList(ListField: string;
|
||||
ADataSet: TDataSet; Asc: array of boolean; SortOptions: TRxSortEngineOptions);
|
||||
var
|
||||
S:string;
|
||||
i, C:integer;
|
||||
begin
|
||||
if not Assigned(ADataSet) then exit;
|
||||
|
||||
S:='';
|
||||
C:=Pos(';', ListField);
|
||||
i:=0;
|
||||
while C>0 do
|
||||
begin
|
||||
if S<>'' then S:=S+';';
|
||||
S:=S + FixFieldName(Copy(ListField, 1, C-1));
|
||||
Delete(ListField, 1, C);
|
||||
|
||||
if (i<=High(Asc)) and (not Asc[i]) then
|
||||
S:=S + ' DESC';
|
||||
C:=Pos(';', ListField);
|
||||
inc(i);
|
||||
end;
|
||||
|
||||
if ListField<>'' then
|
||||
begin
|
||||
if S<>'' then S:=S+';';
|
||||
S:=S + FixFieldName(ListField);
|
||||
if (i<=High(Asc)) and (not Asc[i]) then
|
||||
S:=S + ' DESC';
|
||||
end;
|
||||
|
||||
(ADataSet as TZAbstractRODataset).SortedFields:=S;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterRxDBGridSortEngine(TZeosDataSetSortEngine, 'TZReadOnlyQuery');
|
||||
RegisterRxDBGridSortEngine(TZeosDataSetSortEngine, 'TZQuery');
|
||||
RegisterRxDBGridSortEngine(TZeosDataSetSortEngine, 'TZTable');
|
||||
RegisterRxDBGridSortEngine(TZeosDataSetSortEngine, 'TZMacroQuery');
|
||||
end.
|
||||
|
@@ -0,0 +1,32 @@
|
||||
unit RxLazReport;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;
|
||||
|
||||
type
|
||||
TRxLazReport = class(TComponent)
|
||||
private
|
||||
{ Private declarations }
|
||||
protected
|
||||
{ Protected declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
published
|
||||
{ Published declarations }
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
uses lrRxControls;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('LazReport',[TRxLazReport]);
|
||||
end;
|
||||
|
||||
end.
|
Reference in New Issue
Block a user