diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.ico b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.ico
new file mode 100644
index 000000000..0341321b5
Binary files /dev/null and b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.ico differ
diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lpi b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lpi
new file mode 100644
index 000000000..be1bafb19
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lpi
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lpr b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lpr
new file mode 100644
index 000000000..1e431b5fb
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lpr
@@ -0,0 +1,22 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, rxnew, Unit1,
+ sysutils;
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ DefaultFormatSettings.ThousandSeparator:=' ';
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps
new file mode 100644
index 000000000..173d28f5e
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps
@@ -0,0 +1,622 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.res b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.res
new file mode 100644
index 000000000..e994dfa65
Binary files /dev/null and b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.res differ
diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm
new file mode 100644
index 000000000..7ad29c6cd
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm
@@ -0,0 +1,355 @@
+object Form1: TForm1
+ Left = 558
+ Height = 397
+ Top = 319
+ Width = 1043
+ Caption = 'Form1'
+ ClientHeight = 397
+ ClientWidth = 1043
+ OnClose = FormClose
+ OnCreate = FormCreate
+ LCLVersion = '1.7'
+ 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 = 476
+ Height = 36
+ Top = 7
+ Width = 90
+ AutoSize = True
+ BorderSpacing.Around = 6
+ Caption = 'Create PDF'
+ OnClick = Button1Click
+ TabOrder = 0
+ end
+ object CheckBox1: TCheckBox
+ Left = 1
+ Height = 24
+ Top = 18
+ Width = 99
+ Caption = 'CheckBox1'
+ OnChange = CheckBox1Change
+ TabOrder = 1
+ end
+ object Edit1: TEdit
+ Left = 137
+ Height = 37
+ Top = 7
+ Width = 295
+ TabOrder = 2
+ Text = 'ID=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 = False
+ AutoSort = True
+ Columns = <
+ item
+ Title.Alignment = taCenter
+ Title.Orientation = toHorizontal
+ Title.Caption = 'ID'
+ Width = 50
+ FieldName = 'ID'
+ EditButtons = <>
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ 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.EmptyFont.Style = [fsItalic]
+ Filter.ItemIndex = -1
+ Footers = <>
+ end
+ item
+ Color = clYellow
+ Title.Alignment = taCenter
+ Title.Orientation = toHorizontal
+ Title.Caption = 'Дата поставки'
+ Width = 90
+ FieldName = 'PDATE'
+ EditButtons = <>
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ Filter.EmptyFont.Style = [fsItalic]
+ Filter.ItemIndex = -1
+ Footers = <>
+ end
+ item
+ Title.Alignment = taCenter
+ Title.Orientation = toHorizontal
+ Title.Caption = 'Сумма'
+ Width = 100
+ FieldName = 'SUM'
+ EditButtons = <>
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ Filter.EmptyFont.Style = [fsItalic]
+ Filter.ItemIndex = -1
+ Footers = <>
+ end
+ item
+ Title.Alignment = taCenter
+ Title.Orientation = toHorizontal
+ Title.Caption = 'Страна'
+ Width = 200
+ FieldName = 'Country'
+ EditButtons = <>
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ 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.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 = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter, rdgAllowToolMenu]
+ Align = alClient
+ 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 = 0
+ 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
+ end
+ item
+ Name = 'NAME'
+ DataType = ftString
+ Size = 220
+ end
+ item
+ Name = 'PDATE'
+ DataType = ftDate
+ end
+ item
+ Name = 'SUM'
+ DataType = ftCurrency
+ end
+ item
+ Name = 'Country'
+ DataType = ftString
+ Size = 100
+ end
+ item
+ Name = 'Sity'
+ DataType = ftString
+ Size = 100
+ 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
+ end
+ object RxMemoryData1SUM: TCurrencyField
+ FieldKind = fkData
+ FieldName = 'SUM'
+ Index = 3
+ LookupCache = False
+ ProviderFlags = [pfInUpdate, pfInWhere]
+ ReadOnly = False
+ Required = False
+ MaxValue = 0
+ MinValue = 0
+ 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
+ end
+ object DataSource1: TDataSource
+ DataSet = RxMemoryData1
+ left = 104
+ top = 88
+ end
+ object RxDBGridExportPDF1: TRxDBGridExportPDF
+ RxDBGrid = RxDBGrid1
+ Caption = 'Export to PDF file'
+ ShowSetupForm = True
+ FileName = 'test111.pdf'
+ Options = [repExportTitle, repExportColors, repExportFooter]
+ PdfOptions.Options = []
+ OpenAfterExport = True
+ AuthorPdf = 'Лагунов А.А.'
+ ProducerPdf = 'alexs'
+ left = 112
+ top = 160
+ end
+end
diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas
new file mode 100644
index 000000000..b19f2f3f0
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas
@@ -0,0 +1,230 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, rxmemds, rxdbgrid,
+ RxDBGridExportPdf, Forms, Controls, Graphics,
+ Dialogs, ExtCtrls, StdCtrls, ComCtrls, db;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ Button1: TButton;
+ CheckBox1: TCheckBox;
+ DataSource1: TDataSource;
+ Edit1: TEdit;
+ Memo1: TMemo;
+ PageControl1: TPageControl;
+ Panel1: TPanel;
+ RxDBGrid1: TRxDBGrid;
+ RxDBGridExportPDF1: TRxDBGridExportPDF;
+ RxMemoryData1: TRxMemoryData;
+ RxMemoryData1Country: TStringField;
+ RxMemoryData1ID: TAutoIncField;
+ RxMemoryData1NAME: TStringField;
+ RxMemoryData1PDATE: TDateField;
+ RxMemoryData1Sity: TStringField;
+ RxMemoryData1SUM: TCurrencyField;
+ TabSheet1: TTabSheet;
+ TabSheet2: TTabSheet;
+ procedure Button1Click(Sender: TObject);
+ procedure CheckBox1Change(Sender: TObject);
+ procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+ procedure FormCreate(Sender: TObject);
+ private
+ FontDirList: TStrings;
+ procedure InitFonts;
+ procedure ShowInfo(AText:string; AParams : array of const);
+ procedure DebugFonts;
+ public
+ { public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+uses EasyLazFreeType, LazFreeTypeFontCollection,
+ LazFileUtils;
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ PageControl1.ActivePageIndex:=0;
+ RxMemoryData1.Open;
+ RxMemoryData1.AppendRecord([1, 'Строка с длинным текстом 1', now, 100, 'Россия', 'Москва']);
+ RxMemoryData1.AppendRecord([2, 'Строка с длинным текстом 2', now - 1, 100, 'Россия', 'Ставрополь']);
+ RxMemoryData1.AppendRecord([3, 'Строка с длинным текстом 3', now - 2, 110, 'Россия', 'Калининград']);
+ RxMemoryData1.AppendRecord([4, 'Строка с длинным текстом 4', now - 3, 5000, 'Россия', 'Владивасток']);
+ RxMemoryData1.AppendRecord([5, 'Строка с длинным текстом 5', now - 4, 123.31, 'USA', 'New-York']);
+ RxMemoryData1.AppendRecord([6, 'Строка с длинным текстом 6', now, 100, 'Россия', 'Москва']);
+ RxMemoryData1.AppendRecord([7, 'Строка с длинным текстом 7', now - 1, 100, 'Россия', 'Ставрополь']);
+ RxMemoryData1.AppendRecord([8, 'Строка с длинным текстом 8', now - 2, 110, 'Россия', 'Калининград']);
+ RxMemoryData1.AppendRecord([9, 'Строка с длинным текстом 9', now - 3, 5000, 'Россия', 'Владивасток']);
+ RxMemoryData1.AppendRecord([10,'Строка с длинным текстом 10', now - 4, 123.31, 'USA', 'New-York']);
+ RxMemoryData1.AppendRecord([11,'Строка с длинным текстом 11', now, 100, 'Россия', 'Москва']);
+ RxMemoryData1.AppendRecord([12,'Строка с длинным текстом 12', now - 1, 100, 'Россия', 'Ставрополь']);
+ RxMemoryData1.AppendRecord([13,'Строка с длинным текстом 13', now - 2, 110, 'Россия', 'Калининград']);
+ RxMemoryData1.AppendRecord([14,'Строка с длинным текстом 14', now - 3, 5000, 'Россия', 'Владивасток']);
+ RxMemoryData1.AppendRecord([15,'Строка с длинным текстом 15', now - 4, 123.31, 'USA', 'New-York']);
+ RxMemoryData1.AppendRecord([16,'Строка с длинным текстом 16', now, 100, 'Россия', 'Москва']);
+ RxMemoryData1.AppendRecord([17,'Строка с длинным текстом 17', now - 1, 100, 'Россия', 'Ставрополь']);
+ RxMemoryData1.AppendRecord([18,'Строка с длинным текстом 18', now - 2, 110, 'Россия', 'Калининград']);
+ RxMemoryData1.AppendRecord([19,'Строка с длинным текстом 19', now - 3, 5000, 'Россия', 'Владивасток']);
+ RxMemoryData1.AppendRecord([20,'Строка с длинным текстом 20', now - 4, 123.31, 'USA', 'New-York']);
+
+ DebugFonts;
+end;
+
+procedure TForm1.InitFonts;
+procedure CreateFontDirList;
+var
+ s: String;
+begin
+ FontDirList := TStringList.Create;
+ {$IFDEF WINDOWS}
+ s := SHGetFolderPathUTF8(20); // CSIDL_FONTS = 20
+ if s <> '' then
+ FontDirList.Add(s);
+ {$ENDIF}
+ {$IFDEF linux}
+ FontDirList.Add('/usr/share/cups/fonts/');
+ FontDirList.Add('/usr/share/fonts/');
+ FontDirList.Add('/usr/local/lib/X11/fonts/');
+ FontDirList.Add(GetUserDir + '.fonts/');
+ {$ENDIF}
+end;
+
+
+ { Duplicates functionality in FontCollection.AddFolder in order to be able to
+ ignore exceptions due to font read errors (occur on Linux Mint with font
+ NanumMyeongjo.ttf }
+ procedure AddFolder(AFolder: string);
+ var
+ files: TStringList;
+ i: integer;
+ begin
+ AFolder := ExpandFileName(AFolder);
+ if (length(AFolder) <> 0) and (AFolder[length(AFolder)] <> PathDelim) then
+ AFolder += PathDelim;
+ files := TStringList.Create;
+ FontCollection.BeginUpdate;
+ try
+ FindAllFiles(files, AFolder, '*.ttf', true);
+ files.Sort;
+ for i := 0 to files.Count-1 do
+ try
+ FontCollection.AddFile(files[i]);
+ except
+ end;
+ finally
+ FontCollection.EndUpdate;
+ files.Free;
+ end;
+ end;
+
+var
+ i: Integer;
+begin
+ if FontDirList = nil then
+ CreateFontDirList;
+
+ for i:=0 to FontDirList.Count-1 do
+ AddFolder(FontDirList[i]);
+end;
+
+procedure TForm1.ShowInfo(AText: string; AParams: array of const);
+begin
+ Memo1.Lines.Add(Format(AText, AParams));
+end;
+
+procedure TForm1.DebugFonts;
+
+procedure DumpFamaly(AFontFamely:string);
+var
+ FFM: TCustomFamilyCollectionItem;
+ I: Integer;
+ FFI: TCustomFontCollectionItem;
+begin
+ FFM:=FontCollection.Family[AFontFamely];
+ if not Assigned(FFM) then
+ begin
+ ShowInfo('Font Family %s NOT FOUND!', [AFontFamely]);
+ exit;
+ end;
+
+
+ ShowInfo('In Family %s count fonts : %d', [AFontFamely, FFM.FontCount]);
+ for I:=0 to FFM.FontCount-1 do
+ begin
+ FFI:=FFM.Font[i];
+ ShowInfo('Font in file %s - NAME: %s. Styles = %s', [FFI.Filename, FFI.Information[ftiFullName], FFI.Styles]);
+ end;
+
+ FFI:=FFM.GetFont('Regular');
+ if Assigned(FFI) then
+ ShowInfo('REGULAR Font in file %s - NAME: %s', [FFI.Filename, FFI.Information[ftiFullName]])
+ else
+ ShowInfo('Regular font not found', []);
+end;
+
+begin
+ InitFonts;
+ Memo1.Lines.Clear;
+ if Assigned(FontCollection) then
+ begin
+ ShowInfo('FontCollection.FontFileCount = %d', [FontCollection.FontFileCount]);
+ ShowInfo('FontCollection.FamilyCount = %d', [FontCollection.FamilyCount]);
+ DumpFamaly('Arial');
+ DumpFamaly('Sans');
+ DumpFamaly('Serif');
+ DumpFamaly('Liberation Sans');
+ end
+ else
+ Memo1.Text:='FontCollection not assigned';
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ RxDBGridExportPDF1.Execute;
+end;
+
+procedure TForm1.CheckBox1Change(Sender: TObject);
+begin
+ if CheckBox1.Checked then
+ begin
+ RxMemoryData1.Filter:=Edit1.Text;
+ end;
+ RxMemoryData1.Filtered:=CheckBox1.Checked;
+end;
+
+procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+ FreeAndNil(FontDirList);
+end;
+
+end.
+
+{
+'Conakry'
+'DejaVu Sans'
+'DejaVu Sans Condensed'
+'DejaVu Sans Light'
+'DejaVu Sans Mono'
+'DejaVu Serif'
+'DejaVu Serif Condensed'
+
+'Denemo'
+
+'FreeSans'
+'Caladea'
+'Carlito'
+}
diff --git a/components/rx/trunk/rxdbgrid.pas b/components/rx/trunk/rxdbgrid.pas
index 791e09770..df0a1c2ce 100644
--- a/components/rx/trunk/rxdbgrid.pas
+++ b/components/rx/trunk/rxdbgrid.pas
@@ -2481,17 +2481,7 @@ function TRxDBGrid.GetFooterRowCount: integer;
begin
Result:=FFooterOptions.RowCount;
end;
-{
-function TRxDBGrid.GetMarkerDown: TBitmap;
-begin
- Result:=FMarkerDown;
-end;
-function TRxDBGrid.GetMarkerUp: TBitmap;
-begin
- Result:=FMarkerUp;
-end;
-}
function TRxDBGrid.GetDrawFullLine: boolean;
begin
Result := FFooterOptions.FDrawFullLine;
@@ -6031,433 +6021,6 @@ begin
inherited Destroy;
end;
-(*
-{ TRxColumnFooter }
-
-procedure TRxColumnFooter.SetValue(const AValue: string);
-begin
- if FValue = AValue then
- exit;
- FValue := AValue;
- FOwner.ColumnChanged;
-end;
-
-procedure TRxColumnFooter.SetDisplayFormat(const AValue: string);
-begin
- if FDisplayFormat = AValue then
- exit;
- FDisplayFormat := AValue;
- FOwner.ColumnChanged;
-end;
-
-procedure TRxColumnFooter.SetAlignment(const AValue: TAlignment);
-begin
- if FAlignment = AValue then
- exit;
- FAlignment := AValue;
- FOwner.ColumnChanged;
-end;
-
-procedure TRxColumnFooter.FontChanged(Sender: TObject);
-begin
- FisDefaultFont := False;
- FOwner.ColumnChanged;
-end;
-
-function TRxColumnFooter.GetFont: TFont;
-begin
- result := FFont;
-end;
-
-function TRxColumnFooter.IsFontStored: Boolean;
-begin
- result := not FisDefaultFont;
-end;
-
-procedure TRxColumnFooter.SetFieldName(const AValue: string);
-begin
- if FFieldName = AValue then
- exit;
- FFieldName := AValue;
- FOwner.ColumnChanged;
-end;
-
-procedure TRxColumnFooter.SetFont(AValue: TFont);
-begin
- if not FFont.IsEqual(AValue) then
- FFont.Assign(AValue);
-end;
-
-procedure TRxColumnFooter.SetLayout(const AValue: TTextLayout);
-begin
- if FLayout = AValue then
- exit;
- FLayout := AValue;
- FOwner.ColumnChanged;
-end;
-
-procedure TRxColumnFooter.SetValueType(const AValue: TFooterValueType);
-begin
- if FValueType = AValue then
- exit;
- FValueType := AValue;
- if FValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then
- TRxDBGrid(FOwner.Grid).CalcStatTotals;
- FOwner.ColumnChanged;
-end;
-
-function TRxColumnFooter.DisplayText: string;
-begin
- case FValueType of
- fvtSum,
- fvtAvg,
- fvtMax,
- fvtMin: Result := GetStatTotal;
- fvtCount: Result := GetRecordsCount;
- fvtFieldValue: Result := GetFieldValue;
- fvtStaticText: Result := FValue;
- fvtRecNo: Result := GetRecNo;
- else
- Result := '';
- end;
-end;
-
-procedure TRxColumnFooter.FillDefaultFont;
-var
- AGrid: TCustomGrid;
-begin
- AGrid := FOwner.Grid;
- if (AGrid<>nil) then
- begin
- FFont.Assign(AGrid.Font);
- FIsDefaultFont := True;
- end;
-end;
-
-function TRxColumnFooter.GetFieldValue: string;
-begin
- if (FFieldName <> '') and TRxDBGrid(FOwner.Grid).DatalinkActive then
- Result := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName).AsString
- else
- Result := '';
-end;
-
-function TRxColumnFooter.GetRecordsCount: string;
-begin
- if TRxDBGrid(FOwner.Grid).DatalinkActive then
- begin
- if DisplayFormat <> '' then
- Result := Format(DisplayFormat,
- [{TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount} FCountRec])
- else
- Result := IntToStr(FCountRec); //TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount);
- end
- else
- Result := '';
-end;
-
-function TRxColumnFooter.GetRecNo: string;
-begin
- if TRxDBGrid(FOwner.Grid).DatalinkActive then
- begin
- if DisplayFormat <> '' then
- Result := Format(DisplayFormat, [TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecNo])
- else
- Result := IntToStr(TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecNo);
- end
- else
- Result := '';
-end;
-
-function TRxColumnFooter.GetStatTotal: string;
-var
- F: TField;
-begin
- if (FFieldName <> '') and TRxDBGrid(FOwner.Grid).DatalinkActive and
- (TRxDBGrid(FOwner.Grid).DataSource.DataSet.RecordCount <> 0) then
- begin
- F := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName);
- if Assigned(F) then
- begin
- if F.DataType in [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
- ftDate, ftTime, ftDateTime, ftTimeStamp, ftLargeint, ftBCD] then
- begin
- if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- begin
- if FValueType in [fvtSum, fvtAvg] then
- Result := ''
- else
- if FTestValue = 0 then
- Result := ''
- else
- if FDisplayFormat = '' then
- Result := DateToStr(FTestValue)
- else
- Result := FormatDateTime(FDisplayFormat, FTestValue);
- end
- else
- if F.DataType in [ftSmallint, ftInteger, ftWord, ftLargeint] then
- begin
- if FDisplayFormat = '' then
- Result := IntToStr(Round(FTestValue))
- else
- Result := Format(FDisplayFormat, [Round(FTestValue)]);
- end
- else
- begin
- if FDisplayFormat <> '' then
- Result := FormatFloat(FDisplayFormat, FTestValue)
- else
- if F.DataType = ftCurrency then
- Result := FloatToStrF(FTestValue, ffCurrency, 12, 2)
- else
- Result := FloatToStr(FTestValue);
- end;
- end
- else
- Result := '';
- end
- else
- Result := '';
- end
- else
- Result := '';
-end;
-
-procedure TRxColumnFooter.ResetTestValue;
-var
- F: TField;
-begin
- FTestValue := 0;
- FCountRec:=0;
-
- if (ValueType in [fvtMin, fvtMax]) and (TRxDBGrid(
- FOwner.Grid).DataSource.DataSet.RecordCount <> 0) then
- begin
- F := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName);
- if (Assigned(F)) and not (F.IsNull) then
- if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- FTestValue := F.AsDateTime
- else
- FTestValue := F.AsFloat;
- end;
-end;
-
-procedure TRxColumnFooter.UpdateTestValue;
-var
- F: TField;
-begin
- if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then
- begin
- F := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FindField(FFieldName);
- if Assigned(F) then
- begin
- if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- begin
- case FValueType of
- fvtMax: FTestValue := Max(FTestValue, F.AsDateTime);
- fvtMin: FTestValue := Min(FTestValue, F.AsDateTime);
- end;
- end
- else
- begin
- case FValueType of
- fvtSum: FTestValue := FTestValue + F.AsFloat;
- // fvtAvg:
- fvtMax: FTestValue := Max(FTestValue, F.AsFloat);
- fvtMin: FTestValue := Min(FTestValue, F.AsFloat);
- end;
- end;
- end;
- end;
-end;
-
-function TRxColumnFooter.DeleteTestValue: boolean;
-var
- F: TField;
-begin
- Result := True;
- if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then
- begin
- F := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName);
- if (Assigned(F)) and not (F.IsNull) then
- if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- Result := not ((FValueType in [fvtMax, fvtMin]) and (FTestValue = F.AsDateTime))
- else
- if FValueType in [fvtMax, fvtMin] then
- Result := (FTestValue <> F.AsFloat)
- else
- FTestValue := FTestValue - F.AsFloat;
- end;
-end;
-
-function TRxColumnFooter.PostTestValue: boolean;
-var
- F: TField;
-begin
- Result := True;
- if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then
- begin
- F := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName);
- if Assigned(F) then
- if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- begin
- if FValueType in [fvtMax, fvtMin] then
- if F.DataSet.State = dsinsert then
- begin
- if not (F.IsNull) then
- case FValueType of
- fvtMax: FTestValue := Max(FTestValue, F.AsDateTime);
- fvtMin: FTestValue := Min(FTestValue, F.AsDateTime);
- end;
- end
- else
- if (F.OldValue <> null) and (FTestValue = TDateTime(F.OldValue)) then
- Result := False
- else
- if not F.IsNull then
- case FValueType of
- fvtMax: FTestValue := Max(FTestValue, F.AsDateTime);
- fvtMin: FTestValue := Min(FTestValue, F.AsDateTime);
- end;
- end
- else
- if F.DataSet.State = dsinsert then
- begin
- if not F.IsNull then
- case FValueType of
- fvtSum: FTestValue := FTestValue + F.AsFloat;
- fvtMax: FTestValue := Max(FTestValue, F.AsFloat);
- fvtMin: FTestValue := Min(FTestValue, F.AsFloat);
- end;
- end
- else
- if (FValueType in [fvtMax, fvtMin]) and (F.OldValue <> null) and
- (FTestValue = Float(F.OldValue)) then
- Result := False
- else
- case FValueType of
- fvtSum:
- begin
- if not F.IsNull then
- begin
- if F.OldValue <> null then
- FTestValue := FTestValue - Float(F.OldValue);
- FTestValue := FTestValue + F.AsFloat;
- end;
- end;
- fvtMax: if not F.IsNull then
- FTestValue := Max(FTestValue, F.AsFloat);
- fvtMin: if not F.IsNull then
- FTestValue := Min(FTestValue, F.AsFloat);
- end;
- end;
-end;
-
-function TRxColumnFooter.ErrorTestValue: boolean;
-var
- F: TField;
-begin
- Result := True;
- if ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then
- begin
- F := TRxDBGrid(FOwner.Grid).DataSource.DataSet.FieldByName(FFieldName);
- if Assigned(F) then
- begin
- if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- begin
- if (FValueType in [fvtMax, fvtMin]) and not (F.IsNull) then
- begin
- if not (F.IsNull) and (FTestValue = F.AsDateTime) then
- Result := False
- else
- if (F.DataSet.RecordCount <> 0) and (F.OldValue <> null) then
- begin
- case FValueType of
- fvtMax: FTestValue := Max(FTestValue, TDateTime(F.OldValue));
- fvtMin: FTestValue := Min(FTestValue, TDateTime(F.OldValue));
- end;
- end;
- end;
- end
- else
- if (FValueType in [fvtMax, fvtMin]) and not (F.IsNull) and (FTestValue = F.AsFloat) then
- Result := False
- else
- begin
- case FValueType of
- fvtSum:
- if F.DataSet.RecordCount = 0 then
- begin
-{ if not F.IsNull then
- FTestValue := FTestValue - F.AsFloat;}
- { TODO -oalexs : need rewrite this code - where difficult! }
- end
- else
- begin
- if F.OldValue <> null then
- FTestValue := FTestValue + Float(F.OldValue);
- if not F.IsNull then
- FTestValue := FTestValue - F.AsFloat;
- end;
- fvtMax:
- if (F.DataSet.RecordCount <> 0) and (F.OldValue <> null) then
- FTestValue := Max(FTestValue, Float(F.OldValue));
- fvtMin:
- if (F.DataSet.RecordCount <> 0) and (F.OldValue <> null) then
- FTestValue := Min(FTestValue, Float(F.OldValue));
- end;
- end;
- end;
- end;
-end;
-
-procedure TRxColumnFooter.UpdateTestValueFromVar(AValue: Variant);
-begin
- if FValueType in [fvtSum, fvtAvg, fvtMax, fvtMin] then
- begin
- if (not VarIsEmpty(AValue)) and (AValue <> null) and Assigned(FField) then
- begin
- if FField.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
- begin
- case FValueType of
- fvtMax: FTestValue := Max(FTestValue, AValue);
- fvtMin: FTestValue := Min(FTestValue, AValue);
- end;
- end
- else
- begin
- case FValueType of
- fvtSum,
- fvtAvg: FTestValue := FTestValue + AValue;
- fvtMax: FTestValue := Max(FTestValue, AValue);
- fvtMin: FTestValue := Min(FTestValue, AValue);
- end;
- end;
- end;
- end;
-end;
-
-///!
-constructor TRxColumnFooter.Create(Owner: TRxColumn);
-begin
- inherited Create;
- FOwner := Owner;
- FTestValue := 0;
- FLayout := tlCenter;
-
- FFont := TFont.Create;
- FillDefaultFont;
- FFont.OnChange := @FontChanged;
-end;
-
-destructor TRxColumnFooter.Destroy;
-begin
- FreeThenNil(FFont);
- inherited Destroy;
-end;
-*)
-
{ TFilterListCellEditor }
procedure TFilterListCellEditor.WndProc(var TheMessage: TLMessage);
diff --git a/components/rx/trunk/rxdbgridexportpdf.pas b/components/rx/trunk/rxdbgridexportpdf.pas
index a7edcffb9..ef0c6aa65 100644
--- a/components/rx/trunk/rxdbgridexportpdf.pas
+++ b/components/rx/trunk/rxdbgridexportpdf.pas
@@ -37,7 +37,7 @@ interface
{$IF (FPC_FULLVERSION >= 30101)}
uses
- Classes, SysUtils, DB, rxdbgrid, LazFreeTypeFontCollection, vclutils, fpPDF;
+ Classes, SysUtils, DB, rxdbgrid, LazFreeTypeFontCollection, vclutils, Graphics, fpPDF, EasyLazFreeType;
type
@@ -82,6 +82,7 @@ type
FOptions: TRxDBGridExportPdfOptions;
FProducerPDF: string;
FPdfOptions:TPdfExportOptions;
+ FCurPage: TPDFPage;
FWorkPages:TFPList;
FWorkPagesNeedCount:integer;
@@ -99,7 +100,10 @@ type
FHeaderFont:integer;
FBodyFont:integer;
FFooterFont:integer;
+ FExportFontHeader: TFreeTypeFont;
+ FExportFontBody: TFreeTypeFont;
+ procedure WriteTextRect(AExportFont:TFreeTypeFont; X, Y, W, H:integer; AText:string; ATextAlign:TAlignment);
procedure DoExportTitle;
procedure DoExportBody;
procedure DoSetupFonts;
@@ -129,7 +133,14 @@ type
implementation
{$IF (FPC_FULLVERSION >= 30101)}
-uses rxdconst, FileUtil, forms, LCLIntf, LazFileUtils, EasyLazFreeType;
+uses Grids, rxdconst, FileUtil, Forms, Controls, LCLIntf, LazFileUtils, RxDBGridExportPdfSetupUnit;
+
+function ColorToDdfColor(C:TColor):TARGBColor;
+var
+ A:array [1..4] of byte absolute C;
+begin
+ Result:={A[1] shl 24 +} A[1] shl 16 + A[2] shl 8 + A[3];
+end;
{ TPdfExportOptions }
@@ -170,19 +181,50 @@ begin
FPdfOptions.Assign(AValue);
end;
+procedure TRxDBGridExportPDF.WriteTextRect(AExportFont: TFreeTypeFont; X, Y, W,
+ H: integer; AText: string; ATextAlign: TAlignment);
+var
+ FTW, FTH: Single;
+ X1: TPDFFloat;
+ Y1: TPDFFloat;
+begin
+ FTW:=AExportFont.TextWidth(AText);
+ FTH:=AExportFont.TextHeight(AText);
+ case ATextAlign of
+ taLeftJustify:
+ begin
+ Y1:=Y;
+ X1:=X + constCellPadding;
+ end;
+ taRightJustify:
+ begin
+ Y1:=Y;
+ X1:=X + W - FTW - 2;
+ if X1 < X then
+ X1:=X;
+ end;
+ taCenter:
+ begin
+ Y1:=Y;
+ X1:=(X + W) / 2 - FTW / 2 - constCellPadding;
+ if X1 < X then
+ X1:=X;
+ end;
+ end;
+ FCurPage.WriteText(X1, Y1 - FTH, AText);
+end;
+
procedure TRxDBGridExportPDF.DoExportTitle;
var
- P: TPDFPage;
- Pt: TPDFCoord;
- i, X, CP, PX: Integer;
+ i, X, CP: Integer;
C: TRxColumn;
S: String;
PU: TPDFUnitOfMeasure;
+ WW: Single;
begin
X:=FPageWidth + FPageMargin.Right;
CP:=-1;
- PX:=0;
-
+ FCurPage:=nil;
for i:=0 to FRxDBGrid.Columns.Count - 1 do
begin
C:=FRxDBGrid.Columns[i];
@@ -190,19 +232,18 @@ begin
if X + C.Width > FPageWidth - FPageMargin.Right then
begin
Inc(CP);
- P:=TPDFPage(FWorkPages[CP]);
+ FCurPage:=TPDFPage(FWorkPages[CP]);
X:=FPageMargin.Left;
- PX:=0;
end;
- Pt.X := X;
- Pt.Y := FPosY;
- P.SetColor(C.Color);
- P.DrawRect(Pt.X, Pt.Y, C.Width, FRxDBGrid.DefaultRowHeight, 1, false, true);
+ FCurPage.SetColor(ColorToDdfColor(FRxDBGrid.BorderColor), true);
+ FCurPage.DrawRect(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, 1, false, true);
- P.SetFont(FHeaderFont, 10);
- P.WriteText(Pt.X+2, Pt.Y-10, C.Title.Caption);
+ FCurPage.SetFont(FHeaderFont, 10);
+ FExportFontHeader.SizeInPoints:=10;
+ FCurPage.SetColor(ColorToDdfColor(C.Title.Font.Color), false);
+ WriteTextRect(FExportFontHeader, X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, C.Title.Caption, C.Title.Alignment);
X:=X + C.Width;
end;
@@ -213,41 +254,38 @@ end;
procedure TRxDBGridExportPDF.DoExportBody;
procedure DoWriteRow;
var
- P: TPDFPage;
- Pt: TPDFCoord;
i, X, CP: Integer;
C: TRxColumn;
S: String;
begin
- X:=FPageMargin.Left;
- CP:=0;
- P:=TPDFPage(FWorkPages[CP]);
+ X:=FPageWidth + FPageMargin.Right;
+ CP:=-1;
+ FCurPage:=nil;
for i:=0 to FRxDBGrid.Columns.Count - 1 do
begin
C:=FRxDBGrid.Columns[i];
-
-
- Pt.X := X;
- Pt.Y := FPosY;
- P.SetColor(C.Color);
- P.DrawRect(Pt.X, Pt.Y, C.Width, FRxDBGrid.DefaultRowHeight, 1, false, true);
-
-
- if Assigned(C.Field) then
- begin
- P.SetFont(FBodyFont, 10);
- P.WriteText(Pt.X+2, Pt.Y-10, C.Field.DisplayText);
- end;
-
if X + C.Width > FPageWidth - FPageMargin.Right then
begin
Inc(CP);
- P:=TPDFPage(FWorkPages[CP]);
+ FCurPage:=TPDFPage(FWorkPages[CP]);
X:=FPageMargin.Left;
- end
- else
- Inc(X, C.Width);
+ end;
+
+ FCurPage.SetColor(ColorToDdfColor(FRxDBGrid.BorderColor), true); //Border
+ //FCurPage.SetColor(ColorToDdfColor(C.Color), false); // Fill color
+ FCurPage.DrawRect(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, 1, false, true);
+
+ if Assigned(C.Field) then
+ begin
+ FCurPage.SetFont(FBodyFont, 10);
+ FExportFontBody.SizeInPoints:=10;
+ FCurPage.SetColor(ColorToDdfColor(C.Font.Color), false);
+ WriteTextRect(FExportFontBody, X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, C.Field.DisplayText, C.Alignment);
+ end;
+
+
+ X:=X + C.Width;
end;
end;
@@ -269,26 +307,34 @@ procedure TRxDBGridExportPDF.DoSetupFonts;
var
FM: TCustomFamilyCollectionItem;
FIH, FI: TCustomFontCollectionItem;
+ B: Boolean;
begin
-
+ FExportFontHeader:=nil;
FFontCollection:=TFreeTypeFontCollection.Create;
InitFonts(FFontCollection);
- FM:=FFontCollection.Family['Arial'];
+ FM:=FFontCollection.Family['Liberation Sans'];
+ if not Assigned(FM) then
+ FM:=FFontCollection.Family['Arial'];
+
if Assigned(FM) then
begin
- FIH:=FM.GetFont(['Bold']);
+ FIH:=FM.GetFont('Bold');
if Assigned(FIH) then
begin
+ B:=FIH.Bold;
FPDFDocument.FontDirectory := ExtractFileDir(FIH.Filename);
FHeaderFont := FPDFDocument.AddFont(ExtractFileName(FIH.Filename), FIH.Information[ftiFullName]);
+ FExportFontHeader:=FIH.CreateFont;
end;
FI:=FM.GetFont('Regular');
if Assigned(FI) then
begin
- FPDFDocument.FontDirectory := ExtractFileDir(FIH.Filename);
- FBodyFont := FPDFDocument.AddFont(ExtractFileName(FIH.Filename), FIH.Information[ftiFullName]);
+ B:=FI.Bold;
+ FPDFDocument.FontDirectory := ExtractFileDir(FI.Filename);
+ FBodyFont := FPDFDocument.AddFont(ExtractFileName(FI.Filename), FI.Information[ftiFullName]);
+ FExportFontBody:=FI.CreateFont;
end;
if not Assigned(FIH) then
@@ -299,7 +345,7 @@ begin
FFontCollection.Free;
if not Assigned(FM) then
- raise Exception.Create('Not found arial font');
+ raise Exception.Create('Not found Sans font');
end;
procedure TRxDBGridExportPDF.DoExportFooter;
@@ -310,6 +356,7 @@ end;
procedure TRxDBGridExportPDF.DoSetupDocHeader;
var
W, i: Integer;
+ C: TRxColumn;
begin
FPDFDocument.Infos.Title := Application.Title;
FPDFDocument.Infos.Author := FAuthorPDF;
@@ -335,16 +382,17 @@ begin
FPageHeight := PDFPaperSizes[FPdfOptions.FPaperType, 1];
end;
- W:=FPageMargin.Left;
- for i:=0 to FRxDBGrid.Columns.Count-1 do
+ W:=FPageWidth + FPageMargin.Right;
+ FWorkPagesNeedCount:=0;
+ for i:=0 to FRxDBGrid.Columns.Count - 1 do
begin
- W:=W + FRxDBGrid.Columns[i].Width;
-
- if W > FPageWidth - FPageMargin.Right then
+ C:=FRxDBGrid.Columns[i];
+ if W + C.Width > FPageWidth - FPageMargin.Right then
begin
Inc(FWorkPagesNeedCount);
W:=FPageMargin.Left;
end;
+ W:=W + C.Width;
end;
end;
end;
@@ -410,6 +458,9 @@ begin
FreeAndNil(FWorkPages);
FreeAndNil(FPDFDocument);
+
+ if Assigned(FExportFontHeader) then
+ FreeAndNil(FExportFontHeader);
end;
if Result and FOpenAfterExport then
@@ -418,7 +469,22 @@ end;
function TRxDBGridExportPDF.DoSetupTools: boolean;
begin
- Result:=inherited DoSetupTools;
+ RxDBGridExportPdfSetupForm:=TRxDBGridExportPdfSetupForm.Create(Application);
+ RxDBGridExportPdfSetupForm.FileNameEdit1.FileName:=FileName;
+ RxDBGridExportPdfSetupForm.cbOpenAfterExport.Checked:=FOpenAfterExport;
+ RxDBGridExportPdfSetupForm.cbExportColumnHeader.Checked:=repExportTitle in FOptions;
+
+ Result:=RxDBGridExportPdfSetupForm.ShowModal = mrOk;
+ if Result then
+ begin
+ FileName:=RxDBGridExportPdfSetupForm.FileNameEdit1.FileName;
+ FOpenAfterExport:=RxDBGridExportPdfSetupForm.cbOpenAfterExport.Checked;
+ if RxDBGridExportPdfSetupForm.cbExportColumnHeader.Checked then
+ FOptions:=FOptions + [repExportTitle]
+ else
+ FOptions:=FOptions - [repExportTitle];
+ end;
+ RxDBGridExportPdfSetupForm.Free;
end;
procedure TRxDBGridExportPDF.DoSaveDocument;
diff --git a/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm b/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm
new file mode 100644
index 000000000..5e56ee4ee
--- /dev/null
+++ b/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm
@@ -0,0 +1,132 @@
+object RxDBGridExportPdfSetupForm: TRxDBGridExportPdfSetupForm
+ Left = 544
+ Height = 254
+ Top = 387
+ Width = 518
+ Caption = 'Export params'
+ ClientHeight = 254
+ ClientWidth = 518
+ OnCreate = FormCreate
+ LCLVersion = '1.7'
+ object Label1: TLabel
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Owner
+ Left = 6
+ Height = 20
+ Top = 6
+ Width = 105
+ BorderSpacing.Around = 6
+ Caption = 'Export file name'
+ FocusControl = FileNameEdit1
+ ParentColor = False
+ end
+ object FileNameEdit1: TFileNameEdit
+ AnchorSideLeft.Control = Label1
+ AnchorSideTop.Control = Label1
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 12
+ Height = 37
+ Top = 32
+ Width = 500
+ Filter = 'All files (*.*)|*.*|LibreOffice/OpenOffice (*.ods)|*.ods|Excell 97-2003|*.xls|Excell 2007-2013|*.xlxs'
+ FilterIndex = 0
+ HideDirectories = False
+ ButtonWidth = 23
+ NumGlyphs = 1
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Around = 6
+ MaxLength = 0
+ TabOrder = 0
+ end
+ object cbOpenAfterExport: TCheckBox
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = FileNameEdit1
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 24
+ Top = 75
+ Width = 141
+ BorderSpacing.Around = 6
+ Caption = 'Open after export'
+ TabOrder = 1
+ end
+ object cbExportColumnHeader: TCheckBox
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = cbOpenAfterExport
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 24
+ Top = 105
+ Width = 167
+ BorderSpacing.Around = 6
+ Caption = 'Export column header'
+ TabOrder = 2
+ end
+ object cbExportColumnFooter: TCheckBox
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = cbExportColumnHeader
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 24
+ Top = 135
+ Width = 162
+ BorderSpacing.Around = 6
+ Caption = 'Export column footer'
+ Enabled = False
+ TabOrder = 3
+ end
+ object cbExportCellColors: TCheckBox
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = cbExportColumnFooter
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 24
+ Top = 165
+ Width = 138
+ BorderSpacing.Around = 6
+ Caption = 'Export cell colors'
+ Enabled = False
+ TabOrder = 4
+ end
+ object cbOverwriteExisting: TCheckBox
+ AnchorSideLeft.Control = Label4
+ AnchorSideTop.Control = FileNameEdit1
+ AnchorSideTop.Side = asrBottom
+ Left = 265
+ Height = 24
+ Top = 75
+ Width = 168
+ BorderSpacing.Around = 6
+ Caption = 'Overwrite existing file'
+ Enabled = False
+ TabOrder = 5
+ end
+ object ButtonPanel1: TButtonPanel
+ Left = 6
+ Height = 46
+ Top = 202
+ Width = 506
+ 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
+ object Label4: TLabel
+ AnchorSideLeft.Control = Owner
+ AnchorSideLeft.Side = asrCenter
+ AnchorSideTop.Control = Owner
+ Left = 259
+ Height = 1
+ Top = 0
+ Width = 1
+ ParentColor = False
+ end
+end
diff --git a/components/rx/trunk/rxdbgridexportpdfsetupunit.pas b/components/rx/trunk/rxdbgridexportpdfsetupunit.pas
new file mode 100644
index 000000000..8d4df39f5
--- /dev/null
+++ b/components/rx/trunk/rxdbgridexportpdfsetupunit.pas
@@ -0,0 +1,87 @@
+{ TPdfExportOptions unit
+
+ Copyright (C) 2005-2013 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 RxDBGridExportPdfSetupUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ EditBtn, ButtonPanel;
+
+type
+
+ { TRxDBGridExportPdfSetupForm }
+
+ TRxDBGridExportPdfSetupForm = class(TForm)
+ ButtonPanel1: TButtonPanel;
+ cbExportCellColors: TCheckBox;
+ cbExportColumnFooter: TCheckBox;
+ cbExportColumnHeader: TCheckBox;
+ cbOpenAfterExport: TCheckBox;
+ cbOverwriteExisting: TCheckBox;
+ FileNameEdit1: TFileNameEdit;
+ Label1: TLabel;
+ Label4: TLabel;
+ procedure FormCreate(Sender: TObject);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ RxDBGridExportPdfSetupForm: TRxDBGridExportPdfSetupForm;
+
+implementation
+uses rxdconst;
+
+{$R *.lfm}
+
+{ TRxDBGridExportPdfSetupForm }
+
+procedure TRxDBGridExportPdfSetupForm.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;
+end;
+
+end.
+
diff --git a/components/rx/trunk/rxdbgridexportspreadsheet_paramsunit.lfm b/components/rx/trunk/rxdbgridexportspreadsheet_paramsunit.lfm
index 4c491e349..01bde6a9e 100644
--- a/components/rx/trunk/rxdbgridexportspreadsheet_paramsunit.lfm
+++ b/components/rx/trunk/rxdbgridexportspreadsheet_paramsunit.lfm
@@ -15,7 +15,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
Left = 6
Height = 20
Top = 6
- Width = 106
+ Width = 105
BorderSpacing.Around = 6
Caption = 'Export file name'
FocusControl = FileNameEdit1
@@ -28,7 +28,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
- Height = 30
+ Height = 37
Top = 32
Width = 530
Filter = 'All files (*.*)|*.*|LibreOffice/OpenOffice (*.ods)|*.ods|Excell 97-2003|*.xls|Excell 2007-2013|*.xlxs'
@@ -39,6 +39,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
MaxLength = 0
+ Spacing = 0
TabOrder = 0
end
object Label3: TLabel
@@ -47,7 +48,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 280
Height = 20
- Top = 128
+ Top = 135
Width = 71
BorderSpacing.Around = 6
Caption = 'Page name'
@@ -61,8 +62,8 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 286
- Height = 30
- Top = 154
+ Height = 37
+ Top = 161
Width = 256
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
@@ -74,7 +75,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
- Top = 128
+ Top = 135
Width = 162
BorderSpacing.Around = 6
Caption = 'Export column footer'
@@ -86,7 +87,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
- Top = 68
+ Top = 75
Width = 141
BorderSpacing.Around = 6
Caption = 'Open after export'
@@ -94,8 +95,8 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
end
object ButtonPanel1: TButtonPanel
Left = 6
- Height = 42
- Top = 198
+ Height = 46
+ Top = 194
Width = 536
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
@@ -114,8 +115,8 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
- Top = 98
- Width = 166
+ Top = 105
+ Width = 167
BorderSpacing.Around = 6
Caption = 'Export column header'
TabOrder = 2
@@ -126,8 +127,8 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 6
Height = 24
- Top = 158
- Width = 137
+ Top = 165
+ Width = 138
BorderSpacing.Around = 6
Caption = 'Export cell colors'
TabOrder = 4
@@ -148,7 +149,7 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 280
Height = 24
- Top = 98
+ Top = 105
Width = 168
BorderSpacing.Around = 6
Caption = 'Overwrite existing file'
@@ -160,8 +161,8 @@ object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsFo
AnchorSideTop.Side = asrBottom
Left = 280
Height = 24
- Top = 68
- Width = 120
+ Top = 75
+ Width = 121
BorderSpacing.Around = 6
Caption = 'Export formula'
TabOrder = 5
diff --git a/components/rx/trunk/rxnew.lpk b/components/rx/trunk/rxnew.lpk
index 28088cbd9..6a48820fd 100644
--- a/components/rx/trunk/rxnew.lpk
+++ b/components/rx/trunk/rxnew.lpk
@@ -26,7 +26,7 @@ translate to Lazarus by alexs in 2005 - 2016
"/>
-
+
@@ -302,6 +302,14 @@ translate to Lazarus by alexs in 2005 - 2016
+
+
+
+
+
+
+
+
diff --git a/components/rx/trunk/rxnew.pas b/components/rx/trunk/rxnew.pas
index c0aaabc30..9798a0882 100644
--- a/components/rx/trunk/rxnew.pas
+++ b/components/rx/trunk/rxnew.pas
@@ -20,7 +20,7 @@ uses
ex_rx_bin_datapacket, ex_rx_datapacket, ex_rx_xml_datapacket, rxsortby,
RxMDI, RxIniPropStorage, rxDateRangeEditUnit, RxDBGridFooterTools,
rxdbgridfootertools_setup, rxShortCutUnit, RxDBGridExportPdf,
- LazarusPackageIntf;
+ RxDBGridExportPdfSetupUnit, LazarusPackageIntf;
implementation