RxFPC:start work on tools for export rxdbgrid data to pdf file

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5067 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/rx/trunk/languages/rxdconst.es.po

@@ -625,6 +625,10 @@ msgstr ""
 msgid "Show column title"
 msgstr ""
 
+#: rxdconst.stoolsexportpdf
+msgid "Export to PDF file"
+msgstr ""
+
 #: rxdconst.stoolsexportspeadsheet
 msgid "Export to speadsheet"
 msgstr ""

components/rx/trunk/languages/rxdconst.po

@@ -603,6 +603,10 @@ msgstr ""
 msgid "Show column title"
 msgstr ""
 
+#: rxdconst.stoolsexportpdf
+msgid "Export to PDF file"
+msgstr ""
+
 #: rxdconst.stoolsexportspeadsheet
 msgid "Export to speadsheet"
 msgstr ""

components/rx/trunk/languages/rxdconst.ru.po

@@ -603,6 +603,10 @@ msgstr "Отображать заголовок отчёта"
 msgid "Show column title"
 msgstr "Отображать заголовки столбцов"
 
+#: rxdconst.stoolsexportpdf
+msgid "Export to PDF file"
+msgstr ""
+
 #: rxdconst.stoolsexportspeadsheet
 msgid "Export to speadsheet"
 msgstr "Экспорт в электронную таблицу"

components/rx/trunk/languages/rxdconst.uk.po

@@ -617,6 +617,10 @@ msgstr "Показати заголовок звіту"
 msgid "Show column title"
 msgstr "Показати заголовок стовпця"
 
+#: rxdconst.stoolsexportpdf
+msgid "Export to PDF file"
+msgstr ""
+
 #: rxdconst.stoolsexportspeadsheet
 msgid "Export to speadsheet"
 msgstr "Експорт до електронної таблиці"

components/rx/trunk/registerrxdb.pas

@@ -42,7 +42,7 @@ procedure Register;
 implementation
 uses DB, DBPropEdits, rxdbgrid, RxDBSpinEdit, RxDBTimeEdit, RxDBCtrls, rxmemds,
   ComponentEditors, seldsfrm, PropEdits, RxDBColorBox, dbdateedit, rxdbcomb,
-  rxlookup, dbcurredit, RxDBGridFooterTools;
+  rxlookup, dbcurredit, RxDBGridFooterTools, RxDBGridExportPdf;
 
 type
 
@@ -123,6 +123,11 @@ begin
   RegisterComponents('RX DBAware',[TRxDBGridFooterTools]);
 end;
 
+procedure RegisterRxDBGridExportPDF;
+begin
+  RegisterComponents('RX DBAware',[TRxDBGridExportPDF]);
+end;
+
 procedure RegisterRxMemDS;
 begin
   RegisterComponents('RX DBAware',[TRxMemoryData]);
@@ -162,6 +167,7 @@ begin
   RegisterUnit('rxmemds', @RegisterRxMemDS);
   RegisterUnit('RxDBColorBox', @RegisterRxDBColorBox);
   RegisterUnit('RxDBGridFooterTools', @RegisterRxDbGridFooterTools);
+  RegisterUnit('RxDBGridExportPdf', @RegisterRxDBGridExportPDF);
 
   //Component Editors
   RegisterComponentEditor(TRxMemoryData, TMemDataSetEditor);

components/rx/trunk/rxdbgridexportpdf.pas

@@ -0,0 +1,334 @@
+{ RxDBGridExportPdf unit
+
+  Copyright (C) 2005-2016 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 RxDBGridExportPdf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, rxdbgrid, fpPDF;
+
+type
+
+  TRxDBGridExportPdfOption = (repExportTitle,
+    repExportColors,
+    repExportFooter,
+    repOverwriteExisting
+    );
+  TRxDBGridExportPdfOptions = set of TRxDBGridExportPdfOption;
+
+  { TPdfExportOptions }
+
+  TPdfExportOptions = class(TPersistent)
+  private
+    FOwner: TPersistent;
+    FOptions: TPDFOptions;
+    FPaperOrientation: TPDFPaperOrientation;
+    FPaperType: TPDFPaperType;
+  protected
+    procedure AssignTo(Dest: TPersistent); override;
+  public
+    constructor Create(AOwner: TPersistent);
+  published
+    property PaperType:TPDFPaperType read FPaperType write FPaperType default ptA4;
+    property PaperOrientation:TPDFPaperOrientation read FPaperOrientation write FPaperOrientation default ppoPortrait;
+    property Options:TPDFOptions read FOptions write FOptions;
+  end;
+
+type
+
+  { TRxDBGridExportPDF }
+
+  TRxDBGridExportPDF = class(TRxDBGridAbstractTools)
+  private
+    FAuthorPDF: string;
+    FFileName: string;
+    FOpenAfterExport: boolean;
+    FOptions: TRxDBGridExportPdfOptions;
+    FProducerPDF: string;
+    FPdfOptions:TPdfExportOptions;
+    FWorkPages:TFPList;
+    FWorkPagesNeedCount:integer;
+    function GetPdfOptions: TPdfExportOptions;
+    procedure SetPdfOptions(AValue: TPdfExportOptions);
+  protected
+    FPDFDocument:TPDFDocument;
+    FCurSection: TPDFSection;
+    FDataSet:TDataSet;
+    FPosY : integer;
+    FPageHeight:integer;
+
+    FHeaderFont:integer;
+    FBodyFont:integer;
+    FFooterFont:integer;
+
+    procedure DoExportTitle;
+    procedure DoExportBody;
+    procedure DoSetupFonts;
+    procedure DoExportFooter;
+
+    procedure DoSetupDocHeader;
+    procedure DoExportPage;
+    function DoExecTools:boolean;override;
+    function DoSetupTools:boolean; override;
+    procedure DoSaveDocument;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property FileName:string read FFileName write FFileName;
+    property Options:TRxDBGridExportPdfOptions read FOptions write FOptions;
+    property PdfOptions:TPdfExportOptions read GetPdfOptions write SetPdfOptions;
+    property OpenAfterExport:boolean read FOpenAfterExport write FOpenAfterExport default false;
+    property AuthorPdf:string read FAuthorPDF write FAuthorPDF;
+    property ProducerPdf:string read FProducerPDF write FProducerPDF;
+  end;
+
+implementation
+uses rxdconst, forms, LCLIntf;
+
+{ TPdfExportOptions }
+
+procedure TPdfExportOptions.AssignTo(Dest: TPersistent);
+begin
+  if Dest is TPdfExportOptions then
+  begin
+    TPdfExportOptions(Dest).FOptions := FOptions;
+    TPdfExportOptions(Dest).FPaperOrientation:=FPaperOrientation;
+    TPdfExportOptions(Dest).FPaperType:=FPaperType;
+  end
+  else
+  inherited AssignTo(Dest);
+end;
+
+constructor TPdfExportOptions.Create(AOwner: TPersistent);
+begin
+  inherited Create;
+  FOwner:=AOwner;
+  FPaperType:=ptA4;
+  FPaperOrientation:=ppoPortrait;
+end;
+
+{ TRxDBGridExportSpreadSheet }
+
+function TRxDBGridExportPDF.GetPdfOptions: TPdfExportOptions;
+begin
+  Result:=FPdfOptions;
+end;
+
+procedure TRxDBGridExportPDF.SetPdfOptions(AValue: TPdfExportOptions);
+begin
+  FPdfOptions.Assign(AValue);
+end;
+
+procedure TRxDBGridExportPDF.DoExportTitle;
+var
+  P: TPDFPage;
+  Pt: TPDFCoord;
+  i: Integer;
+  C: TRxColumn;
+begin
+  for i:=0 to FRxDBGrid.Columns.Count - 1 do
+  begin
+    P:=TPDFPage(FWorkPages[0]);
+    C:=FRxDBGrid.Columns[i];
+    Pt.X := 20 + i * 40;
+    Pt.Y := FPosY;
+    P.SetColor(C.Color);
+    P.DrawRect(Pt.X, Pt.Y, 40, FRxDBGrid.DefaultRowHeight, 1, true, true);
+  end;
+  Inc(FPosY, FRxDBGrid.DefaultRowHeight)
+end;
+
+procedure TRxDBGridExportPDF.DoExportBody;
+begin
+
+end;
+
+procedure TRxDBGridExportPDF.DoSetupFonts;
+begin
+  FHeaderFont := FPDFDocument.AddFont('Helvetica');
+//  FBodyFont := D.AddFont('Helvetica');
+//  FFooterFont := D.AddFont('Helvetica');
+  FBodyFont := FHeaderFont;
+  FFooterFont := FHeaderFont;
+end;
+
+procedure TRxDBGridExportPDF.DoExportFooter;
+begin
+
+end;
+
+procedure TRxDBGridExportPDF.DoSetupDocHeader;
+var
+  MaxW, W, i: Integer;
+begin
+  FPDFDocument.Infos.Title := Application.Title;
+  FPDFDocument.Infos.Author := FAuthorPDF;
+  FPDFDocument.Infos.Producer := FProducerPDF;
+  FPDFDocument.Infos.ApplicationName := ApplicationName;
+  FPDFDocument.Infos.CreationDate := Now;
+
+  FPDFDocument.Options:=FPdfOptions.FOptions;
+  FPDFDocument.DefaultOrientation:=FPdfOptions.PaperOrientation;
+
+  //calc need count pages for all columns
+  FWorkPagesNeedCount:=0;
+  if FPdfOptions.FPaperType <> ptCustom then
+  begin
+    if FPdfOptions.PaperOrientation = ppoPortrait then
+      MaxW:=PDFPaperSizes[FPdfOptions.FPaperType, 0]
+    else
+      MaxW:=PDFPaperSizes[FPdfOptions.FPaperType, 1];
+
+    W:=0;
+    for i:=0 to FRxDBGrid.Columns.Count-1 do
+    begin
+      W:=W + FRxDBGrid.Columns[i].Width;
+
+      if W > MaxW then
+      begin
+        Inc(FWorkPagesNeedCount);
+        W:=0;
+      end;
+    end;
+  end;
+
+  if FWorkPagesNeedCount = 0 then
+    FWorkPagesNeedCount:=1;
+
+end;
+
+procedure TRxDBGridExportPDF.DoExportPage;
+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:=20;
+
+  if repExportTitle in FOptions then
+    DoExportTitle;
+
+  DoExportBody;
+end;
+
+function TRxDBGridExportPDF.DoExecTools: boolean;
+var
+  P: TBookMark;
+begin
+  Result:=false;
+  FDataSet:=FRxDBGrid.DataSource.DataSet;
+  FDataSet.DisableControls;
+  {$IFDEF NoAutomatedBookmark}
+  P:=FDataSet.GetBookmark;
+  {$ELSE}
+  P:=FDataSet.Bookmark;
+  {$ENDIF}
+
+  FPDFDocument:=TPDFDocument.Create(nil);
+  FWorkPages:=TFPList.Create;
+  try
+    DoSetupFonts;
+    DoSetupDocHeader;
+    FPDFDocument.StartDocument;
+    FCurSection := FPDFDocument.Sections.AddSection; // we always need at least one section
+    FDataSet.First;
+    repeat
+      DoExportPage;
+      FDataSet.Next;
+    until FDataSet.EOF;
+
+    DoSaveDocument;
+    Result:=true;
+  finally
+    {$IFDEF NoAutomatedBookmark}
+    FDataSet.GotoBookmark(P);
+    FDataSet.FreeBookmark(P);
+    {$ELSE}
+    FDataSet.Bookmark:=P;
+    {$ENDIF}
+    FDataSet.EnableControls;
+
+    FreeAndNil(FWorkPages);
+    FreeAndNil(FPDFDocument);
+  end;
+
+  if Result and FOpenAfterExport then
+    OpenDocument(FileName);
+end;
+
+function TRxDBGridExportPDF.DoSetupTools: boolean;
+begin
+  Result:=inherited DoSetupTools;
+end;
+
+procedure TRxDBGridExportPDF.DoSaveDocument;
+var
+  F: TFileStream;
+begin
+  F := TFileStream.Create(FFileName,fmCreate);
+  try
+    FPDFDocument.SaveToStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+constructor TRxDBGridExportPDF.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FPdfOptions:=TPdfExportOptions.Create(Self);
+
+  FCaption:=sToolsExportPDF;
+  FOpenAfterExport:=false;
+end;
+
+destructor TRxDBGridExportPDF.Destroy;
+begin
+  FreeAndNil(FPdfOptions);
+  inherited Destroy;
+end;
+
+
+end.
+

components/rx/trunk/rxdbgridexportspreadsheet.pas

@@ -1,6 +1,6 @@
 { RxDBGridExportSpreadSheet unit
 
-  Copyright (C) 2005-2015 Lagunov Aleksey alexs@yandex.ru
+  Copyright (C) 2005-2016 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

components/rx/trunk/rxdconst.pas

@@ -174,6 +174,7 @@ resourcestring
 
   sExportParams              = 'Export params';
   sToolsExportSpeadSheet     = 'Export to speadsheet';
+  sToolsExportPDF            = 'Export to PDF file';
   sExportFileName            = 'Export file name';
   sOpenAfterExport           = 'Open after export';
   sPageName                  = 'Page name';

components/rx/trunk/rxnew.lpk

@@ -25,7 +25,7 @@ translate to Lazarus by alexs in 2005 - 2016
 "/>
     <License Value="LGPL"/>
     <Version Major="2" Minor="9" Release="2" Build="190"/>
-    <Files Count="67">
+    <Files Count="68">
       <Item1>
         <Filename Value="autopanel.pas"/>
         <UnitName Value="AutoPanel"/>
@@ -297,6 +297,10 @@ translate to Lazarus by alexs in 2005 - 2016
         <Filename Value="rxshortcutunit.pas"/>
         <UnitName Value="rxShortCutUnit"/>
       </Item67>
+      <Item68>
+        <Filename Value="rxdbgridexportpdf.pas"/>
+        <UnitName Value="RxDBGridExportPdf"/>
+      </Item68>
     </Files>
     <LazDoc Paths="docs;\usr\local\share\lazarus\components\rxnew\docs"/>
     <i18n>

components/rx/trunk/rxnew.pas

@@ -19,7 +19,8 @@ uses
   tooledit, vclutils, RxCloseFormValidator, RxHistoryNavigator, 
   ex_rx_bin_datapacket, ex_rx_datapacket, ex_rx_xml_datapacket, rxsortby, 
   RxMDI, RxIniPropStorage, rxDateRangeEditUnit, RxDBGridFooterTools, 
-  rxdbgridfootertools_setup, rxShortCutUnit, LazarusPackageIntf;
+  rxdbgridfootertools_setup, rxShortCutUnit, RxDBGridExportPdf, 
+  LazarusPackageIntf;
 
 implementation