From 2047c32696bed6ab5b4f63e4d46274df6c1bb599 Mon Sep 17 00:00:00 2001 From: alexs75 Date: Thu, 18 Aug 2016 07:53:51 +0000 Subject: [PATCH] RxFPC:Rewrite work with fonts in RxDBGrid export to pdf git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5092 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../Demos/RxDbGridExportToPDF/project1.lps | 360 ++++++------ .../trunk/Demos/RxDbGridExportToPDF/unit1.lfm | 141 +++-- .../trunk/Demos/RxDbGridExportToPDF/unit1.pas | 17 +- components/rx/trunk/rxdbgridexportpdf.pas | 534 +++++++++++++++--- .../rx/trunk/rxdbgridexportpdfsetupunit.lfm | 1 - 5 files changed, 766 insertions(+), 287 deletions(-) diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps index dbe3f9c56..ba8d8a1b4 100644 --- a/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps +++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/project1.lps @@ -3,13 +3,13 @@ - + - + @@ -18,9 +18,9 @@ - - - + + + @@ -30,14 +30,15 @@ - + - - - - + + + + + @@ -45,28 +46,28 @@ - + - + - + - + @@ -74,25 +75,25 @@ - + - + - - - + + + - + @@ -102,51 +103,53 @@ - + - + - + - + - + - - - - + + + + + - - - - + + + + + @@ -156,36 +159,36 @@ - + - - - + + + - + - + - + @@ -193,21 +196,22 @@ - + - - + + + - - - + + + @@ -215,7 +219,7 @@ - + @@ -223,13 +227,13 @@ - + - + @@ -238,14 +242,14 @@ - + - + @@ -253,28 +257,28 @@ - + - + - + - + @@ -284,41 +288,41 @@ - + - + - + - + - + - + @@ -326,7 +330,7 @@ - + @@ -335,21 +339,21 @@ - + - + - + @@ -359,63 +363,64 @@ - + - + - + - + - + - - - + + + + - - - + + + - + - + @@ -423,15 +428,15 @@ - + - - - + + + @@ -439,7 +444,7 @@ - + @@ -447,7 +452,7 @@ - + @@ -455,12 +460,10 @@ - - - - - - + + + + @@ -471,7 +474,7 @@ - + @@ -479,150 +482,181 @@ - + - - - - + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + - + - + - + - - + + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - - + + - + - + - + - + @@ -630,22 +664,32 @@ - - - - - - - + + + + + - + + + + + - - + + + + + + + + + + diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm index 7ad29c6cd..5ba556558 100644 --- a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm +++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.lfm @@ -11,12 +11,12 @@ object Form1: TForm1 LCLVersion = '1.7' object Panel1: TPanel Left = 0 - Height = 50 - Top = 347 + Height = 51 + Top = 346 Width = 1043 Align = alBottom AutoSize = True - ClientHeight = 50 + ClientHeight = 51 ClientWidth = 1043 TabOrder = 0 object Button1: TButton @@ -34,26 +34,50 @@ object Form1: TForm1 TabOrder = 0 end object CheckBox1: TCheckBox - Left = 1 + AnchorSideLeft.Control = Panel1 + AnchorSideBottom.Control = Edit1 + AnchorSideBottom.Side = asrBottom + Left = 7 Height = 24 - Top = 18 - Width = 99 - Caption = 'CheckBox1' + Top = 20 + Width = 85 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 6 + Caption = 'Use filter' OnChange = CheckBox1Change TabOrder = 1 end object Edit1: TEdit - Left = 137 + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Button1 + Left = 247 Height = 37 Top = 7 - Width = 295 + Width = 223 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 TabOrder = 2 Text = 'ID=1' end + object Label1: TLabel + AnchorSideLeft.Control = CheckBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Edit1 + AnchorSideBottom.Side = asrBottom + Left = 92 + Height = 20 + Top = 24 + Width = 149 + Anchors = [akLeft, akBottom] + Caption = 'Enter filter expression^' + ParentColor = False + end end object PageControl1: TPageControl Left = 0 - Height = 347 + Height = 346 Top = 0 Width = 1043 ActivePage = TabSheet1 @@ -62,11 +86,11 @@ object Form1: TForm1 TabOrder = 1 object TabSheet1: TTabSheet Caption = 'Test data' - ClientHeight = 313 + ClientHeight = 312 ClientWidth = 1033 object RxDBGrid1: TRxDBGrid Left = 0 - Height = 313 + Height = 312 Top = 0 Width = 1033 ColumnDefValues.BlobText = '(данные)' @@ -86,21 +110,6 @@ object Form1: TForm1 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 @@ -115,6 +124,39 @@ object Form1: TForm1 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 + 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> + end item Title.Alignment = taCenter Title.Orientation = toHorizontal @@ -126,7 +168,29 @@ object Form1: TForm1 Filter.EmptyValue = '(Нет)' Filter.EmptyFont.Style = [fsItalic] Filter.ItemIndex = -1 - Footers = <> + 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 Title.Alignment = taCenter @@ -210,11 +274,16 @@ object Form1: TForm1 ShortCut = 16451 Enabled = True end> - FooterOptions.DrawFullLine = False - OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter, rdgAllowToolMenu] + FooterOptions.Active = True + FooterOptions.Color = clYellow + FooterOptions.RowCount = 3 + FooterOptions.DrawFullLine = True + OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgFooterRows, rdgAllowQuickFilter, rdgAllowToolMenu] + FooterColor = clYellow + FooterRowCount = 3 Align = alClient Color = clWindow - DrawFullLine = False + DrawFullLine = True FocusColor = clRed SelectedColor = clHighlight GridLineStyle = psSolid @@ -226,7 +295,7 @@ object Form1: TForm1 end object TabSheet2: TTabSheet Caption = 'Debug window' - ClientHeight = 313 + ClientHeight = 312 ClientWidth = 1033 object Memo1: TMemo Left = 0 @@ -242,32 +311,39 @@ object Form1: TForm1 end end object RxMemoryData1: TRxMemoryData + Active = True 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> PacketRecords = 0 @@ -342,7 +418,6 @@ object Form1: TForm1 object RxDBGridExportPDF1: TRxDBGridExportPDF RxDBGrid = RxDBGrid1 Caption = 'Export to PDF file' - ShowSetupForm = True FileName = 'test111.pdf' Options = [repExportTitle, repExportColors, repExportFooter] PdfOptions.Options = [] diff --git a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas index b19f2f3f0..6e7aff9b6 100644 --- a/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas +++ b/components/rx/trunk/Demos/RxDbGridExportToPDF/unit1.pas @@ -18,6 +18,7 @@ type CheckBox1: TCheckBox; DataSource1: TDataSource; Edit1: TEdit; + Label1: TLabel; Memo1: TMemo; PageControl1: TPageControl; Panel1: TPanel; @@ -58,6 +59,7 @@ uses EasyLazFreeType, LazFreeTypeFontCollection, procedure TForm1.FormCreate(Sender: TObject); begin + RxDBGridExportPDF1.ShowSetupForm:=true; PageControl1.ActivePageIndex:=0; RxMemoryData1.Open; RxMemoryData1.AppendRecord([1, 'Строка с длинным текстом 1', now, 100, 'Россия', 'Москва']); @@ -119,6 +121,7 @@ end; FontCollection.BeginUpdate; try FindAllFiles(files, AFolder, '*.ttf', true); + //FindAllFiles(files, AFolder, '*.otf', true); files.Sort; for i := 0 to files.Count-1 do try @@ -153,6 +156,7 @@ var FFM: TCustomFamilyCollectionItem; I: Integer; FFI: TCustomFontCollectionItem; + tiInf: TFreeTypeInformation; begin FFM:=FontCollection.Family[AFontFamely]; if not Assigned(FFM) then @@ -171,7 +175,12 @@ begin FFI:=FFM.GetFont('Regular'); if Assigned(FFI) then - ShowInfo('REGULAR Font in file %s - NAME: %s', [FFI.Filename, FFI.Information[ftiFullName]]) + begin + ShowInfo('REGULAR Font in file %s - NAME: %s', [FFI.Filename, FFI.Information[ftiFullName]]); + + for tiInf := Low(TFreeTypeInformation) to high(TFreeTypeInformation) do + ShowInfo('%s - %s', [FreeTypeInformationStr[tiInf], FFI.Information[tiInf]]); + end else ShowInfo('Regular font not found', []); end; @@ -187,6 +196,10 @@ begin DumpFamaly('Sans'); DumpFamaly('Serif'); DumpFamaly('Liberation Sans'); + DumpFamaly('Gootville'); + DumpFamaly('Oxygen Mono'); + DumpFamaly('FreeSans'); + DumpFamaly('Noto Sans Tai Viet'); end else Memo1.Text:='FontCollection not assigned'; @@ -194,7 +207,9 @@ end; procedure TForm1.Button1Click(Sender: TObject); begin + RxDBGridExportPDF1.ShowSetupForm:=false; RxDBGridExportPDF1.Execute; + RxDBGridExportPDF1.ShowSetupForm:=true; end; procedure TForm1.CheckBox1Change(Sender: TObject); diff --git a/components/rx/trunk/rxdbgridexportpdf.pas b/components/rx/trunk/rxdbgridexportpdf.pas index 776d2fb59..e522c47ef 100644 --- a/components/rx/trunk/rxdbgridexportpdf.pas +++ b/components/rx/trunk/rxdbgridexportpdf.pas @@ -37,7 +37,8 @@ interface {$IF (FPC_FULLVERSION >= 30101)} uses - Classes, SysUtils, DB, rxdbgrid, LazFreeTypeFontCollection, vclutils, Graphics, fpPDF, EasyLazFreeType; + Classes, SysUtils, DB, rxdbgrid, LazFreeTypeFontCollection, vclutils, Graphics, fpPDF, EasyLazFreeType, + contnrs; type @@ -67,6 +68,56 @@ type end; type + TRxDBGridExportPDF = class; + TExportFonts = class; + + { TExportFontItem } + + TExportFontItem = class + private + FFontName: string; + FOwner:TExportFonts; + FBold: boolean; + FDefaultFont: boolean; + FFont: TFont; + // + FFreeTypeFont:TFreeTypeFont; + FPdfFont:integer; + function GetFontSize: Single; + procedure SetFontSize(AValue: Single); + + public + constructor Create(AOwner:TExportFonts; AFont:TFont; AFreeTypeFont:TFreeTypeFont); + destructor Destroy; override; + procedure Activate; + property FontSize:Single read GetFontSize write SetFontSize; + property Bold:boolean read FBold; + property DefaultFont:boolean read FDefaultFont; + property FontName:string read FFontName; + end; + + { TExportFonts } + + TExportFonts = class + private + FDefaultFontBold: TExportFontItem; + FDefaultFontNormal: TExportFontItem; + FOwner:TRxDBGridExportPDF; + FList:TFPList; + function GetCount: integer; + function GetItem(Index: integer): TExportFontItem; + public + constructor Create(AOwner:TRxDBGridExportPDF); + destructor Destroy; override; + procedure Clear; + function AddItem(AFont: TFont; AFontCollectionItem:TCustomFontCollectionItem; ADefStyle:TFontStyles = []): TExportFontItem; + function FindItem(AFont:TFont; ADefStyle:TFontStyles = []):TExportFontItem; + property DefaultFontNormal:TExportFontItem read FDefaultFontNormal; + property DefaultFontBold:TExportFontItem read FDefaultFontBold; + property Count:integer read GetCount; + property Item[Index:integer]:TExportFontItem read GetItem; + end; + { TRxDBGridExportPDF } @@ -87,33 +138,33 @@ type FWorkPagesNeedCount:integer; FFontCollection:TFreeTypeFontCollection; + FFontItems:TExportFonts; function GetPdfOptions: TPdfExportOptions; procedure SetPageMargin(AValue: TRxPageMargin); procedure SetPdfOptions(AValue: TPdfExportOptions); + function SelectFont(AFont:TFont):TExportFontItem; + function ActivateFont(AFont:TFont; AOwnerFont:TFont):TExportFontItem; protected FPDFDocument:TPDFDocument; FCurSection: TPDFSection; FDataSet:TDataSet; FPosY : integer; - FHeaderFont:integer; - FBodyFont:integer; - FFooterFont:integer; - FExportFontHeader: TFreeTypeFont; - FExportFontBody: TFreeTypeFont; + procedure DoSetupDocHeader; + procedure DoSetupFonts; - procedure WriteTextRect(AExportFont:TFreeTypeFont; X, Y, W, H:integer; AText:string; ATextAlign:TAlignment); + procedure WriteTextRect(AExportFont:TExportFontItem; X, Y, W, H:integer; AText:string; ATextAlign:TAlignment); + procedure StartNewPage; + + procedure DoExportPage; procedure DoExportTitle; procedure DoExportBody; - procedure DoSetupFonts; procedure DoExportFooter; + procedure DoSaveDocument; - procedure DoSetupDocHeader; - procedure DoExportPage; function DoExecTools:boolean;override; function DoSetupTools:boolean; override; - procedure DoSaveDocument; // procedure InitFonts(AFontCollection:TFreeTypeFontCollection); public @@ -145,6 +196,163 @@ begin Result:={A[1] shl 24 +} A[1] shl 16 + A[2] shl 8 + A[3]; end; +{ TExportFonts } + +function TExportFonts.GetCount: integer; +begin + Result:=FList.Count; +end; + +function TExportFonts.GetItem(Index: integer): TExportFontItem; +begin + Result:=TExportFontItem(FList[Index]); +end; + +constructor TExportFonts.Create(AOwner: TRxDBGridExportPDF); +begin + inherited Create; + FOwner:=AOwner; + FList:=TFPList.Create; +end; + +destructor TExportFonts.Destroy; +begin + Clear; + FreeAndNil(FList); + inherited Destroy; +end; + +procedure TExportFonts.Clear; +var + I: Integer; +begin + for I:=0 to FList.Count-1 do + TExportFontItem(FList[i]).Free; + FList.Clear; +end; + +function TExportFonts.AddItem(AFont: TFont; + AFontCollectionItem: TCustomFontCollectionItem; ADefStyle: TFontStyles + ): TExportFontItem; +var + S1, S2, S3: String; +begin + Result:=nil; + if not Assigned(AFont) then exit; + + Result:=FindItem(AFont, ADefStyle); + if not Assigned(AFont) then exit; + + Result:=TExportFontItem.Create(Self, AFont, AFontCollectionItem.CreateFont); + + S1:=ExtractFileDir(AFontCollectionItem.Filename); + S2:=ExtractFileName(AFontCollectionItem.Filename); + S3:=AFontCollectionItem.Information[ftiFullName]; + FOwner.FPDFDocument.FontDirectory:=S1; + Result.FPdfFont:=FOwner.FPDFDocument.AddFont(S2, S3); +end; + +function TExportFonts.FindItem(AFont: TFont; ADefStyle: TFontStyles + ): TExportFontItem; +var + K: TExportFontItem; + i: Integer; +begin + Result:=nil; + if not Assigned(AFont) then exit; + + if ADefStyle = [] then + ADefStyle:=AFont.Style; + + if AFont.Name = 'default' then + begin + for i:=0 to FList.Count - 1 do + begin + //Стили! + K:=TExportFontItem(FList[i]); + if K.DefaultFont then + begin + if (fsBold in ADefStyle) and K.Bold then + begin + Result:=K; + exit; + end + else + if (not (fsBold in ADefStyle)) and not K.Bold then + begin + Result:=K; + exit; + end; + end; + end; + end + else + begin + for i:=0 to FList.Count-1 do + begin + K:=TExportFontItem(FList[i]); + if K.FontName = AFont.Name then + begin + if (fsBold in ADefStyle) and K.Bold then + begin + Result:=K; + exit; + end + else + if (not (fsBold in ADefStyle)) and not K.Bold then + begin + Result:=K; + exit; + end; + end; + end; + end; +end; + +{ TExportFontItem } + +function TExportFontItem.GetFontSize: Single; +begin + Result:=FFreeTypeFont.SizeInPixels; +end; + +procedure TExportFontItem.SetFontSize(AValue: Single); +begin + FFreeTypeFont.SizeInPixels:=AValue; +end; + + +constructor TExportFontItem.Create(AOwner: TExportFonts; AFont: TFont; + AFreeTypeFont: TFreeTypeFont); +begin + inherited Create; + FOwner:=AOwner; + FOwner.FList.Add(Self); + FFont:=AFont; + FFreeTypeFont:=AFreeTypeFont; + FFontName:=AFont.Name; +end; + +destructor TExportFontItem.Destroy; +begin + FreeAndNil(FFreeTypeFont); + inherited Destroy; +end; + +procedure TExportFontItem.Activate; +var + FS: Integer; +begin + if FFont.Size = 0 then + FS:=10 + else + FS:=FFont.Size; + + FFreeTypeFont.SizeInPoints:=FS; + FOwner.FOwner.FCurPage.SetFont(FPdfFont, FS); + FOwner.FOwner.FCurPage.SetColor(ColorToDdfColor(FFont.Color), false); +end; + { TPdfExportOptions } procedure TPdfExportOptions.AssignTo(Dest: TPersistent); @@ -184,15 +392,44 @@ begin FPdfOptions.Assign(AValue); end; -procedure TRxDBGridExportPDF.WriteTextRect(AExportFont: TFreeTypeFont; X, Y, W, - H: integer; AText: string; ATextAlign: TAlignment); +function TRxDBGridExportPDF.SelectFont(AFont: TFont): TExportFontItem; +var + i: Integer; +begin + Result:=nil; + for i:=0 to FFontItems.Count-1 do + if FFontItems.Item[i].FFont = AFont then + begin + Result:=FFontItems.Item[i]; + Exit; + end; +end; + +function TRxDBGridExportPDF.ActivateFont(AFont: TFont; AOwnerFont: TFont + ): TExportFontItem; +begin + Result:=SelectFont(AFont); + if not Assigned(Result) then + Result:=SelectFont(AOwnerFont); + if not Assigned(Result) then + Result:=FFontItems.FDefaultFontNormal; + + if Assigned(Result) then + Result.Activate + else + raise Exception.Create('Font not found'); + +end; + +procedure TRxDBGridExportPDF.WriteTextRect(AExportFont: TExportFontItem; 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); + FTW:=AExportFont.FFreeTypeFont.TextWidth(AText); + FTH:=AExportFont.FFreeTypeFont.TextHeight(AText); case ATextAlign of taLeftJustify: begin @@ -217,6 +454,24 @@ begin FCurPage.WriteText(X1, Y1 - FTH, AText); end; +procedure TRxDBGridExportPDF.StartNewPage; +var + P: TPDFPage; + i: Integer; +begin + FWorkPages.Clear; + for i:=0 to FWorkPagesNeedCount - 1 do + begin + P := FPDFDocument.Pages.AddPage; + P.PaperType := FPdfOptions.PaperType; + P.UnitOfMeasure := uomPixels; + FCurSection.AddPage(P); + FWorkPages.Add(P); + end; + + FPosY:=FPageMargin.Top + 20; +end; + procedure TRxDBGridExportPDF.DoExportTitle; var i, X, CP: Integer; @@ -231,24 +486,23 @@ begin for i:=0 to FRxDBGrid.Columns.Count - 1 do begin C:=FRxDBGrid.Columns[i]; - - if X + C.Width > FPageWidth - FPageMargin.Right then + if C.Visible then begin - Inc(CP); - FCurPage:=TPDFPage(FWorkPages[CP]); - X:=FPageMargin.Left; + if X + C.Width > FPageWidth - FPageMargin.Right then + begin + Inc(CP); + FCurPage:=TPDFPage(FWorkPages[CP]); + X:=FPageMargin.Left; + end; + + FCurPage.SetColor(ColorToDdfColor(FRxDBGrid.BorderColor), true); + FCurPage.DrawRect(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, 1, false, true); + + + WriteTextRect(ActivateFont(C.Title.Font, FRxDBGrid.TitleFont), X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, C.Title.Caption, C.Title.Alignment); + + X:=X + C.Width; end; - - FCurPage.SetColor(ColorToDdfColor(FRxDBGrid.BorderColor), true); - FCurPage.DrawRect(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, 1, false, true); - - - 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; Inc(FPosY, FRxDBGrid.DefaultRowHeight); @@ -269,26 +523,24 @@ begin for i:=0 to FRxDBGrid.Columns.Count - 1 do begin C:=FRxDBGrid.Columns[i]; - if X + C.Width > FPageWidth - FPageMargin.Right then + if C.Visible then begin - Inc(CP); - FCurPage:=TPDFPage(FWorkPages[CP]); - X:=FPageMargin.Left; + if X + C.Width > FPageWidth - FPageMargin.Right then + begin + Inc(CP); + FCurPage:=TPDFPage(FWorkPages[CP]); + X:=FPageMargin.Left; + 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, true, true); + + if Assigned(C.Field) then + WriteTextRect(ActivateFont(C.Font, FRxDBGrid.Font), X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, C.Field.DisplayText, C.Alignment); + + X:=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, true, 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; @@ -299,24 +551,48 @@ begin FDataSet.Next; Inc(FPosY, FRxDBGrid.DefaultRowHeight); if FPosY > FPageHeight - FPageMargin.Bottom then - begin - FPosY:=FPageMargin.Top + 20; +{ begin + FPosY:=FPageMargin.Top + 20;} exit; - end; +// end; end; end; procedure TRxDBGridExportPDF.DoSetupFonts; + +procedure AddFonts(AFont:TFont); var FM: TCustomFamilyCollectionItem; - FIH, FI: TCustomFontCollectionItem; - B: Boolean; + S: String; + FIH: TCustomFontCollectionItem; begin - FExportFontHeader:=nil; - FFontCollection:=TFreeTypeFontCollection.Create; - InitFonts(FFontCollection); + S:=AFont.Name; + FM:=FFontCollection.Family[S]; + if Assigned(FM) then + begin + if fsBold in AFont.Style then + FIH:=FM.GetFont('Bold') + else + FIH:=FM.GetFont('Regular'); - FM:=FFontCollection.Family['Liberation Sans']; + if Assigned(FIH) then + FFontItems.AddItem(AFont, FIH); + end; +end; + +var + FM: TCustomFamilyCollectionItem; + FIH: TCustomFontCollectionItem; + F: TExportFontItem; + i: Integer; +begin + InitFonts(FFontCollection); + FM:=nil; + + if FRxDBGrid.Font.Name <> 'default' then + FM:=FFontCollection.Family[FRxDBGrid.Font.Name]; + if not Assigned(FM) then //Fill default fonts + FM:=FFontCollection.Family['Liberation Sans']; if not Assigned(FM) then FM:=FFontCollection.Family['Arial']; @@ -325,35 +601,98 @@ begin 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; + F:=FFontItems.AddItem(FRxDBGrid.TitleFont, FIH, [fsBold]); + F.FBold:=true; + F.FDefaultFont:=true; + FFontItems.FDefaultFontBold:=F; end; - FI:=FM.GetFont('Regular'); - if Assigned(FI) then + FIH:=FM.GetFont('Regular'); + if Assigned(FIH) then begin - B:=FI.Bold; - FPDFDocument.FontDirectory := ExtractFileDir(FI.Filename); - FBodyFont := FPDFDocument.AddFont(ExtractFileName(FI.Filename), FI.Information[ftiFullName]); - FExportFontBody:=FI.CreateFont; + F:=FFontItems.AddItem(FRxDBGrid.Font, FIH, []); + F.FDefaultFont:=true; + FFontItems.FDefaultFontNormal:=F; end; - - if not Assigned(FIH) then - FHeaderFont:=FBodyFont; - - FFooterFont := FHeaderFont; end; - FFontCollection.Free; if not Assigned(FM) then raise Exception.Create('Not found Sans font'); + + for i:=0 to FRxDBGrid.Columns.Count-1 do + begin + if FRxDBGrid.Columns[i].Font.Name <> 'default' then + AddFonts(FRxDBGrid.Columns[i].Font); + + if FRxDBGrid.Columns[i].Footer.Font.Name <> 'default' then + AddFonts(FRxDBGrid.Columns[i].Footer.Font); + + if FRxDBGrid.Columns[i].Title.Font.Name <> 'default' then + AddFonts(FRxDBGrid.Columns[i].Title.Font); + end; end; procedure TRxDBGridExportPDF.DoExportFooter; -begin +procedure WriteFooterRow(AFooterRow:Integer); +var + i, X, CP, FS: Integer; + S: String; + C: TRxColumn; +begin + X:=FPageWidth + FPageMargin.Right; + CP:=-1; + FCurPage:=nil; + + for i:=0 to FRxDBGrid.Columns.Count - 1 do + begin + C:=FRxDBGrid.Columns[i]; + if C.Visible then + begin + if X + C.Width > FPageWidth - FPageMargin.Right then + begin + Inc(CP); + FCurPage:=TPDFPage(FWorkPages[CP]); + X:=FPageMargin.Left; + end; + + FCurPage.SetColor(ColorToDdfColor(FRxDBGrid.BorderColor), true); //Border + FCurPage.SetColor(ColorToDdfColor(FRxDBGrid.FooterOptions.Color), false); // Fill color + FCurPage.DrawRect(X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, 1, true, true); + + if FRxDBGrid.FooterOptions.RowCount = 1 then + S:=C.Footer.DisplayText + else + begin + if C.Footers.Count > AFooterRow then + S:=C.Footers[AFooterRow].DisplayText + else + S:=''; + end; + + if (S<>'') then + WriteTextRect(ActivateFont(C.Footer.Font, FRxDBGrid.Font), X, FPosY, C.Width, FRxDBGrid.DefaultRowHeight, S, C.Footer.Alignment); + + X:=X + C.Width; + end; + end; + Inc(FPosY, FRxDBGrid.DefaultRowHeight); +end; + +var + j: Integer; +begin + if FRxDBGrid.FooterRowCount = 1 then + WriteFooterRow(1) + else + begin + for j:=0 to FRxDBGrid.FooterRowCount-1 do + begin + if FPosY > FPageHeight - FPageMargin.Bottom then + StartNewPage; + WriteFooterRow(j); + end; + end; end; procedure TRxDBGridExportPDF.DoSetupDocHeader; @@ -390,12 +729,15 @@ begin for i:=0 to FRxDBGrid.Columns.Count - 1 do begin C:=FRxDBGrid.Columns[i]; - if W + C.Width > FPageWidth - FPageMargin.Right then + if C.Visible then begin - Inc(FWorkPagesNeedCount); - W:=FPageMargin.Left; + if W + C.Width > FPageWidth - FPageMargin.Right then + begin + Inc(FWorkPagesNeedCount); + W:=FPageMargin.Left; + end; + W:=W + C.Width; end; - W:=W + C.Width; end; end; end; @@ -405,21 +747,10 @@ var P: TPDFPage; i: Integer; begin - FWorkPages.Clear; - for i:=0 to FWorkPagesNeedCount - 1 do - begin - P := FPDFDocument.Pages.AddPage; - P.PaperType := FPdfOptions.PaperType; - P.UnitOfMeasure := uomPixels; - FCurSection.AddPage(P); - FWorkPages.Add(P); - end; - - FPosY:=FPageMargin.Top + 20; + StartNewPage; if repExportTitle in FOptions then DoExportTitle; - DoExportBody; end; @@ -436,7 +767,9 @@ begin P:=FDataSet.Bookmark; {$ENDIF} + FFontCollection:=TFreeTypeFontCollection.Create; FPDFDocument:=TPDFDocument.Create(nil); + FFontItems:=TExportFonts.Create(Self); FWorkPages:=TFPList.Create; try DoSetupFonts; @@ -448,6 +781,14 @@ begin DoExportPage; until FDataSet.EOF; + if repExportTitle in FOptions then + begin + if FPosY > FPageHeight - FPageMargin.Bottom then + StartNewPage; + + DoExportFooter; + end; + DoSaveDocument; Result:=true; finally @@ -461,9 +802,8 @@ begin FreeAndNil(FWorkPages); FreeAndNil(FPDFDocument); - - if Assigned(FExportFontHeader) then - FreeAndNil(FExportFontHeader); + FreeAndNil(FFontItems); + FreeAndNil(FFontCollection); end; if Result and FOpenAfterExport then @@ -476,6 +816,7 @@ begin RxDBGridExportPdfSetupForm.FileNameEdit1.FileName:=FileName; RxDBGridExportPdfSetupForm.cbOpenAfterExport.Checked:=FOpenAfterExport; RxDBGridExportPdfSetupForm.cbExportColumnHeader.Checked:=repExportTitle in FOptions; + RxDBGridExportPdfSetupForm.cbExportColumnFooter.Checked:=repExportFooter in FOptions; Result:=RxDBGridExportPdfSetupForm.ShowModal = mrOk; if Result then @@ -486,6 +827,11 @@ begin FOptions:=FOptions + [repExportTitle] else FOptions:=FOptions - [repExportTitle]; + + if RxDBGridExportPdfSetupForm.cbExportColumnFooter.Checked then + FOptions:=FOptions + [repExportFooter] + else + FOptions:=FOptions - [repExportFooter]; end; RxDBGridExportPdfSetupForm.Free; end; diff --git a/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm b/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm index 5e56ee4ee..14af7c98d 100644 --- a/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm +++ b/components/rx/trunk/rxdbgridexportpdfsetupunit.lfm @@ -74,7 +74,6 @@ object RxDBGridExportPdfSetupForm: TRxDBGridExportPdfSetupForm Width = 162 BorderSpacing.Around = 6 Caption = 'Export column footer' - Enabled = False TabOrder = 3 end object cbExportCellColors: TCheckBox