pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

RxFPC:continue work on RxDBGrid PDF export

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5080 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2016-08-11 14:00:57 +00:00
parent 667cae6df5
commit e534eade83
3 changed files with 194 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

189
components/rx/trunk/rxdbgridexportpdf.pas
View File

@ -37,7 +37,7 @@ interface
{$IF (FPC_FULLVERSION >= 30101)}
uses
Classes, SysUtils, DB, rxdbgrid, fpPDF;
Classes, SysUtils, DB, rxdbgrid, LazFreeTypeFontCollection, vclutils, fpPDF;
type
@ -72,6 +72,10 @@ type
TRxDBGridExportPDF = class(TRxDBGridAbstractTools)
private
FPageMargin: TRxPageMargin;
FPageHeight:integer;
FPageWidth:integer;
FAuthorPDF: string;
FFileName: string;
FOpenAfterExport: boolean;
@ -80,14 +84,17 @@ type
FPdfOptions:TPdfExportOptions;
FWorkPages:TFPList;
FWorkPagesNeedCount:integer;
FFontCollection:TFreeTypeFontCollection;
function GetPdfOptions: TPdfExportOptions;
procedure SetPageMargin(AValue: TRxPageMargin);
procedure SetPdfOptions(AValue: TPdfExportOptions);
protected
FPDFDocument:TPDFDocument;
FCurSection: TPDFSection;
FDataSet:TDataSet;
FPosY : integer;
FPageHeight:integer;
FHeaderFont:integer;
FBodyFont:integer;
@ -103,6 +110,8 @@ type
function DoExecTools:boolean;override;
function DoSetupTools:boolean; override;
procedure DoSaveDocument;
//
procedure InitFonts(AFontCollection:TFreeTypeFontCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -113,13 +122,14 @@ type
property OpenAfterExport:boolean read FOpenAfterExport write FOpenAfterExport default false;
property AuthorPdf:string read FAuthorPDF write FAuthorPDF;
property ProducerPdf:string read FProducerPDF write FProducerPDF;
property PageMargin:TRxPageMargin read FPageMargin write SetPageMargin;
end;
{$ENDIF}
implementation
{$IF (FPC_FULLVERSION >= 30101)}
uses rxdconst, forms, LCLIntf;
uses rxdconst, FileUtil, forms, LCLIntf, LazFileUtils, EasyLazFreeType;
{ TPdfExportOptions }
@ -150,6 +160,11 @@ begin
Result:=FPdfOptions;
end;
procedure TRxDBGridExportPDF.SetPageMargin(AValue: TRxPageMargin);
begin
FPageMargin.Assign(AValue);
end;
procedure TRxDBGridExportPDF.SetPdfOptions(AValue: TPdfExportOptions);
begin
FPdfOptions.Assign(AValue);
@ -159,16 +174,19 @@ procedure TRxDBGridExportPDF.DoExportTitle;
var
P: TPDFPage;
Pt: TPDFCoord;
i, X: Integer;
i, X, CP: Integer;
C: TRxColumn;
S: String;
begin
X:=20;
X:=FPageMargin.Left;
CP:=0;
P:=TPDFPage(FWorkPages[CP]);
for i:=0 to FRxDBGrid.Columns.Count - 1 do
begin
P:=TPDFPage(FWorkPages[0]);
C:=FRxDBGrid.Columns[i];
Pt.X := X;
Pt.Y := FPosY;
P.SetColor(C.Color);
@ -176,44 +194,76 @@ begin
P.SetFont(FHeaderFont, 10);
//P.SetColor(clBlue, false);
P.WriteText(Pt.X+2, Pt.Y-10, C.Title.Caption);
Inc(X, C.Width);
if X + C.Width > FPageWidth - FPageMargin.Right then
begin
Inc(CP);
P:=TPDFPage(FWorkPages[CP]);
X:=FPageMargin.Left;
end
else
Inc(X, C.Width);
end;
Inc(FPosY, FRxDBGrid.DefaultRowHeight);
{
S:='Russian: Привет мир!';
P.SetFont(FBodyFont, 11);
P.WriteText(40, 160, S);}
end;
procedure TRxDBGridExportPDF.DoExportBody;
procedure DoWriteRow;
begin
//
end;
begin
while not FDataSet.EOF do
begin
DoWriteRow;
FDataSet.Next;
Inc(FPosY, FRxDBGrid.DefaultRowHeight);
if FPosY > FPageHeight - FPageMargin.Bottom then
begin
FPosY:=FPageMargin.Top + 20;
exit;
end;
end;
end;
procedure TRxDBGridExportPDF.DoSetupFonts;
var
FM: TCustomFamilyCollectionItem;
FIH, FI: TCustomFontCollectionItem;
begin
//FPDFDocument.FontDirectory := '/usr/share/fonts/liberation';
FPDFDocument.FontDirectory := '/usr/share/fonts/liberation';
FHeaderFont := FPDFDocument.AddFont('LiberationSans-Regular.ttf', 'LiberationSans', clGreen);
FPDFDocument.FontDirectory := 'fonts';
FBodyFont := FPDFDocument.AddFont('FreeSans.ttf', 'FreeSans', clGreen); // TODO: this color value means nothing - not used at all
// FHeaderFont := FPDFDocument.AddFont('Helvetica');
// FBodyFont := D.AddFont('Helvetica');
// FFooterFont := D.AddFont('Helvetica');
// FBodyFont := FHeaderFont;
FFooterFont := FHeaderFont;
FFontCollection:=TFreeTypeFontCollection.Create;
InitFonts(FFontCollection);
{FtTitle := D.AddFont('Helvetica', clRed);
FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans', clGreen); // TODO: this color value means nothing - not used at all
FtText2 := D.AddFont('Times-BoldItalic', clBlack);}
FM:=FFontCollection.Family['Arial'];
if Assigned(FM) then
begin
FIH:=FM.GetFont(['Bold']);
if Assigned(FIH) then
begin
FPDFDocument.FontDirectory := ExtractFileDir(FIH.Filename);
FHeaderFont := FPDFDocument.AddFont(ExtractFileName(FIH.Filename), FIH.Information[ftiFullName]);
end;
FI:=FM.GetFont('Regular');
if Assigned(FI) then
begin
FPDFDocument.FontDirectory := ExtractFileDir(FIH.Filename);
FBodyFont := FPDFDocument.AddFont(ExtractFileName(FIH.Filename), FIH.Information[ftiFullName]);
end;
if not Assigned(FIH) then
FHeaderFont:=FBodyFont;
FFooterFont := FHeaderFont;
end;
FFontCollection.Free;
if not Assigned(FM) then
raise Exception.Create('Not found arial font');
end;
procedure TRxDBGridExportPDF.DoExportFooter;
@ -223,7 +273,7 @@ end;
procedure TRxDBGridExportPDF.DoSetupDocHeader;
var
MaxW, W, i: Integer;
W, i: Integer;
begin
FPDFDocument.Infos.Title := Application.Title;
FPDFDocument.Infos.Author := FAuthorPDF;
@ -235,30 +285,32 @@ begin
FPDFDocument.DefaultOrientation:=FPdfOptions.PaperOrientation;
//calc need count pages for all columns
FWorkPagesNeedCount:=0;
FWorkPagesNeedCount:=1;
if FPdfOptions.FPaperType <> ptCustom then
begin
if FPdfOptions.PaperOrientation = ppoPortrait then
MaxW:=PDFPaperSizes[FPdfOptions.FPaperType, 0]
begin
FPageWidth := PDFPaperSizes[FPdfOptions.FPaperType, 0];
FPageHeight := PDFPaperSizes[FPdfOptions.FPaperType, 1];
end
else
MaxW:=PDFPaperSizes[FPdfOptions.FPaperType, 1];
begin
FPageWidth := PDFPaperSizes[FPdfOptions.FPaperType, 1];
FPageHeight := PDFPaperSizes[FPdfOptions.FPaperType, 0];
end;
W:=0;
W:=FPageMargin.Left;
for i:=0 to FRxDBGrid.Columns.Count-1 do
begin
W:=W + FRxDBGrid.Columns[i].Width;
if W > MaxW then
if W > FPageWidth - FPageMargin.Right then
begin
Inc(FWorkPagesNeedCount);
W:=0;
W:=FPageMargin.Left;
end;
end;
end;
if FWorkPagesNeedCount = 0 then
FWorkPagesNeedCount:=1;
end;
procedure TRxDBGridExportPDF.DoExportPage;
@ -276,7 +328,7 @@ begin
FWorkPages.Add(P);
end;
FPosY:=40;
FPosY:=FPageMargin.Top + 20;
if repExportTitle in FOptions then
DoExportTitle;
@ -307,7 +359,6 @@ begin
FDataSet.First;
repeat
DoExportPage;
FDataSet.Next;
until FDataSet.EOF;
DoSaveDocument;
@ -346,9 +397,66 @@ begin
end;
end;
procedure TRxDBGridExportPDF.InitFonts(AFontCollection: TFreeTypeFontCollection
);
var
FontDirList: TStringList;
procedure CreateFontDirList;
var
s: String;
begin
{$IFDEF WINDOWS}
s := SHGetFolderPathUTF8(20); // CSIDL_FONTS = 20
if s <> '' then
FontDirList.Add(s);
{$ENDIF}
{$IFDEF linux}
//tested on Fedora 24
FontDirList.Add('/usr/share/cups/fonts/');
FontDirList.Add('/usr/share/fonts/');
FontDirList.Add('/usr/local/lib/X11/fonts/');
FontDirList.Add(GetUserDir + '.fonts/');
{$ENDIF}
end;
procedure AddFolder(AFolder: string);
var
Files: TStringList;
i: integer;
begin
AFolder := AppendPathDelim(ExpandFileName(AFolder));
Files := TStringList.Create;
AFontCollection.BeginUpdate;
try
FindAllFiles(Files, AFolder, '*.ttf', true);
Files.Sort;
for i := 0 to Files.Count-1 do
try
AFontCollection.AddFile(Files[i]);
except
end;
finally
AFontCollection.EndUpdate;
Files.Free;
end;
end;
var
i: Integer;
begin
FontDirList := TStringList.Create;
CreateFontDirList;
for i:=0 to FontDirList.Count-1 do
AddFolder(FontDirList[i]);
FreeAndNil(FontDirList);
end;
constructor TRxDBGridExportPDF.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPageMargin:=TRxPageMargin.Create;
FPdfOptions:=TPdfExportOptions.Create(Self);
FCaption:=sToolsExportPDF;
@ -358,6 +466,7 @@ end;
destructor TRxDBGridExportPDF.Destroy;
begin
FreeAndNil(FPdfOptions);
FreeAndNil(FPageMargin);
inherited Destroy;
end;

45
components/rx/trunk/rxdbgridprintgrid.pas
View File

@ -36,7 +36,7 @@ interface
uses
Classes, SysUtils, DB, rxdbgrid, LR_Class, LR_DSet, LR_DBSet, contnrs,
Graphics, Printers;
Graphics, Printers, vclutils;
type
TRxDBGridPrintOption =
@ -60,25 +60,6 @@ type
destructor Destroy; override;
end;
{ TRxPageMargin }
TRxPageMargin = class(TPersistent)
private
FBottom: integer;
FLeft: integer;
FRight: integer;
FTop: integer;
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
published
property Left:integer read FLeft write FLeft default 20;
property Top:integer read FTop write FTop default 20;
property Right:integer read FRight write FRight default 20;
property Bottom:integer read FBottom write FBottom default 20;
end;
{ TRxDBGridPrint }
TRxDBGridPrint = class(TRxDBGridAbstractTools)
@ -139,30 +120,6 @@ begin
RegisterComponents('RX DBAware',[TRxDBGridPrint]);
end;
{ TRxPageMargin }
procedure TRxPageMargin.AssignTo(Dest: TPersistent);
begin
if (Dest is TRxPageMargin) then
begin
TRxPageMargin(Dest).FBottom:=FBottom;
TRxPageMargin(Dest).FLeft:=FLeft;
TRxPageMargin(Dest).FRight:=FRight;
TRxPageMargin(Dest).FTop:=FTop;
end
else
inherited AssignTo(Dest);
end;
constructor TRxPageMargin.Create;
begin
inherited Create;
FBottom:=20;
FLeft:=20;
FRight:=20;
FTop:=20;
end;
{ TRxColInfo }
constructor TRxColInfo.Create;

44
components/rx/trunk/vclutils.pas
View File

@ -42,9 +42,29 @@ uses
Classes, SysUtils, Graphics, Controls, Forms, LResources
;
type
TTextOrientation = (toHorizontal, toVertical90, toHorizontal180, toVertical270, toHorizontal360);
{ TRxPageMargin }
TRxPageMargin = class(TPersistent)
private
FBottom: integer;
FLeft: integer;
FRight: integer;
FTop: integer;
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create;
published
property Left:integer read FLeft write FLeft default 20;
property Top:integer read FTop write FTop default 20;
property Right:integer read FRight write FRight default 20;
property Bottom:integer read FBottom write FBottom default 20;
end;
function WidthOf(R: TRect): Integer; inline;
function HeightOf(R: TRect): Integer; inline;
@ -109,6 +129,30 @@ uses LCLProc, LCLIntf, LCLType, LCLStrConsts;
{$R rx_lcl.res}
{$ENDIF}
{ TRxPageMargin }
procedure TRxPageMargin.AssignTo(Dest: TPersistent);
begin
if (Dest is TRxPageMargin) then
begin
TRxPageMargin(Dest).FBottom:=FBottom;
TRxPageMargin(Dest).FLeft:=FLeft;
TRxPageMargin(Dest).FRight:=FRight;
TRxPageMargin(Dest).FTop:=FTop;
end
else
inherited AssignTo(Dest);
end;
constructor TRxPageMargin.Create;
begin
inherited Create;
FBottom:=20;
FLeft:=20;
FRight:=20;
FTop:=20;
end;
function WidthOf(R: TRect): Integer;
begin
Result := R.Right - R.Left;