mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 18:58:04 +02:00
added pdf document writer
This commit is contained in:
Moritz Lamprecht
Maxim Ganetsky
parent
b59196e223
commit
0fafee823a
744
components/fpvectorial/pdfvectorialwriter.pas
Normal file
744
components/fpvectorial/pdfvectorialwriter.pas
Normal file
@ -0,0 +1,744 @@
|
||||
unit pdfvectorialwriter;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StrUtils, Graphics, Math, fpvectorial, fpPDF, fpTTF;
|
||||
|
||||
const
|
||||
{$IFDEF WINDOWS}
|
||||
FONT_DIR = 'C:\Windows\Fonts\';
|
||||
{$ELSE}
|
||||
{$IFDEF LINUX} // TODO: there are different font locations for linux
|
||||
FONT_DIR = '/usr/local/share/fonts/';
|
||||
{$ELSE}
|
||||
FONT_DIR = '~/Library/Fonts';
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
cInchToMM = 25.4;
|
||||
cInchToCM = 2.54;
|
||||
|
||||
type
|
||||
{
|
||||
T
|
||||
____v____
|
||||
| |
|
||||
| |
|
||||
L > | | < R
|
||||
| |
|
||||
|_______|
|
||||
^
|
||||
B
|
||||
|
||||
every entity being rendered should have a bound box
|
||||
limiting the space it can use. Those limits are set by
|
||||
left, top, right, bottom spacings (in mm). X and Y
|
||||
shall be used as cursors to add padding and navigate
|
||||
|
||||
}
|
||||
TvBoundBox = record
|
||||
L, T, R, B: Double;
|
||||
X, Y: Double; // cursor
|
||||
end;
|
||||
|
||||
TvEntityKind = (ekParagraph, ekList, ekTable, ekText, ekField, ekImage, ekNone);
|
||||
|
||||
TvEntityInfo = record
|
||||
Kind: TvEntityKind;
|
||||
Box: TvBoundBox;
|
||||
end;
|
||||
|
||||
TvPDFFont = record
|
||||
Font: TvFont;
|
||||
Cache: TFPFontCacheItem;
|
||||
ID: Integer;
|
||||
end;
|
||||
|
||||
TvPDFFontArray = array of TvPDFFont;
|
||||
|
||||
TvPDFVectorialWriter = class(TvCustomVectorialWriter)
|
||||
private
|
||||
FPointSeparator: TFormatSettings;
|
||||
|
||||
FDocument: TPDFDocument;
|
||||
FSection: TPDFSection;
|
||||
FPage: TPDFPage;
|
||||
|
||||
FFonts: TvPDFFontArray;
|
||||
|
||||
// default style
|
||||
FStyle: TvStyle;
|
||||
|
||||
// line space (TODO: customisability)
|
||||
FLineSpace: Double;
|
||||
FSpacing: Double;
|
||||
|
||||
{ utilities }
|
||||
function GetBorderWidth(AType: TvTableBorderType): Double;
|
||||
function GetStyle(AText: TvText; APara: TvParagraph): TvStyle;
|
||||
function UnitToMM(AValue: Double; AUnit: TvUnits; Box: TvBoundBox): Double;
|
||||
function GetEntityInfo(AEntity, AParent: TvEntity; ABox: TvBoundBox): TvEntityInfo;
|
||||
function GetFontID(AName: String; IsBold, IsItalic: Boolean): Integer;
|
||||
function GetFontIDnew(AName: String; IsBold, IsItalic: Boolean): Integer;
|
||||
function GetFont(AName: String; IsBold, IsItalic: Boolean): TvPDFFont;
|
||||
function TabsToSpaces(AText: String): String;
|
||||
|
||||
{ entity measurements }
|
||||
function GetHeight(Entity, AParent: TvEntity): Double;
|
||||
function GetHeight(AEntity, AParent: TvEntity; AKind: TvEntityKind): Double;
|
||||
function GetTextHeight(AText: TvText; APara: TvParagraph): Double;
|
||||
function GetTextWidth(AText: TvText; APara: TvParagraph): Double;
|
||||
function GetFontHeight(AText: TvText): Double;
|
||||
function GetFontWidth(AText: TvText): Double;
|
||||
function GetParagraphHeight(APara: TvParagraph): Double;
|
||||
function GetListHeight(AList: TvList): Double;
|
||||
function GetTableHeight(ATable: TvTable): Double;
|
||||
function GetRowHeight(ARow: TvTableRow; ALast: Boolean): Double;
|
||||
function GetCellHeight(ACell: TvTableCell; ALast: Boolean): Double;
|
||||
function GetFieldHeight(AField: TvField): Double;
|
||||
function GetImageHeight(AImage: TvRasterImage): Double;
|
||||
function GetWidth(AEntity, AParent: TvEntity; AKind: TvEntityKind; ABox: TvBoundBox): Double;
|
||||
function GetImageWidth(AImage: TvRasterImage): Double;
|
||||
|
||||
{ add entities }
|
||||
procedure AddFonts(AData: TvVectorialDocument);
|
||||
function AddPage(APage: TvTextPageSequence; AData: TvVectorialDocument): TvBoundBox;
|
||||
procedure AddParagraph(APara: TvParagraph; APage: TvTextPageSequence; AData: TvVectorialDocument; ABox: TvBoundBox);
|
||||
procedure AddList(AList: TvList; var Box: TvBoundBox);
|
||||
procedure AddTable(ATable: TvTable; APage: TvTextPageSequence; AData: TvVectorialDocument; ABox: TvBoundBox);
|
||||
procedure AddText(AText: TvText; APara: TvParagraph; ABox: TvBoundBox);
|
||||
procedure AddField(AField: TvField; ABox: TvBoundBox);
|
||||
procedure AddImage(AImage: TvRasterImage; ABox: TvBoundBox);
|
||||
public
|
||||
constructor Create; override;
|
||||
procedure WriteToFile(AFileName: String; AData: TvVectorialDocument); override;
|
||||
procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TvPDFVectorialWriter }
|
||||
|
||||
function Inc(var AValue: Double; AIncrement: Double): Double;
|
||||
begin
|
||||
AValue := AValue + AIncrement;
|
||||
Result := AValue;
|
||||
end;
|
||||
|
||||
function Dec(var AValue: Double; ADecrement: Double): Double;
|
||||
begin
|
||||
AValue := AValue - ADecrement;
|
||||
Result := AValue;
|
||||
end;
|
||||
|
||||
// definitions for the border widths
|
||||
function TvPDFVectorialWriter.GetBorderWidth(AType: TvTableBorderType): Double;
|
||||
begin
|
||||
case AType of
|
||||
tbtNone: Result := 0;
|
||||
tbtSingle: Result := 1;
|
||||
tbtDefault: Result := 0.4;
|
||||
tbtDouble: Result := 2;
|
||||
tbtDashed: Result := 0; // TODO: add dashed line
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetStyle(AText: TvText; APara: TvParagraph): TvStyle;
|
||||
begin
|
||||
Result := AText.GetCombinedStyle(APara);
|
||||
if Result = nil then Result := FStyle;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetEntityInfo(AEntity, AParent: TvEntity; ABox: TvBoundBox): TvEntityInfo;
|
||||
begin
|
||||
Result.Box := ABox;
|
||||
if (AEntity is TvParagraph) then
|
||||
Result.Kind := ekParagraph
|
||||
else if (AEntity is TvList) then
|
||||
Result.Kind := ekList
|
||||
else if (AEntity is TvTable) then
|
||||
Result.Kind := ekTable
|
||||
else if (AEntity is TvText) then
|
||||
Result.Kind := ekText
|
||||
else if (AEntity is TvField) then
|
||||
Result.Kind := ekField
|
||||
else if (AEntity is TvRasterImage) then
|
||||
Result.Kind := ekImage;
|
||||
Result.Box.B := Result.Box.T + GetHeight(AEntity, AParent, Result.Kind);
|
||||
Result.Box.R := GetWidth(AEntity, AParent, Result.Kind, Result.Box);
|
||||
Result.Box.X := Result.Box.L;
|
||||
Result.Box.Y := Result.Box.T;
|
||||
end;
|
||||
|
||||
// convert tabs to spaces (really only working for monospace fonts)
|
||||
function TvPDFVectorialWriter.TabsToSpaces(AText: String): String;
|
||||
const
|
||||
TAB_SIZE = 6;
|
||||
var
|
||||
TabPos, i: Integer;
|
||||
Tmp: String;
|
||||
begin
|
||||
for i := 0 to AText.CountChar(#9) do
|
||||
begin
|
||||
TabPos := Pos(#9, AText) - 1;
|
||||
Tmp := AText.Substring(0, TabPos);
|
||||
while Tmp.Length mod TAB_SIZE <> 0 do
|
||||
Tmp := Tmp + ' ';
|
||||
AText := AText.Replace(AText.Substring(0, TabPos) + #9, Tmp);
|
||||
end;
|
||||
Result := AText;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetHeight(AEntity, AParent: TvEntity; AKind: TvEntityKind): Double;
|
||||
begin
|
||||
case AKind of
|
||||
ekParagraph: Result := GetParagraphHeight(TvParagraph(AEntity));
|
||||
ekList: Result := GetListHeight(TvList(AEntity));
|
||||
ekTable: Result := GetTableHeight(TvTable(AEntity));
|
||||
ekText: Result := GetTextHeight(TvText(AEntity), TvParagraph(AParent));
|
||||
ekField: Result := GetFieldHeight(TvField(AEntity));
|
||||
ekImage: Result := GetImageHeight(TvRasterImage(AEntity));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetWidth(AEntity, AParent: TvEntity; AKind: TvEntityKind; ABox: TvBoundBox): Double;
|
||||
begin
|
||||
case AKind of
|
||||
ekText: Result := ABox.L + GetTextWidth(TvText(AEntity), TvParagraph(AParent));
|
||||
ekImage: Result := ABox.L + GetImageWidth(TvRasterImage(AEntity));
|
||||
else Result := ABox.R; // TODO: add width for other entities
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetHeight(Entity, AParent: TvEntity): Double;
|
||||
begin
|
||||
if Entity is TvText then
|
||||
Exit(GetTextHeight(TvText(Entity), TvParagraph(AParent)));
|
||||
if Entity is TvParagraph then
|
||||
Exit(GetParagraphHeight(TvParagraph(Entity)));
|
||||
if Entity is TvList then
|
||||
Exit(GetListHeight(TvList(Entity)));
|
||||
if Entity is TvTable then
|
||||
Exit(GetTableHeight(TvTable(Entity)));
|
||||
if Entity is TvField then
|
||||
Exit(GetFieldHeight(TvField(Entity)));
|
||||
if Entity is TvRasterImage then
|
||||
Exit(GetImageHeight(TvRasterImage(Entity)));
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetTextHeight(AText: TvText; APara: TvParagraph): Double;
|
||||
begin
|
||||
AText.Style := GetStyle(AText, APara);
|
||||
Result := AText.Style.MarginTop + GetFontHeight(AText) + AText.Style.MarginBottom + FSpacing;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetTextWidth(AText: TvText; APara: TvParagraph): Double;
|
||||
begin
|
||||
AText.Style := GetStyle(AText, APara);
|
||||
Result := AText.Style.MarginLeft + GetFontWidth(AText) + AText.Style.MarginLeft;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetFontHeight(AText: TvText): Double;
|
||||
var
|
||||
Descender: Single; // how far does the text dip below the baseline
|
||||
Font: TvPDFFont;
|
||||
begin
|
||||
Font := GetFont(AText.Style.Font.Name, AText.Style.Font.Bold, AText.Style.Font.Italic);
|
||||
Assert(Font.Cache <> nil, 'no font cache found');
|
||||
Result := Font.Cache.TextHeight(AText.Value.Text, AText.Style.Font.Size, Descender);
|
||||
//Result := (Result * cInchToMM) / gTTFontCache.DPI;
|
||||
//Result := PDFToMM(AText.Style.Font.Size);
|
||||
Result := PDFToMM(Result); // seems to be the best way
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetFontWidth(AText: TvText): Double;
|
||||
var
|
||||
Font: TvPDFFont;
|
||||
begin
|
||||
Font := GetFont(AText.Style.Font.Name, AText.Style.Font.Bold, AText.Style.Font.Italic);
|
||||
Assert(Font.Cache <> nil, 'no font cache found');
|
||||
Result := Font.Cache.TextWidth(AText.Value.Text, AText.Style.Font.Size);
|
||||
Result := (Result * cInchToMM) / gTTFontCache.DPI;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetParagraphHeight(APara: TvParagraph): Double;
|
||||
var
|
||||
Tmp: Double;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
if APara.GetEntitiesCount = 0 then
|
||||
begin
|
||||
if APara.Style <> nil then
|
||||
begin
|
||||
// empty paragraphs need to take space as if there
|
||||
// is some text, like in odt and docx documents
|
||||
APara.Style.MarginTop := 0;
|
||||
APara.Style.MarginBottom := 0;
|
||||
APara.AddText('');
|
||||
end;
|
||||
end;
|
||||
for i := 0 to APara.GetEntitiesCount - 1 do
|
||||
begin
|
||||
Tmp := GetHeight(APara.GetEntity(i), APara);
|
||||
if Tmp > Result then Result := Tmp;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetListHeight(AList: TvList): Double;
|
||||
begin
|
||||
Result := 0; // TODO: add list height
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetTableHeight(ATable: TvTable): Double;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
for I := 0 to ATable.GetRowCount - 1 do
|
||||
begin
|
||||
if i = ATable.GetRowCount - 1 then
|
||||
Inc(Result, GetRowHeight(ATable.GetRow(i), true))
|
||||
else
|
||||
Inc(Result, GetRowHeight(ATable.GetRow(i), false));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetRowHeight(ARow: TvTableRow; ALast: Boolean): Double;
|
||||
var
|
||||
Tmp: Double;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
for i := 0 to ARow.GetCellCount - 1 do
|
||||
begin // get height of tallest cell
|
||||
Tmp := GetCellHeight(ARow.GetCell(i), ALast);
|
||||
if Tmp > Result then Result := Tmp;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetCellHeight(ACell: TvTableCell; ALast: Boolean): Double;
|
||||
var
|
||||
Para: TvParagraph;
|
||||
i: Integer;
|
||||
begin
|
||||
Result := ACell.SpacingTop + ACell.SpacingBottom;
|
||||
for i := 0 to ACell.GetEntitiesCount - 1 do
|
||||
Inc(Result, GetHeight(ACell.GetEntity(i), ACell));
|
||||
if ALast and (ACell.GetEntity(ACell.GetEntitiesCount - 1) is TvParagraph) then
|
||||
begin
|
||||
Para := TvParagraph(ACell.GetEntity(ACell.GetEntitiesCount - 1));
|
||||
if (Para.GetEntity(Para.GetEntitiesCount - 1) is TvText) then
|
||||
Inc(Result, FLineSpace - FSpacing);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetFieldHeight(AField: TvField): Double;
|
||||
begin
|
||||
Result := 0; // TODO: add field height
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetImageHeight(AImage: TvRasterImage): Double;
|
||||
begin
|
||||
if IsZero(AImage.Width) or IsZero(AImage.Height) then
|
||||
Result := (AImage.RasterImage.Height * cInchToCM) / 96
|
||||
else
|
||||
Result := AImage.Height * 10;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetImageWidth(AImage: TvRasterImage): Double;
|
||||
begin
|
||||
if IsZero(AImage.Width) or IsZero(AImage.Height) then
|
||||
Result := (AImage.RasterImage.Width * cInchToCM) / 96
|
||||
else
|
||||
Result := AImage.Width * 10;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.UnitToMM(AValue: Double; AUnit: TvUnits; Box: TvBoundBox): Double;
|
||||
begin
|
||||
case AUnit of
|
||||
dimMillimeter: Result := AValue;
|
||||
dimPercent: Result := (Box.R - Box.L) * (AValue / 100);
|
||||
dimPoint: Result := PDFTomm(AValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
// returns the font ID for a specific style
|
||||
function TvPDFVectorialWriter.GetFontID(AName: String; IsBold, IsItalic: Boolean): Integer;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
for i := 0 to Length(FFonts) - 1 do
|
||||
begin
|
||||
if FFonts[i].Font.Name = AName then
|
||||
begin
|
||||
if (FFonts[i].Font.Bold = IsBold) and (FFonts[i].Font.Italic = IsItalic) then
|
||||
Exit(FFonts[i].ID);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetFontIDnew(AName: String; IsBold, IsItalic: Boolean): Integer;
|
||||
var
|
||||
Search: String;
|
||||
begin
|
||||
Search := AName;
|
||||
if IsBold then Search := Search + ' Bold';
|
||||
if IsItalic then Search := Search + ' Italic';
|
||||
Result := FDocument.Fonts.FindFont(Search);
|
||||
if Result = -1 then Result := 0;
|
||||
end;
|
||||
|
||||
function TvPDFVectorialWriter.GetFont(AName: String; IsBold, IsItalic: Boolean): TvPDFFont;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := FFonts[0];
|
||||
for i := 0 to Length(FFonts) - 1 do
|
||||
begin
|
||||
if FFonts[i].Font.Name = AName then
|
||||
begin
|
||||
if (FFonts[i].Font.Bold = IsBold) and (FFonts[i].Font.Italic = IsItalic) then
|
||||
Exit(FFonts[i]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddFonts(AData: TvVectorialDocument);
|
||||
var
|
||||
Cache: TFPFontCacheItem;
|
||||
NewName: String;
|
||||
Font: TvFont;
|
||||
i, j: Integer;
|
||||
begin
|
||||
SetLength(FFonts, 1);
|
||||
FFonts[0].Font := FStyle.Font;
|
||||
FFonts[0].Cache := gTTFontCache.Find(FStyle.Font.Name, FStyle.Font.Bold, FStyle.Font.Italic);
|
||||
FFonts[0].ID := FDocument.AddFont(FFonts[0].Cache.FileName, FStyle.Font.Name);
|
||||
j := 1;
|
||||
for i := 0 to AData.GetStyleCount - 1 do
|
||||
begin
|
||||
Font := AData.GetStyle(i).Font;
|
||||
if (Font.Name = '') then Continue;
|
||||
NewName := Font.Name;
|
||||
if Font.Bold then
|
||||
NewName := NewName + ' Bold';
|
||||
if Font.Italic then NewName := NewName + ' Italic';
|
||||
if FDocument.Fonts.FindFont(NewName) = -1 then
|
||||
begin
|
||||
Cache := gTTFontCache.Find(Font.Name, Font.Bold, Font.Italic);
|
||||
if Cache = nil then Continue;
|
||||
SetLength(FFonts, Length(FFonts) + 1);
|
||||
Assert(Length(FFonts) > j, 'array should be large enough');
|
||||
FFonts[j].Font := Font;
|
||||
FFonts[j].ID := FDocument.AddFont(Cache.FileName, NewName);
|
||||
FFonts[j].Cache := Cache;
|
||||
j := j + 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// add pdf page to document
|
||||
function TvPDFVectorialWriter.AddPage(APage: TvTextPageSequence; AData: TvVectorialDocument): TvBoundBox;
|
||||
begin
|
||||
// add new page
|
||||
FPage := FDocument.Pages.AddPage;
|
||||
FSection.AddPage(FPage);
|
||||
|
||||
// page options could be made selectable
|
||||
FPage.PaperType := ptA4;
|
||||
FPage.Orientation := ppoPortrait;
|
||||
FPage.UnitOfMeasure := uomMillimeters;
|
||||
|
||||
// set bounds for page
|
||||
Result.T := APage.MarginTop;
|
||||
Result.L := APage.MarginLeft;
|
||||
Result.B := PDFTomm(FPage.Paper.H) - APage.MarginBottom;
|
||||
Result.R := PDFTomm(FPage.Paper.W) - APage.MarginRight;
|
||||
Result.X := Result.L;
|
||||
Result.Y := Result.T;
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddParagraph(APara: TvParagraph; APage: TvTextPageSequence; AData: TvVectorialDocument; ABox: TvBoundBox);
|
||||
var
|
||||
Info: TvEntityInfo;
|
||||
Entity: TvEntity;
|
||||
i: Integer;
|
||||
begin
|
||||
if APara.Style = nil then APara.Style := FStyle;
|
||||
for i := 0 to APara.GetEntitiesCount - 1 do
|
||||
begin
|
||||
Entity := APara.GetEntity(i);
|
||||
Info := GetEntityInfo(Entity, APara, ABox);
|
||||
case Info.Kind of
|
||||
ekText:
|
||||
begin
|
||||
case TvText(Entity).Style.Alignment of
|
||||
vsaRight:
|
||||
begin
|
||||
Info.Box.R := ABox.R;
|
||||
Info.Box.L := ABox.R - TvText(Entity).Style.MarginRight - GetFontWidth(TvText(Entity));
|
||||
Info.Box.X := Info.Box.L;
|
||||
end;
|
||||
vsaCenter:
|
||||
begin
|
||||
Info.Box.R := ABox.R;
|
||||
Info.Box.X := Info.Box.X + ((Info.Box.R - Info.Box.L) / 2) - (GetFontWidth(TvText(Entity)) / 2) - TvText(Entity).Style.MarginLeft;
|
||||
end;
|
||||
end;
|
||||
AddText(TvText(Entity), APara, Info.Box);
|
||||
end;
|
||||
ekField: AddField(TvField(Entity), Info.Box);
|
||||
ekImage:
|
||||
begin
|
||||
case APara.Style.Alignment of
|
||||
vsaRight:
|
||||
begin
|
||||
Info.Box.R := ABox.R;
|
||||
Info.Box.L := ABox.R - GetImageWidth(TvRasterImage(Entity));
|
||||
Info.Box.X := Info.Box.L;
|
||||
end;
|
||||
vsaCenter:
|
||||
begin
|
||||
Info.Box.R := ABox.R;
|
||||
Info.Box.X := Info.Box.X + ((Info.Box.R - Info.Box.L) / 2) - (GetImageWidth(TvRasterImage(Entity)) / 2);
|
||||
end;
|
||||
end;
|
||||
AddImage(TvRasterImage(Entity), Info.Box);
|
||||
end;
|
||||
end;
|
||||
// move to the right
|
||||
ABox.L := Info.Box.R;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddList(AList: TvList; var Box: TvBoundBox);
|
||||
begin
|
||||
// TODO: add support for lists
|
||||
raise Exception.Create('Unsupported Entity: TvList');
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddTable(ATable: TvTable; APage: TvTextPageSequence; AData: TvVectorialDocument; ABox: TvBoundBox);
|
||||
var
|
||||
RBox, CBox, EBox: TvBoundBox;
|
||||
CWidth, CLineWidth: Double;
|
||||
Info: TvEntityInfo;
|
||||
Cell: TvTableCell;
|
||||
i, j, k, l: Integer;
|
||||
Entity: TvEntity;
|
||||
Row: TvTableRow;
|
||||
CSame: Boolean;
|
||||
begin
|
||||
// set table bounds
|
||||
RBox := ABox;
|
||||
CSame := (ATable.ColWidths = nil);
|
||||
CWidth := UnitToMM(100 / ATable.GetColCount(), dimPercent, ABox);
|
||||
for i := 0 to ATable.GetRowCount - 1 do
|
||||
begin
|
||||
// current row
|
||||
Row := ATable.GetRow(i);
|
||||
if i = ATable.GetRowCount - 1 then
|
||||
RBox.B := RBox.T + GetRowHeight(Row, true)
|
||||
else
|
||||
RBox.B := RBox.T + GetRowHeight(Row, false);
|
||||
CBox := RBox;
|
||||
l := 0; // counter for col widths
|
||||
for j := 0 to Row.GetCellCount - 1 do
|
||||
begin
|
||||
// current cell
|
||||
Cell := Row.GetCell(j);
|
||||
|
||||
// set cursor
|
||||
CBox.X := CBox.L + Cell.SpacingLeft;
|
||||
CBox.Y := CBox.T + Cell.SpacingTop;
|
||||
|
||||
if not CSame then // get cell width
|
||||
CWidth := UnitToMM(ATable.ColWidths[l], ATable.ColWidthsUnits, ABox);
|
||||
|
||||
// setup bounds + spanning
|
||||
CBox.R := CBox.L + CWidth;
|
||||
if Cell.SpannedCols > 1 then
|
||||
begin
|
||||
if not CSame then
|
||||
begin
|
||||
for k := 1 to Cell.SpannedCols - 1 do
|
||||
Inc(CBox.R, UnitToMM(ATable.ColWidths[l + k], ATable.ColWidthsUnits, ABox));
|
||||
end
|
||||
else Inc(CBox.R, CWidth * (Cell.SpannedCols - 1));
|
||||
end;
|
||||
|
||||
// top border
|
||||
FPage.SetColor(FPColorToTColorRef(Cell.Borders.Top.Color));
|
||||
CLineWidth := GetBorderWidth(Cell.Borders.Top.LineType);
|
||||
if CLineWidth > 0 then
|
||||
FPage.DrawLine(CBox.L, CBox.T, CBox.R, CBox.T, CLineWidth);
|
||||
|
||||
// bottom border
|
||||
FPage.SetColor(FPColorToTColorRef(Cell.Borders.Bottom.Color));
|
||||
CLineWidth := GetBorderWidth(Cell.Borders.Bottom.LineType);
|
||||
if CLineWidth > 0 then
|
||||
FPage.DrawLine(CBox.L, CBox.B, CBox.R, CBox.B, CLineWidth);
|
||||
|
||||
// left border
|
||||
FPage.SetColor(FPColorToTColorRef(Cell.Borders.Left.Color));
|
||||
CLineWidth := GetBorderWidth(Cell.Borders.Left.LineType);
|
||||
if CLineWidth > 0 then
|
||||
FPage.DrawLine(CBox.L, CBox.T, CBox.L, CBox.B, CLineWidth);
|
||||
|
||||
// right border
|
||||
FPage.SetColor(FPColorToTColorRef(Cell.Borders.Right.Color));
|
||||
CLineWidth := GetBorderWidth(Cell.Borders.Right.LineType);
|
||||
if CLineWidth > 0 then
|
||||
FPage.DrawLine(CBox.R, CBox.T, CBox.R, CBox.B, CLineWidth);
|
||||
|
||||
// handle entities
|
||||
for k := 0 to Cell.GetEntitiesCount - 1 do
|
||||
begin
|
||||
Entity := Cell.GetEntity(k);
|
||||
EBox := CBox;
|
||||
EBox.T := CBox.Y;
|
||||
EBox.L := CBox.X;
|
||||
EBox.R := EBox.R - Cell.SpacingRight;
|
||||
EBox.B := EBox.B - Cell.SpacingBottom;
|
||||
Info := GetEntityInfo(Entity, Cell, EBox);
|
||||
case Info.Kind of
|
||||
ekParagraph: AddParagraph(TvParagraph(Entity), APage, AData, EBox);
|
||||
ekList: AddList(TvList(Entity), EBox);
|
||||
ekTable: AddTable(TvTable(Entity), APage, AData, EBox);
|
||||
end;
|
||||
CBox.Y := Info.Box.B;
|
||||
end;
|
||||
// next cell
|
||||
CBox.L := CBox.R;
|
||||
l := l + Cell.SpannedCols;
|
||||
end;
|
||||
// next row
|
||||
RBox.T := RBox.B;
|
||||
end;
|
||||
// update coordinates
|
||||
ABox.T := ABox.B;
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddText(AText: TvText; APara: TvParagraph; ABox: TvBoundBox);
|
||||
var
|
||||
Text: String;
|
||||
FID: Integer;
|
||||
begin
|
||||
// margins
|
||||
Inc(ABox.Y, AText.Style.MarginTop);
|
||||
Inc(ABox.X, AText.Style.MarginLeft);
|
||||
|
||||
// move textbaseline down
|
||||
Inc(ABox.Y, GetFontHeight(AText));
|
||||
|
||||
// write text
|
||||
FID := GetFontIDnew(AText.Style.Font.Name, AText.Style.Font.Bold, AText.Style.Font.Italic);
|
||||
FPage.SetFont(FID, Round(AText.Style.Font.Size));
|
||||
Text := TabsToSpaces(AText.Value.Text); // replace tabs (cannot be printed)
|
||||
FPage.WriteText(ABox.X, ABox.Y, Text, 0, AText.Style.Font.Underline, AText.Style.Font.StrikeThrough);
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddField(AField: TvField; ABox: TvBoundBox);
|
||||
begin
|
||||
// TODO: add support for fields
|
||||
raise Exception.Create('Unsupported Entity: TvField');
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.AddImage(AImage: TvRasterImage; ABox: TvBoundBox);
|
||||
var
|
||||
Image: TPDFImageItem;
|
||||
H, W: Double;
|
||||
begin
|
||||
Image := FDocument.Images.AddImageItem;
|
||||
Image.Image := AImage.RasterImage;
|
||||
H := GetImageHeight(AImage);
|
||||
W := GetImageWidth(AImage);
|
||||
Inc(ABox.Y, H);
|
||||
FPage.DrawImage(ABox.X, ABox.Y, W, H, Image.ID);
|
||||
end;
|
||||
|
||||
constructor TvPDFVectorialWriter.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FPointSeparator := DefaultFormatSettings;
|
||||
FPointSeparator.DecimalSeparator := '.';
|
||||
FPointSeparator.ThousandSeparator := '#'; // disable
|
||||
|
||||
FDocument := TPDFDocument.Create(nil);
|
||||
FDocument.FontDirectory := FONT_DIR;
|
||||
|
||||
FLineSpace := 1; // default line space
|
||||
// only using half of the spacing to ensure compatibility
|
||||
FSpacing := FLineSpace * 50/100; // 50%
|
||||
|
||||
// build font cache
|
||||
gTTFontCache.SearchPath.Add(FONT_DIR);
|
||||
gTTFontCache.BuildFontCache;
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.WriteToFile(AFileName: String; AData: TvVectorialDocument);
|
||||
var
|
||||
OStream: TFileStream;
|
||||
begin
|
||||
if ExtractFileExt(AFilename) = '' then
|
||||
AFilename := AFilename + STR_PDF_EXTENSION;
|
||||
OStream := TFileStream.Create(AFileName, fmCreate);
|
||||
try
|
||||
WriteToStream(OStream, AData);
|
||||
finally
|
||||
FreeAndNil(OStream);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TvPDFVectorialWriter.WriteToStream(AStream: TStream; AData: TvVectorialDocument);
|
||||
var
|
||||
TextPage: TvTextPageSequence;
|
||||
Info: TvEntityInfo;
|
||||
Empty: TvBoundBox;
|
||||
Entity: TvEntity;
|
||||
i, j: Integer;
|
||||
begin
|
||||
// default style
|
||||
FStyle := AData.AddStyle;
|
||||
FStyle.Font.Name := 'Times New Roman';
|
||||
FStyle.Font.Size := 11;
|
||||
FStyle.MarginLeft := 0;
|
||||
FStyle.MarginRight := 0;
|
||||
FStyle.MarginTop := FSpacing / 2;
|
||||
FStyle.MarginBottom := FSpacing / 2;
|
||||
|
||||
FDocument.StartDocument;
|
||||
AddFonts(AData);
|
||||
FDocument.Options := FDocument.Options + [poPageOriginAtTop, poNoEmbeddedFonts];
|
||||
FSection := FDocument.Sections.AddSection;
|
||||
AData.GuessDocumentSize();
|
||||
for i := 0 to AData.GetPageCount - 1 do // iterate through pages
|
||||
begin
|
||||
TextPage := AData.GetPageAsText(i);
|
||||
Empty := AddPage(TextPage, AData);
|
||||
for j := 0 to TextPage.GetEntitiesCount - 1 do // iterate through entities
|
||||
begin
|
||||
Entity := TextPage.GetEntity(j);
|
||||
Info := GetEntityInfo(Entity, nil, Empty);
|
||||
case Info.Kind of
|
||||
ekParagraph: AddParagraph(TvParagraph(Entity), TextPage, AData, Info.Box);
|
||||
ekList: AddList(TvList(Entity), Info.Box);
|
||||
ekTable: AddTable(TvTable(Entity), TextPage, AData, Info.Box);
|
||||
else raise Exception.Create('Unsupported Entity');
|
||||
end;
|
||||
Empty.T := Info.Box.B; // decrease free space
|
||||
end;
|
||||
end;
|
||||
FDocument.SaveToStream(AStream);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterVectorialWriter(TvPDFVectorialWriter, vfPDF);
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user