mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 11:08:02 +02:00
* Added fcl-pdf
git-svn-id: trunk@33162 -
This commit is contained in:
michael
parent
3526fb27a7
commit
5eb691f2c9
22
.gitattributes
vendored
22
.gitattributes
vendored
@ -2572,6 +2572,28 @@ packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain
|
||||
packages/fcl-passrc/tests/tcvarparser.pas svneol=native#text/plain
|
||||
packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
|
||||
packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
|
||||
packages/fcl-pdf/Makefile svneol=native#text/plain
|
||||
packages/fcl-pdf/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-pdf/examples/poppy.jpg -text
|
||||
packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
|
||||
packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
|
||||
packages/fcl-pdf/fpmake.pp svneol=native#text/plain
|
||||
packages/fcl-pdf/readme.txt svneol=native#text/plain
|
||||
packages/fcl-pdf/src/fpparsettf.pp svneol=native#text/plain
|
||||
packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain
|
||||
packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain
|
||||
packages/fcl-pdf/src/fpttfencodings.pp svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/fpparsettf_test.pas svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/fppdf_test.pas svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/fpttf_test.pas svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/readme.txt svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/testunits.inc svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/unittests_console.lpi svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/unittests_console.lpr svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/unittests_gui.lpi svneol=native#text/plain
|
||||
packages/fcl-pdf/tests/unittests_gui.lpr svneol=native#text/plain
|
||||
packages/fcl-pdf/utils/mkpdffontdef.lpi svneol=native#text/plain
|
||||
packages/fcl-pdf/utils/mkpdffontdef.pp svneol=native#text/plain
|
||||
packages/fcl-process/Makefile svneol=native#text/plain
|
||||
packages/fcl-process/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
|
||||
2617
packages/fcl-pdf/Makefile
Normal file
2617
packages/fcl-pdf/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
128
packages/fcl-pdf/Makefile.fpc
Normal file
128
packages/fcl-pdf/Makefile.fpc
Normal file
@ -0,0 +1,128 @@
|
||||
#
|
||||
# Makefile.fpc for running fpmake
|
||||
#
|
||||
|
||||
[package]
|
||||
name=fcl-pdf
|
||||
version=3.1.1
|
||||
|
||||
[require]
|
||||
packages=rtl fcl-base
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
|
||||
[prerules]
|
||||
FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
|
||||
ifdef OS_TARGET
|
||||
FPC_TARGETOPT+=--os=$(OS_TARGET)
|
||||
endif
|
||||
ifdef CPU_TARGET
|
||||
FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
|
||||
endif
|
||||
LOCALFPMAKE=./fpmake$(SRCEXEEXT)
|
||||
# Adding a dependency on fpmkunit is not possbile due to an infinite loop. So
|
||||
# the fpmkunit-searchpath is added here:
|
||||
PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
|
||||
ifneq ($(PACKAGEDIR_FPMKUNIT),)
|
||||
ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
|
||||
UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
|
||||
else
|
||||
UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
|
||||
endif
|
||||
ifdef CHECKDEPEND
|
||||
$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
|
||||
$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
|
||||
override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
|
||||
endif
|
||||
else
|
||||
PACKAGEDIR_FPMKUNIT=
|
||||
UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
|
||||
ifneq ($(UNITDIR_FPMKUNIT),)
|
||||
UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
|
||||
else
|
||||
UNITDIR_FPMKUNIT=
|
||||
endif
|
||||
endif
|
||||
ifdef UNITDIR_FPMAKE_FPMKUNIT
|
||||
override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
|
||||
endif
|
||||
|
||||
[rules]
|
||||
# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
|
||||
override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
|
||||
override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
|
||||
# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
|
||||
override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
|
||||
# Compose general fpmake-parameters
|
||||
ifdef FPMAKEOPT
|
||||
FPMAKE_OPT+=$(FPMAKEOPT)
|
||||
endif
|
||||
FPMAKE_OPT+=--localunitdir=../..
|
||||
FPMAKE_OPT+=--globalunitdir=..
|
||||
FPMAKE_OPT+=$(FPC_TARGETOPT)
|
||||
FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
|
||||
FPMAKE_OPT+=--compiler=$(FPC)
|
||||
FPMAKE_OPT+=-bu
|
||||
.NOTPARALLEL:
|
||||
|
||||
fpmake$(SRCEXEEXT): fpmake.pp
|
||||
$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
|
||||
all: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT)
|
||||
smart: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
|
||||
release: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
|
||||
debug: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
|
||||
# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
|
||||
# most often fail because the dependencies are cleared.
|
||||
# In case of a clean, simply do nothing
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
clean:
|
||||
else
|
||||
clean:
|
||||
$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
|
||||
endif
|
||||
# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
|
||||
# when the package is compiled using fpcmake prior to running this clean using fpmake
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
distclean: $(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
|
||||
else
|
||||
distclean:
|
||||
ifdef inUnix
|
||||
{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi; }
|
||||
else
|
||||
$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
|
||||
endif
|
||||
-$(DEL) $(LOCALFPMAKE)
|
||||
endif
|
||||
cleanall: distclean
|
||||
install: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
else
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
endif
|
||||
# distinstall also installs the example-sources and omits the location of the source-
|
||||
# files from the fpunits.cfg files.
|
||||
distinstall: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
|
||||
else
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
|
||||
endif
|
||||
zipinstall: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
|
||||
zipdistinstall: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
|
||||
zipsourceinstall: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
|
||||
else
|
||||
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
|
||||
endif
|
||||
BIN
packages/fcl-pdf/examples/poppy.jpg
Normal file
BIN
packages/fcl-pdf/examples/poppy.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 26 KiB |
72
packages/fcl-pdf/examples/testfppdf.lpi
Normal file
72
packages/fcl-pdf/examples/testfppdf.lpi
Normal file
@ -0,0 +1,72 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveOnlyProjectUnits Value="True"/>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<SaveJumpHistory Value="False"/>
|
||||
<SaveFoldState Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="testfppdf"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="testfppdf.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testfppdf"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
455
packages/fcl-pdf/examples/testfppdf.lpr
Normal file
455
packages/fcl-pdf/examples/testfppdf.lpr
Normal file
@ -0,0 +1,455 @@
|
||||
{ This program generatesa multi-page PDF document and tests various
|
||||
functionality on each of the 5 pages. }
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
program testfppdf;
|
||||
|
||||
uses
|
||||
classes, sysutils, fpimage, fpreadjpeg, freetype, fppdf;
|
||||
|
||||
Function SetUpDocument : TPDFDocument;
|
||||
Var
|
||||
P : TPDFPage;
|
||||
S : TPDFSection;
|
||||
i: integer;
|
||||
begin
|
||||
Result:=TPDFDocument.Create(Nil);
|
||||
Result.Infos.Title := 'Test Document';
|
||||
Result.Infos.Author := ApplicationName;
|
||||
Result.Infos.Producer:='fpGUI Toolkit 0.8';
|
||||
Result.Infos.ApplicationName:='pdf_demo';
|
||||
Result.Infos.CreationDate:=Now;
|
||||
Result.StartDocument;
|
||||
S:=Result.Sections.AddSection; // we always need at least one section
|
||||
for i := 1 to 5 do
|
||||
begin
|
||||
P:=Result.Pages.AddPage;
|
||||
P.PaperType := ptA4;
|
||||
P.UnitOfMeasure := uomMillimeters;
|
||||
S.AddPage(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure SaveDocument(D : TPDFDocument);
|
||||
Var
|
||||
F : TFileStream;
|
||||
begin
|
||||
F:=TFileStream.Create('test.pdf',fmCreate);
|
||||
try
|
||||
D.SaveToStream(F);
|
||||
Writeln('Document used ',D.ObjectCount,' PDF objects/commands');
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure EmptyPage;
|
||||
Var
|
||||
D : TPDFDocument;
|
||||
begin
|
||||
D:=SetupDocument;
|
||||
try
|
||||
SaveDocument(D);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ all units of measure are in millimeters }
|
||||
Procedure SimpleText(D: TPDFDocument; APage: integer);
|
||||
Var
|
||||
P : TPDFPage;
|
||||
FtTitle, FtText1, FtText2: integer;
|
||||
lPt1: TPDFCoord;
|
||||
begin
|
||||
P:=D.Pages[APage];
|
||||
// create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
|
||||
FtTitle := D.AddFont('helvetica-12', clRed);
|
||||
FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans-12', clGreen); // TODO: this color value means nothing - not used at all
|
||||
FtText2 := D.AddFont('times-8', clGreen);
|
||||
|
||||
{ Page title }
|
||||
P.SetFont(FtTitle,23);
|
||||
P.SetColor(clBlack, false);
|
||||
lPt1 := P.Matrix.Transform(25, 20);
|
||||
P.WriteText(lPt1.X, lPt1.Y, 'Sample Text');
|
||||
|
||||
// Write text using FreeSans font
|
||||
P.SetFont(ftText1,12);
|
||||
P.SetColor(clBlack, false);
|
||||
P.WriteText(25, P.GetPaperHeight-70, '(25mm,70mm) FreeSans: 0oO 1lL - wêreld çèûÎÐð£¢ß');
|
||||
lPt1 := P.Matrix.Transform(25, 76);
|
||||
P.WriteText(lPt1.X, lPt1.Y, '(25mm,76mm) - FreeSans font');
|
||||
|
||||
P.WriteUTF8Text(25, P.GetPaperHeight-200, 'Hello Graeme *'#$E2#$95#$AC'*'#$C3#$A4); // 0xE2 0x95 0xAC is UTF-8 for ╬ and 0xC3 0xA4 is UTF-8 for ä
|
||||
lPt1 := P.Matrix.Transform(25, 210);
|
||||
P.WriteUTF8Text(lPt1.X, lPt1.Y, 'В субботу двадцать третьего мая приезжает твоя любимая теща.');
|
||||
|
||||
// Write text using Helvetica font
|
||||
P.SetFont(ftText2,12);
|
||||
P.SetColor(clBlue, false);
|
||||
lPt1 := P.Matrix.Transform(25, 50);
|
||||
P.WriteText(lPt1.X, lPt1.Y, '(25mm,50mm) - Times: 0oO 1lL - wêreld çèûÎÐð£¢ß');
|
||||
P.SetFont(ftText2,16);
|
||||
P.SetColor($c00000, false);
|
||||
lPt1 := P.Matrix.Transform(75, 100);
|
||||
P.WriteText(lPt1.X, lPt1.Y, '(75mm,100mm) - Big text at absolute position');
|
||||
end;
|
||||
|
||||
Procedure SimpleLinesRaw(D: TPDFDocument; APage: integer);
|
||||
var
|
||||
P: TPDFPage;
|
||||
FtTitle: integer;
|
||||
lPt1, lPt2: TPDFCoord;
|
||||
begin
|
||||
P:=D.Pages[APage];
|
||||
// create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
|
||||
FtTitle := D.AddFont('helvetica-12', clBlack);
|
||||
|
||||
{ Page title }
|
||||
P.SetFont(FtTitle,23);
|
||||
P.SetColor(clBlack, false);
|
||||
lPt1 := P.Matrix.Transform(25, 20);
|
||||
P.WriteText(lPt1.X, lPt1.Y, 'Sample Line Drawing (DrawLine)');
|
||||
|
||||
P.SetColor(clBlack,False); // clblue
|
||||
P.SetPenStyle(ppsSolid);
|
||||
lPt1 := P.Matrix.Transform(30, 100);
|
||||
lPt2 := P.Matrix.Transform(150, 150);
|
||||
P.DrawLine(lPt1, lPt2, 0.2);
|
||||
P.SetColor($0000FF,False); // clblue
|
||||
P.SetPenStyle(ppsDash);
|
||||
lPt1 := P.Matrix.Transform(50, 70);
|
||||
lPt2 := P.Matrix.Transform(180, 100);
|
||||
P.DrawLine(lPt1, lPt2, 0.1);
|
||||
P.SetColor($FF0000,False); // clRed
|
||||
P.SetPenStyle(ppsDashDot);
|
||||
lPt1 := P.Matrix.Transform(40, 140);
|
||||
lPt2 := P.Matrix.Transform(160, 80);
|
||||
P.DrawLine(lPt1, lPt2, 1);
|
||||
P.SetColor(clBlack,False); // clBlack
|
||||
P.SetPenStyle(ppsDashDotDot);
|
||||
lPt1 := P.Matrix.Transform(60, 50);
|
||||
lPt2 := P.Matrix.Transform(60, 120);
|
||||
P.DrawLine(lPt1, lPt2, 1.5);
|
||||
P.SetColor(clBlack,False); // clBlack
|
||||
P.SetPenStyle(ppsDot);
|
||||
lPt1 := P.Matrix.Transform(10, 80);
|
||||
lPt2 := P.Matrix.Transform(130, 130);
|
||||
P.DrawLine(lPt1, lPt2, 0.5);
|
||||
end;
|
||||
|
||||
Procedure SimpleLines(D: TPDFDocument; APage: integer);
|
||||
var
|
||||
P: TPDFPage;
|
||||
FtTitle: integer;
|
||||
TsThinBlack, TsThinBlue, TsThick, TsThinRed, TsThinBlackDot: Integer;
|
||||
lPt1, lPt2: TPDFCoord;
|
||||
begin
|
||||
P:=D.Pages[APage];
|
||||
// create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
|
||||
FtTitle := D.AddFont('helvetica-12', clRed);
|
||||
|
||||
{ Page title }
|
||||
P.SetFont(FtTitle,23);
|
||||
P.SetColor(clBlack, false);
|
||||
lPt1 := P.Matrix.Transform(25, 20);
|
||||
P.WriteText(lPt1.X, lPt1.Y, 'Sample Line Drawing (DrawLineStyle)');
|
||||
|
||||
// write the text at position 100 mm from left and 120 mm from top
|
||||
TsThinBlack := D.AddLineStyleDef(0.2, clBlack, ppsSolid);
|
||||
TsThinBlue := D.AddLineStyleDef(0.1, clBlue, ppsDash);
|
||||
TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot);
|
||||
TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
|
||||
TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
|
||||
|
||||
lPt1 := P.Matrix.Transform(30, 100);
|
||||
lPt2 := P.Matrix.Transform(150, 150);
|
||||
P.DrawLineStyle(lPt1, lPt2, tsThinBlack);
|
||||
|
||||
lPt1 := P.Matrix.Transform(50, 70);
|
||||
lPt2 := P.Matrix.Transform(180, 100);
|
||||
P.DrawLineStyle(lPt1, lPt2, tsThinBlue);
|
||||
|
||||
lPt1 := P.Matrix.Transform(40, 140);
|
||||
lPt2 := P.Matrix.Transform(160, 80);
|
||||
P.DrawLineStyle(lPt1, lPt2, tsThinRed);
|
||||
|
||||
lPt1 := P.Matrix.Transform(60, 50);
|
||||
lPt2 := P.Matrix.Transform(60, 120);
|
||||
P.DrawLineStyle(lPt1, lPt2, tsThick);
|
||||
|
||||
lPt1 := P.Matrix.Transform(10, 80);
|
||||
lPt2 := P.Matrix.Transform(130, 130);
|
||||
P.DrawLineStyle(lPt1.X, lPt1.Y, lPt2.X, lPt2.Y, tsThinBlackDot); { just to test the other overloaded version too. }
|
||||
end;
|
||||
|
||||
Procedure SimpleImage(D: TPDFDocument; APage: integer);
|
||||
Var
|
||||
P: TPDFPage;
|
||||
FtTitle: integer;
|
||||
IDX: Integer;
|
||||
W, H: Integer;
|
||||
lPt1: TPDFCoord;
|
||||
begin
|
||||
P := D.Pages[APage];
|
||||
// create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
|
||||
FtTitle := D.AddFont('helvetica-12', clBlack);
|
||||
|
||||
{ Page title }
|
||||
P.SetFont(FtTitle,23);
|
||||
P.SetColor(clBlack, false);
|
||||
lPt1 := P.Matrix.Transform(25, 20);
|
||||
P.WriteText(lPt1.X, lPt1.Y, 'Sample Image Support');
|
||||
|
||||
P.SetFont(FtTitle,10);
|
||||
P.SetColor(clBlack, false);
|
||||
|
||||
IDX := D.Images.AddFromFile('poppy.jpg',False);
|
||||
W := D.Images[IDX].Width;
|
||||
H := D.Images[IDX].Height;
|
||||
{ scalled down image (small) }
|
||||
lPt1 := P.Matrix.Transform(25, 100); // left-bottom coordinate of image
|
||||
P.DrawImage(lPt1.X, lPt1.Y, W div 2, H div 2, IDX);
|
||||
lPt1 := P.Matrix.Transform(90, 75);
|
||||
P.WriteText(lPt1.X, lPt1.Y, '[Scaled image]');
|
||||
|
||||
|
||||
{ large image }
|
||||
lPt1 := P.Matrix.Transform(35, 190); // left-bottom coordinate of image
|
||||
P.DrawImage(lPt1.X, lPt1.Y, W, H, IDX);
|
||||
lPt1 := P.Matrix.Transform(160, 150);
|
||||
P.WriteText(lPt1.X, lPt1.Y, '[Default size]');
|
||||
end;
|
||||
|
||||
Procedure SimpleShapes(D: TPDFDocument; APage: integer);
|
||||
Var
|
||||
P : TPDFPage;
|
||||
FtTitle: integer;
|
||||
// FtText: integer;
|
||||
lPt1, lPt2, lPt3: TPDFCoord;
|
||||
begin
|
||||
P:=D.Pages[APage];
|
||||
// create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
|
||||
FtTitle := D.AddFont('helvetica-12', clBlack);
|
||||
|
||||
{ Page title }
|
||||
P.SetFont(FtTitle,23);
|
||||
P.SetColor(clBlack);
|
||||
lPt1 := P.Matrix.Transform(25, 20);
|
||||
P.WriteText(lPt1.X, lPt1.Y, 'Basic Shapes');
|
||||
|
||||
// ========== Rectangles ============
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 30;
|
||||
{ PDF origin coordinate is Bottom-Left, and we want to use Image coordinate of Top-Left }
|
||||
lPt1.Y := 60+20; // origin + height
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
P.SetColor(clRed, true);
|
||||
P.SetColor($37b344, false); // some green color
|
||||
P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 3, true, true);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 20;
|
||||
{ we need the Top-Left coordinate }
|
||||
lPt1.Y := 50+20; // origin + height
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
P.SetColor(clBlue, true);
|
||||
P.SetColor($b737b3, false); // some purple color
|
||||
P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 1, true, true);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 110;
|
||||
{ PDF origin coordinate is Bottom-Left, and we want to use Image cooridanet of Top-Left }
|
||||
lPt1.Y := 70+20; // origin + height
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsDashDot);
|
||||
P.SetColor(clBlue, true);
|
||||
P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 1, false, true);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 100;
|
||||
{ PDF origin coordinate is Bottom-Left, and we want to use Image cooridanet of Top-Left }
|
||||
lPt1.Y := 60+20; // origin + height
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsDash);
|
||||
P.SetColor($37b344, true); // some green color
|
||||
P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 2, false, true);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 90;
|
||||
{ we need the Top-Left coordinate }
|
||||
lPt1.Y := 50+20; // origin + height
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsSolid);
|
||||
P.SetColor($b737b3, true); // some purple color
|
||||
P.DrawRect(lPt2.X, lPt2.Y, 40, 20, 4, false, true);
|
||||
|
||||
|
||||
// ========== Ellipses ============
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt2 := P.Matrix.Transform(60, 150);
|
||||
P.SetPenStyle(ppsSolid);
|
||||
P.SetColor($c00000, True);
|
||||
P.DrawEllipse(lPt2.X, lPt2.Y, -40, 20, 3, False, True);
|
||||
|
||||
P.SetColor(clBlue, true);
|
||||
P.SetColor($b737b3, false); // some purple color
|
||||
P.DrawEllipse(lPt2, 10, 10, 1, True, True);
|
||||
(*
|
||||
P.DrawRect(mmToPDF(lPt2.X), mmToPDF(lPt2.Y), 2, 2, 1, False, True);
|
||||
FtText := D.AddFont('helvetica-8', clBlack);
|
||||
P.SetFont(ftText,8);
|
||||
P.SetColor(clblack);
|
||||
P.WriteText(mmtoPDF(100), GetPaperHeight-mmToPDF(105),'^---(origin point)');
|
||||
*)
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt2 := P.Matrix.Transform(140, 150);
|
||||
P.SetPenStyle(ppsDashDot);
|
||||
P.SetColor($b737b3, True);
|
||||
P.DrawEllipse(lPt2, 35, 20, 1, False, True);
|
||||
|
||||
|
||||
// ========== Lines Pen Styles ============
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 30;
|
||||
lPt1.Y := 200;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 70;
|
||||
lPt1.Y := 200;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsSolid);
|
||||
P.SetColor(clBlack, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
|
||||
|
||||
lPt1.X := 30;
|
||||
lPt1.Y := 210;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 70;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsDash);
|
||||
P.SetColor(clBlack, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
|
||||
|
||||
lPt1.X := 30;
|
||||
lPt1.Y := 220;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 70;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsDot);
|
||||
P.SetColor(clBlack, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
|
||||
|
||||
lPt1.X := 30;
|
||||
lPt1.Y := 230;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 70;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsDashDot);
|
||||
P.SetColor(clBlack, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
|
||||
|
||||
lPt1.X := 30;
|
||||
lPt1.Y := 240;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 70;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsDashDotDot);
|
||||
P.SetColor(clBlack, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
|
||||
|
||||
|
||||
// ========== Line Attribute ============
|
||||
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 170;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetPenStyle(ppsSolid);
|
||||
P.SetColor(clBlack, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 0.2);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 180;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 0.3);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 190;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 0.5);
|
||||
|
||||
{ Transform the origin point to the Cartesian coordinate system. }
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 200;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 1);
|
||||
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 210;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetColor(clRed, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 2);
|
||||
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 220;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetColor($37b344, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 3);
|
||||
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 230;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetColor(clBlue, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 4);
|
||||
|
||||
lPt1.X := 100;
|
||||
lPt1.Y := 240;
|
||||
lPt2 := P.Matrix.Transform(lPt1);
|
||||
lPt1.X := 140;
|
||||
lPt3 := P.Matrix.Transform(lPt1);
|
||||
P.SetColor($b737b3, True);
|
||||
P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 5);
|
||||
end;
|
||||
|
||||
Var
|
||||
D: TPDFDocument;
|
||||
begin
|
||||
D := SetupDocument;
|
||||
try
|
||||
D.FontDirectory := ExtractFIlePath(Paramstr(0))+'fonts'+PathDelim;
|
||||
|
||||
SimpleText(D, 0);
|
||||
SimpleShapes(D, 1);
|
||||
SimpleLines(D, 2);
|
||||
SimpleLinesRaw(D, 3);
|
||||
SimpleImage(D, 4);
|
||||
|
||||
SaveDocument(D);
|
||||
finally
|
||||
D.Free;
|
||||
end;
|
||||
end.
|
||||
|
||||
48
packages/fcl-pdf/fpmake.pp
Normal file
48
packages/fcl-pdf/fpmake.pp
Normal file
@ -0,0 +1,48 @@
|
||||
{$ifndef ALLPACKAGES}
|
||||
{$mode objfpc}{$H+}
|
||||
program fpmake;
|
||||
|
||||
uses fpmkunit;
|
||||
|
||||
Var
|
||||
P : TPackage;
|
||||
T : TTarget;
|
||||
begin
|
||||
With Installer do
|
||||
begin
|
||||
{$endif ALLPACKAGES}
|
||||
P:=AddPackage('fcl-pdf');
|
||||
|
||||
{$ifdef ALLPACKAGES}
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
|
||||
P.Author := 'Michael Van Canneyt & Graeme Geldenhuys';
|
||||
P.License := 'LGPL with modification, ';
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
P.Email := '';
|
||||
P.Description := 'PDF generating and TTF file info library';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=P.OSes-[embedded,win16];
|
||||
P.Dependencies.Add('rtl-objpas');
|
||||
P.Dependencies.Add('fcl-base');
|
||||
P.Dependencies.Add('fcl-image');
|
||||
P.Dependencies.Add('paszlib');
|
||||
P.Version:='3.1.1';
|
||||
T:=P.Targets.AddUnit('src/fpttfencodings.pp');
|
||||
T:=P.Targets.AddUnit('src/fpparsettf.pp');
|
||||
With T do
|
||||
Dependencies.AddUnit('fpttfencodings');
|
||||
T:=P.Targets.AddUnit('src/fpttf.pp');
|
||||
T:=P.Targets.AddUnit('src/fppdf.pp');
|
||||
With T do
|
||||
begin
|
||||
Dependencies.AddUnit('fpparsettf');
|
||||
end;
|
||||
|
||||
// md5.ref
|
||||
{$ifndef ALLPACKAGES}
|
||||
Run;
|
||||
end;
|
||||
end.
|
||||
{$endif ALLPACKAGES}
|
||||
29
packages/fcl-pdf/readme.txt
Normal file
29
packages/fcl-pdf/readme.txt
Normal file
@ -0,0 +1,29 @@
|
||||
The fcl-pdf package contains a PDF generating unit fppdf that does not depend
|
||||
on any external libraries.
|
||||
|
||||
The PDF generator has the following features:
|
||||
- Support for basic shapes.
|
||||
- Support for basic line styles.
|
||||
- Dictionary support.
|
||||
- Multi-page PDF.
|
||||
- Image support.
|
||||
- TTF Font support.
|
||||
- Font embedding.
|
||||
- Unicode font support.
|
||||
- Stream Compression.
|
||||
- Image embedding.
|
||||
- Several paper types.
|
||||
- Portrait/Landscape.
|
||||
- Support for multiple units.
|
||||
- Rotation matrix system.
|
||||
- PDF creator information.
|
||||
|
||||
Todo:
|
||||
- Implement TFPCustomCanvas descendent (TPDFCanvas) that draws on a PDF.
|
||||
- Partial embedding of (unicode) fonts for smaller PDFs.
|
||||
- On windows, allow to use native font mechanisms for extracting info from TTF files.
|
||||
|
||||
Optionally:
|
||||
- PDF Forms.
|
||||
- Archive format.
|
||||
- Signature.
|
||||
1257
packages/fcl-pdf/src/fpparsettf.pp
Normal file
1257
packages/fcl-pdf/src/fpparsettf.pp
Normal file
File diff suppressed because it is too large
Load Diff
3569
packages/fcl-pdf/src/fppdf.pp
Normal file
3569
packages/fcl-pdf/src/fppdf.pp
Normal file
File diff suppressed because it is too large
Load Diff
480
packages/fcl-pdf/src/fpttf.pp
Normal file
480
packages/fcl-pdf/src/fpttf.pp
Normal file
@ -0,0 +1,480 @@
|
||||
{
|
||||
Description:
|
||||
This is a homegrown font cache. The fpReport reports can reference
|
||||
a font by its name. The job of the font cache is to look through
|
||||
its cached fonts to match the font name, and which *.ttf file it
|
||||
relates too. The reporting code can then extract font details
|
||||
correctly (eg: font width, height etc).
|
||||
}
|
||||
unit fpTTF;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{.$define ttfdebug}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
contnrs,
|
||||
fpparsettf;
|
||||
|
||||
const
|
||||
{ constants to query FontCacheItem.StyleFlags with. }
|
||||
FP_FONT_STYLE_REGULAR = 1 shl 0; { Regular, Plain, Book }
|
||||
FP_FONT_STYLE_ITALIC = 1 shl 1; { Italic }
|
||||
FP_FONT_STYLE_BOLD = 1 shl 2; { Bold }
|
||||
FP_FONT_STYLE_CONDENSED = 1 shl 3; { Condensed }
|
||||
FP_FONT_STYLE_EXTRALIGHT = 1 shl 4; { ExtraLight }
|
||||
FP_FONT_STYLE_LIGHT = 1 shl 5; { Light }
|
||||
FP_FONT_STYLE_SEMIBOLD = 1 shl 6; { Semibold }
|
||||
FP_FONT_STYLE_MEDIUM = 1 shl 7; { Medium }
|
||||
FP_FONT_STYLE_BLACK = 1 shl 8; { Black }
|
||||
FP_FONT_STYLE_FIXEDWIDTH = 1 shl 9; { Fixedwidth }
|
||||
|
||||
type
|
||||
{ Forward declaration }
|
||||
TFPFontCacheList = class;
|
||||
|
||||
|
||||
TFPFontCacheItem = class(TObject)
|
||||
private
|
||||
FFamilyName: String;
|
||||
FFileName: String;
|
||||
FStyleFlags: LongWord;
|
||||
FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
|
||||
function GetIsBold: boolean;
|
||||
function GetIsFixedWidth: boolean;
|
||||
function GetIsItalic: boolean;
|
||||
function GetIsRegular: boolean;
|
||||
procedure SetIsBold(AValue: boolean);
|
||||
procedure SetIsFixedWidth(AValue: boolean);
|
||||
procedure SetIsItalic(AValue: boolean);
|
||||
procedure SetIsRegular(AValue: boolean);
|
||||
public
|
||||
constructor Create(const AFilename: String);
|
||||
{ Returns the actual TTF font file information. Caller needs to free the returned instance. }
|
||||
function GetFontData: TTFFileInfo;
|
||||
{ Result is in pixels }
|
||||
function TextWidth(AStr: string; APointSize: single): single;
|
||||
property FileName: String read FFileName write FFileName;
|
||||
property FamilyName: String read FFamilyName write FFamilyName;
|
||||
{ A bitmasked value describing the full font style }
|
||||
property StyleFlags: LongWord read FStyleFlags write FStyleFlags;
|
||||
{ IsXXX properties are convenience properties, internally querying StyleFlags. }
|
||||
property IsFixedWidth: boolean read GetIsFixedWidth write SetIsFixedWidth;
|
||||
property IsRegular: boolean read GetIsRegular write SetIsRegular;
|
||||
property IsItalic: boolean read GetIsItalic write SetIsItalic;
|
||||
property IsBold: boolean read GetIsBold write SetIsBold;
|
||||
end;
|
||||
|
||||
|
||||
TFPFontCacheList = class(TObject)
|
||||
private
|
||||
FList: TObjectList;
|
||||
FSearchPath: TStringList;
|
||||
FDPI: integer;
|
||||
procedure SearchForFont(const AFontPath: String);
|
||||
function BuildFontCacheItem(const AFontFile: String): TFPFontCacheItem;
|
||||
procedure SetStyleIfExists(var AText: string; var AStyleFlags: integer; const AStyleName: String; const AStyleBit: integer);
|
||||
procedure SetDPI(AValue: integer);
|
||||
protected
|
||||
function GetCount: integer; virtual;
|
||||
function GetItem(AIndex: Integer): TFPFontCacheItem; virtual;
|
||||
procedure SetItem(AIndex: Integer; AValue: TFPFontCacheItem); virtual;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure BuildFontCache;
|
||||
function Add(const AObject: TFPFontCacheItem): integer;
|
||||
procedure Clear;
|
||||
property Count: integer read GetCount;
|
||||
function IndexOf(const AObject: TFPFontCacheItem): integer;
|
||||
function Find(const AFontCacheItem: TFPFontCacheItem): integer;
|
||||
function Find(const AFamilyName: string; ABold: boolean = False; AItalic: boolean = False): TFPFontCacheItem;
|
||||
{ not used: utility function doing a conversion for use. }
|
||||
function PointSizeInPixels(const APointSize: single): single;
|
||||
property Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
|
||||
property SearchPath: TStringList read FSearchPath;
|
||||
property DPI: integer read FDPI write SetDPI;
|
||||
end;
|
||||
|
||||
|
||||
function gTTFontCache: TFPFontCacheList;
|
||||
|
||||
implementation
|
||||
|
||||
resourcestring
|
||||
rsNoSearchPathDefined = 'No search path was defined';
|
||||
rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
|
||||
|
||||
type
|
||||
{ so we can get access to protected methods }
|
||||
TFriendTTFFileInfo = class(TTFFileInfo);
|
||||
|
||||
var
|
||||
uFontCacheList: TFPFontCacheList;
|
||||
|
||||
function gTTFontCache: TFPFontCacheList;
|
||||
begin
|
||||
if not Assigned(uFontCacheList) then
|
||||
begin
|
||||
uFontCacheList := TFPFontCacheList.Create;
|
||||
end;
|
||||
Result := uFontCacheList;
|
||||
end;
|
||||
|
||||
{ TFPFontCacheItem }
|
||||
|
||||
function TFPFontCacheItem.GetIsBold: boolean;
|
||||
begin
|
||||
Result := (FStyleFlags and FP_FONT_STYLE_BOLD) <> 0;
|
||||
end;
|
||||
|
||||
function TFPFontCacheItem.GetIsFixedWidth: boolean;
|
||||
begin
|
||||
Result := (FStyleFlags and FP_FONT_STYLE_FIXEDWIDTH) <> 0;
|
||||
end;
|
||||
|
||||
function TFPFontCacheItem.GetIsItalic: boolean;
|
||||
begin
|
||||
Result := (FStyleFlags and FP_FONT_STYLE_ITALIC) <> 0;
|
||||
end;
|
||||
|
||||
function TFPFontCacheItem.GetIsRegular: boolean;
|
||||
begin
|
||||
Result := (FStyleFlags and FP_FONT_STYLE_REGULAR) <> 0;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItem.SetIsBold(AValue: boolean);
|
||||
begin
|
||||
if AValue then
|
||||
FStyleFlags := FStyleFlags or FP_FONT_STYLE_BOLD
|
||||
else
|
||||
FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_BOLD);
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItem.SetIsFixedWidth(AValue: boolean);
|
||||
begin
|
||||
if AValue then
|
||||
FStyleFlags := FStyleFlags or FP_FONT_STYLE_FIXEDWIDTH
|
||||
else
|
||||
FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_FIXEDWIDTH);
|
||||
|
||||
// if we are FixedWidth, then Regular can't apply
|
||||
FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_REGULAR);
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItem.SetIsItalic(AValue: boolean);
|
||||
begin
|
||||
if AValue then
|
||||
FStyleFlags := FStyleFlags or FP_FONT_STYLE_ITALIC
|
||||
else
|
||||
FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_ITALIC);
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItem.SetIsRegular(AValue: boolean);
|
||||
begin
|
||||
if AValue then
|
||||
FStyleFlags := FStyleFlags or FP_FONT_STYLE_REGULAR
|
||||
else
|
||||
FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_REGULAR);
|
||||
|
||||
// if we are Regular, then FixedWidth can't apply
|
||||
FStyleFlags := FStyleFlags and (not FP_FONT_STYLE_FIXEDWIDTH);
|
||||
end;
|
||||
|
||||
constructor TFPFontCacheItem.Create(const AFilename: String);
|
||||
begin
|
||||
inherited Create;
|
||||
FFileName := AFilename;
|
||||
FStyleFlags := FP_FONT_STYLE_REGULAR;
|
||||
end;
|
||||
|
||||
function TFPFontCacheItem.GetFontData: TTFFileInfo;
|
||||
begin
|
||||
if FileName = '' then
|
||||
raise ETTF.Create(rsNoFontFileName);
|
||||
if FileExists(FileName) then
|
||||
begin
|
||||
Result := TTFFileInfo.Create;
|
||||
Result.LoadFromFile(FileName);
|
||||
end
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
{ TextWidth returns with width of the text. If APointSize = 0.0, then it returns
|
||||
the text width in Font Units. If APointSize > 0 then it returns the text width
|
||||
in Pixels. }
|
||||
function TFPFontCacheItem.TextWidth(AStr: string; APointSize: single): single;
|
||||
{
|
||||
From Microsoft's Typography website:
|
||||
Converting FUnits (font units) to pixels
|
||||
|
||||
Values in the em square are converted to values in the pixel coordinate system
|
||||
by multiplying them by a scale. This scale is:
|
||||
|
||||
pointSize * resolution / ( 72 points per inch * units_per_em )
|
||||
|
||||
where pointSize is the size at which the glyph is to be displayed, and resolution
|
||||
is the resolution of the output device. The 72 in the denominator reflects the
|
||||
number of points per inch.
|
||||
|
||||
For example, assume that a glyph feature is 550 FUnits in length on a 72 dpi
|
||||
screen at 18 point. There are 2048 units per em. The following calculation
|
||||
reveals that the feature is 4.83 pixels long.
|
||||
|
||||
550 * 18 * 72 / ( 72 * 2048 ) = 4.83
|
||||
}
|
||||
var
|
||||
lFntInfo: TFriendTTFFileInfo;
|
||||
i: integer;
|
||||
lWidth: integer;
|
||||
lGIndex: integer;
|
||||
c: Char;
|
||||
{$IFDEF ttfdebug}
|
||||
sl: TStringList;
|
||||
s: string;
|
||||
{$ENDIF}
|
||||
begin
|
||||
Result := 0;
|
||||
if Length(AStr) = 0 then
|
||||
Exit;
|
||||
|
||||
lFntInfo := TFriendTTFFileInfo(GetFontData);
|
||||
if not Assigned(lFntInfo) then
|
||||
Exit;
|
||||
|
||||
{$IFDEF ttfdebug}
|
||||
sl := TStringList.Create;
|
||||
s := '';
|
||||
for i := 0 to 255 do
|
||||
begin
|
||||
lGIndex := lFntInfo.GetGlyphIndex(i);
|
||||
lWidth := lFntInfo.GetAdvanceWidth(lGIndex);
|
||||
s := s + ',' + IntToStr(lWidth);
|
||||
end;
|
||||
sl.Add(s);
|
||||
sl.Add('UnitsPerEm = ' + IntToStr(lFntInfo.Head.UnitsPerEm));
|
||||
sl.SaveToFile('/tmp/' + lFntInfo.PostScriptName + '.txt');
|
||||
sl.Free;
|
||||
{$ENDIF}
|
||||
|
||||
try
|
||||
lWidth := 0;
|
||||
for i := 1 to Length(AStr) do
|
||||
begin
|
||||
c := AStr[i];
|
||||
lGIndex := lFntInfo.GetGlyphIndex(Ord(c));
|
||||
lWidth := lWidth + lFntInfo.GetAdvanceWidth(lGIndex);
|
||||
end;
|
||||
|
||||
if APointSize = 0.0 then
|
||||
Result := lWidth
|
||||
else
|
||||
begin
|
||||
{ Converting Font Units to Pixels. The formula is:
|
||||
pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm ) }
|
||||
Result := lWidth * APointSize * FOwner.DPI / (72 * lFntInfo.Head.UnitsPerEm);
|
||||
end;
|
||||
finally
|
||||
lFntInfo.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFPFontCacheList }
|
||||
|
||||
procedure TFPFontCacheList.SearchForFont(const AFontPath: String);
|
||||
var
|
||||
sr: TSearchRec;
|
||||
lFont: TFPFontCacheItem;
|
||||
s: String;
|
||||
begin
|
||||
if FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
|
||||
begin
|
||||
repeat
|
||||
// check if special files to skip
|
||||
if (sr.Name = '.') or (sr.Name = '..') or (sr.Name = '') then
|
||||
Continue;
|
||||
// We got something, so lets continue
|
||||
s := sr.Name;
|
||||
if (sr.Attr and faDirectory) <> 0 then // found a directory
|
||||
SearchForFont(IncludeTrailingPathDelimiter(AFontPath + s))
|
||||
else
|
||||
begin // we have a file
|
||||
if (lowercase(ExtractFileExt(s)) = '.ttf') or
|
||||
(lowercase(ExtractFileExt(s)) = '.otf') then
|
||||
begin
|
||||
lFont := BuildFontCacheItem(AFontPath + s);
|
||||
Add(lFont);
|
||||
end;
|
||||
end;
|
||||
until FindNext(sr) <> 0;
|
||||
end;
|
||||
FindClose(sr);
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.BuildFontCacheItem(const AFontFile: String): TFPFontCacheItem;
|
||||
var
|
||||
lFontInfo: TTFFileInfo;
|
||||
s: string;
|
||||
flags: integer;
|
||||
begin
|
||||
lFontInfo := TTFFileInfo.Create;
|
||||
try
|
||||
lFontInfo.LoadFromFile(AFontFile);
|
||||
|
||||
Result := TFPFontCacheItem.Create(AFontFile);
|
||||
s := lFontInfo.PostScriptName;
|
||||
Result.FamilyName := lFontInfo.FamilyName;
|
||||
|
||||
// extract simple styles first
|
||||
if lFontInfo.PostScript.isFixedPitch > 0 then
|
||||
Result.StyleFlags := FP_FONT_STYLE_FIXEDWIDTH; // this should overwrite Regular style
|
||||
|
||||
if lFontInfo.PostScript.ItalicAngle <> 0 then
|
||||
Result.StyleFlags := Result.StyleFlags or FP_FONT_STYLE_ITALIC;
|
||||
|
||||
// Now to more complex styles stored in StyleName field. eg: 'Condensed Medium'
|
||||
flags := Result.StyleFlags;
|
||||
SetStyleIfExists(s, flags, 'Bold', FP_FONT_STYLE_BOLD);
|
||||
SetStyleIfExists(s, flags, 'Condensed', FP_FONT_STYLE_CONDENSED);
|
||||
SetStyleIfExists(s, flags, 'ExtraLight', FP_FONT_STYLE_EXTRALIGHT);
|
||||
SetStyleIfExists(s, flags, 'Light', FP_FONT_STYLE_LIGHT);
|
||||
SetStyleIfExists(s, flags, 'Semibold', FP_FONT_STYLE_SEMIBOLD);
|
||||
SetStyleIfExists(s, flags, 'Medium', FP_FONT_STYLE_MEDIUM);
|
||||
SetStyleIfExists(s, flags, 'Black', FP_FONT_STYLE_BLACK);
|
||||
Result.StyleFlags := flags;
|
||||
finally
|
||||
lFontInfo.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheList.SetStyleIfExists(var AText: string; var AStyleFlags: integer; const AStyleName: String;
|
||||
const AStyleBit: integer);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
i := Pos(AStyleName, AText);
|
||||
if i > 0 then
|
||||
begin
|
||||
AStyleFlags := AStyleFlags or AStyleBit;
|
||||
Delete(AText, Length(AStyleName), i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheList.SetDPI(AValue: integer);
|
||||
begin
|
||||
if FDPI = AValue then Exit;
|
||||
FDPI := AValue;
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.GetCount: integer;
|
||||
begin
|
||||
Result := FList.Count;
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.GetItem(AIndex: Integer): TFPFontCacheItem;
|
||||
begin
|
||||
Result := TFPFontCacheItem(FList.Items[AIndex]);
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheList.SetItem(AIndex: Integer; AValue: TFPFontCacheItem);
|
||||
begin
|
||||
FList.Items[AIndex] := AValue;
|
||||
end;
|
||||
|
||||
constructor TFPFontCacheList.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FList := TObjectList.Create;
|
||||
FSearchPath := TStringList.Create;
|
||||
FDPI := 96; // The default is the most common dpi used
|
||||
end;
|
||||
|
||||
destructor TFPFontCacheList.Destroy;
|
||||
begin
|
||||
FList.Free;
|
||||
FSearchPath.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheList.BuildFontCache;
|
||||
var
|
||||
lPath: String;
|
||||
i: integer;
|
||||
begin
|
||||
if FSearchPath.Count < 1 then
|
||||
raise ETTF.Create(rsNoSearchPathDefined);
|
||||
|
||||
for i := 0 to FSearchPath.Count-1 do
|
||||
begin
|
||||
lPath := FSearchPath[i];
|
||||
SearchForFont(IncludeTrailingPathDelimiter(lPath));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.Add(const AObject: TFPFontCacheItem): integer;
|
||||
begin
|
||||
Result := FList.Add(AObject);
|
||||
AObject.FOwner := self;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheList.Clear;
|
||||
begin
|
||||
FList.Clear;
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.IndexOf(const AObject: TFPFontCacheItem): integer;
|
||||
begin
|
||||
Result := FList.IndexOf(AObject);
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.Find(const AFontCacheItem: TFPFontCacheItem): integer;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := -1; // nothing found
|
||||
for i := 0 to Count-1 do
|
||||
begin
|
||||
if (Items[i].FamilyName = AFontCacheItem.FamilyName) and
|
||||
(Items[i].StyleFlags = AFontCacheItem.StyleFlags) then
|
||||
begin
|
||||
Result := i;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.Find(const AFamilyName: string; ABold: boolean; AItalic: boolean): TFPFontCacheItem;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result := nil;
|
||||
for i := 0 to Count-1 do
|
||||
begin
|
||||
if (Items[i].FamilyName = AFamilyName) and (items[i].IsItalic = AItalic)
|
||||
and (items[i].IsBold = ABold) then
|
||||
begin
|
||||
Result := Items[i];
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPFontCacheList.PointSizeInPixels(const APointSize: single): single;
|
||||
begin
|
||||
Result := APointSize * DPI / 72;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
uFontCacheList := nil;
|
||||
|
||||
finalization
|
||||
uFontCacheList.Free;
|
||||
|
||||
end.
|
||||
|
||||
2127
packages/fcl-pdf/src/fpttfencodings.pp
Normal file
2127
packages/fcl-pdf/src/fpttfencodings.pp
Normal file
File diff suppressed because it is too large
Load Diff
2060
packages/fcl-pdf/tests/fpparsettf_test.pas
Normal file
2060
packages/fcl-pdf/tests/fpparsettf_test.pas
Normal file
File diff suppressed because it is too large
Load Diff
1655
packages/fcl-pdf/tests/fppdf_test.pas
Normal file
1655
packages/fcl-pdf/tests/fppdf_test.pas
Normal file
File diff suppressed because it is too large
Load Diff
308
packages/fcl-pdf/tests/fpttf_test.pas
Normal file
308
packages/fcl-pdf/tests/fpttf_test.pas
Normal file
@ -0,0 +1,308 @@
|
||||
unit fpttf_test;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils
|
||||
{$ifdef fptest}
|
||||
,TestFramework
|
||||
{$else}
|
||||
,fpcunit, testutils, testregistry
|
||||
{$endif}
|
||||
,fpttf
|
||||
;
|
||||
|
||||
type
|
||||
|
||||
TFPFontCacheItemTest = class(TTestCase)
|
||||
private
|
||||
FCacheItem: TFPFontCacheItem;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
public
|
||||
property CI: TFPFontCacheItem read FCacheItem;
|
||||
published
|
||||
procedure TestIsRegular;
|
||||
procedure TestIsBold;
|
||||
procedure TestIsItalic;
|
||||
procedure TestIsFixedWidth;
|
||||
procedure TestRegularVsFixedWidth;
|
||||
procedure TestFileName;
|
||||
procedure TestTextWidth_FontUnits;
|
||||
procedure TestTextWidth_Pixels;
|
||||
end;
|
||||
|
||||
|
||||
TFPFontCacheListTest = class(TTestCase)
|
||||
private
|
||||
FFontCacheList: TFPFontCacheList;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
public
|
||||
property FC: TFPFontCacheList read FFontCacheList;
|
||||
published
|
||||
procedure TestCount;
|
||||
procedure TestBuildFontCache;
|
||||
procedure TestClear;
|
||||
procedure TestFind_FamilyName;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
fpparsettf;
|
||||
|
||||
{ TFPFontCacheItemTest }
|
||||
|
||||
procedure TFPFontCacheItemTest.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
FCacheItem := TFPFontCacheItem.Create('mytest.ttf');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TearDown;
|
||||
begin
|
||||
FCacheItem.Free;
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestIsRegular;
|
||||
begin
|
||||
CheckEquals(True, CI.IsRegular, 'Failed on 1');
|
||||
CI.IsRegular := True;
|
||||
CI.IsRegular := True; // to make sure bitwise masks work correctly
|
||||
CheckEquals(True, CI.IsRegular, 'Failed on 2');
|
||||
CI.IsItalic := True;
|
||||
CheckEquals(True, CI.IsRegular, 'Failed on 3');
|
||||
CI.IsRegular := False;
|
||||
CheckEquals(False, CI.IsRegular, 'Failed on 4');
|
||||
CI.IsRegular := False; // to make sure bitwise masks work correctly. eg: xor usage
|
||||
CheckEquals(False, CI.IsRegular, 'Failed on 5');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestIsBold;
|
||||
begin
|
||||
CheckEquals(False, CI.IsBold, 'Failed on 1');
|
||||
CI.IsBold := True;
|
||||
CI.IsBold := True; // to make sure bitwise masks work correctly
|
||||
CheckEquals(True, CI.IsBold, 'Failed on 2');
|
||||
CI.IsBold := True;
|
||||
CI.IsItalic := True;
|
||||
CheckEquals(True, CI.IsBold, 'Failed on 3');
|
||||
CI.IsBold := False;
|
||||
CheckEquals(False, CI.IsBold, 'Failed on 4');
|
||||
CI.IsBold := False; // to make sure bitwise masks work correctly. eg: xor usage
|
||||
CheckEquals(False, CI.IsBold, 'Failed on 5');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestIsItalic;
|
||||
begin
|
||||
CheckEquals(False, CI.IsItalic, 'Failed on 1');
|
||||
CI.IsItalic := True;
|
||||
CI.IsItalic := True; // to make sure bitwise masks work correctly
|
||||
CheckEquals(True, CI.IsItalic, 'Failed on 2');
|
||||
CI.IsBold := True;
|
||||
CI.IsItalic := True;
|
||||
CheckEquals(True, CI.IsItalic, 'Failed on 3');
|
||||
CI.IsItalic := False;
|
||||
CheckEquals(False, CI.IsItalic, 'Failed on 4');
|
||||
CI.IsItalic := False; // to make sure bitwise masks work correctly. eg: xor usage
|
||||
CheckEquals(False, CI.IsItalic, 'Failed on 5');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestIsFixedWidth;
|
||||
begin
|
||||
CheckEquals(False, CI.IsFixedWidth, 'Failed on 1');
|
||||
CI.IsFixedWidth := True;
|
||||
CheckEquals(True, CI.IsFixedWidth, 'Failed on 2');
|
||||
CI.IsFixedWidth := True; // to make sure bitwise masks work correctly
|
||||
CheckEquals(True, CI.IsFixedWidth, 'Failed on 3');
|
||||
CI.IsItalic := True; // changing another bitmask doesn't affect IsFixedWidth
|
||||
CheckEquals(True, CI.IsFixedWidth, 'Failed on 4');
|
||||
CI.IsFixedWidth := False;
|
||||
CheckEquals(False, CI.IsFixedWidth, 'Failed on 5');
|
||||
CI.IsFixedWidth := False; // to make sure bitwise masks work correctly. eg: xor usage
|
||||
CheckEquals(False, CI.IsFixedWidth, 'Failed on 6');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
|
||||
begin
|
||||
CheckEquals(True, CI.IsRegular, 'Failed on 1');
|
||||
CheckEquals(False, CI.IsFixedWidth, 'Failed on 2');
|
||||
CI.IsFixedWidth := True; // this should toggle IsRegular's value
|
||||
CheckEquals(False, CI.IsRegular, 'Failed on 3');
|
||||
CheckEquals(True, CI.IsFixedWidth, 'Failed on 4');
|
||||
CI.IsRegular := True; // this should toggle IsFixedWidth's value
|
||||
CheckEquals(True, CI.IsRegular, 'Failed on 5');
|
||||
CheckEquals(False, CI.IsFixedWidth, 'Failed on 6');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestFileName;
|
||||
begin
|
||||
CI.FileName := '';
|
||||
try
|
||||
CI.GetFontData;
|
||||
Fail('Failed on 1. GetFontData should work if FileName is empty.');
|
||||
except
|
||||
on e: Exception do
|
||||
begin
|
||||
CheckEquals(E.ClassName, 'ETTF', 'Failed on 2.');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
|
||||
var
|
||||
lFC: TFPFontCacheList;
|
||||
lCI: TFPFontCacheItem;
|
||||
begin
|
||||
lFC := TFPFontCacheList.Create;
|
||||
try
|
||||
lFC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
|
||||
lFC.BuildFontCache;
|
||||
|
||||
lCI := lFC.Find('Liberation Sans');
|
||||
AssertEquals('Failed on 1', 14684, round(lCI.TextWidth('Country Ppml01', 0.0)));
|
||||
|
||||
lCI := lFC.Find('DejaVu Sans');
|
||||
AssertEquals('Failed on 2', 16492, round(lCI.TextWidth('Country Ppml01', 0.0)));
|
||||
|
||||
lCI := lFC.Find('Ubuntu'); // 7333 is the raw glyph width, but with kerning it is 7339
|
||||
AssertEquals('Failed on 3', 7333, round(lCI.TextWidth('Country Ppml01', 0.0)));
|
||||
finally
|
||||
lFC.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheItemTest.TestTextWidth_Pixels;
|
||||
var
|
||||
lFC: TFPFontCacheList;
|
||||
lCI: TFPFontCacheItem;
|
||||
px: single;
|
||||
begin
|
||||
lFC := TFPFontCacheList.Create;
|
||||
try
|
||||
lFC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
|
||||
lFC.BuildFontCache;
|
||||
|
||||
lCI := lFC.Find('Liberation Sans');
|
||||
px := 14684 * 10 * 96 / (72 * 2048); // 95.599px
|
||||
AssertEquals('Failed on 1', px, lCI.TextWidth('Country Ppml01', 10.0));
|
||||
px := 14684 * 12 * 96 / (72 * 2048); // 114.7188px
|
||||
AssertEquals('Failed on 2', px, lCI.TextWidth('Country Ppml01', 12.0));
|
||||
px := 14684 * 24 * 96 / (72 * 2048); // 229.4375px
|
||||
AssertEquals('Failed on 3', px, lCI.TextWidth('Country Ppml01', 24.0));
|
||||
|
||||
lCI := lFC.Find('DejaVu Sans');
|
||||
px := 16492 * 10 * 96 / (72 * 2048); // 107.369px
|
||||
AssertEquals('Failed on 4', px, lCI.TextWidth('Country Ppml01', 10.0));
|
||||
px := 16492 * 12 * 96 / (72 * 2048); // 128.8438px
|
||||
AssertEquals('Failed on 5', px, lCI.TextWidth('Country Ppml01', 12.0));
|
||||
px := 16492 * 24 * 96 / (72 * 2048); // 205.6875px
|
||||
AssertEquals('Failed on 6', px, lCI.TextWidth('Country Ppml01', 24.0));
|
||||
|
||||
lCI := lFC.Find('Ubuntu');
|
||||
px := 7333 * 10 * 96 / (72 * 1000); // 97.7733px
|
||||
AssertEquals('Failed on 7', px, lCI.TextWidth('Country Ppml01', 10.0));
|
||||
px := 7333 * 12 * 96 / (72 * 1000); // 117.328px
|
||||
AssertEquals('Failed on 8', px, lCI.TextWidth('Country Ppml01', 12.0));
|
||||
px := 7333 * 24 * 96 / (72 * 1000); // 234.656px
|
||||
AssertEquals('Failed on 9', px, lCI.TextWidth('Country Ppml01', 24.0));
|
||||
finally
|
||||
lFC.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFPFontCacheListTest }
|
||||
|
||||
procedure TFPFontCacheListTest.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
FFontCacheList := TFPFontCacheList.Create;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheListTest.TearDown;
|
||||
begin
|
||||
FFontCacheList.Free;
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheListTest.TestCount;
|
||||
begin
|
||||
CheckEquals(0, FC.Count, 'Failed on 1');
|
||||
FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
|
||||
CheckEquals(0, FC.Count, 'Failed on 2');
|
||||
FC.BuildFontCache;
|
||||
CheckEquals(4, FC.Count, 'Failed on 3');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheListTest.TestBuildFontCache;
|
||||
begin
|
||||
CheckEquals(0, FC.Count, 'Failed on 1');
|
||||
try
|
||||
FC.BuildFontCache;
|
||||
Fail('Failed on 2. We don''t have font paths, so BuildFontCache shouldn''t run.');
|
||||
except
|
||||
on e: Exception do
|
||||
begin
|
||||
CheckEquals(E.ClassName, 'ETTF', 'Failed on 3.');
|
||||
end;
|
||||
end;
|
||||
|
||||
FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
|
||||
CheckEquals(0, FC.Count, 'Failed on 4');
|
||||
FC.BuildFontCache;
|
||||
CheckEquals(4, FC.Count, 'Failed on 5');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheListTest.TestClear;
|
||||
begin
|
||||
CheckEquals(0, FC.Count, 'Failed on 1');
|
||||
FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
|
||||
FC.BuildFontCache;
|
||||
CheckEquals(4, FC.Count, 'Failed on 2');
|
||||
FC.Clear;
|
||||
CheckEquals(0, FC.Count, 'Failed on 3');
|
||||
end;
|
||||
|
||||
procedure TFPFontCacheListTest.TestFind_FamilyName;
|
||||
var
|
||||
lCI: TFPFontCacheItem;
|
||||
begin
|
||||
lCI := nil;
|
||||
CheckEquals(0, FC.Count, 'Failed on 1');
|
||||
lCI := FC.Find('Ubuntu');
|
||||
CheckTrue(lCI = nil, 'Failed on 2');
|
||||
FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
|
||||
FC.BuildFontCache;
|
||||
CheckEquals(4, FC.Count, 'Failed on 3');
|
||||
lCI := FC.Find('Ubuntu');
|
||||
CheckTrue(Assigned(lCI), 'Failed on 4');
|
||||
|
||||
{ TODO: We should try and extend this to make font paths user configure
|
||||
thus the tests could be more flexible. }
|
||||
|
||||
lCI := FC.Find('Ubuntu', True); // bold font
|
||||
CheckTrue(lCI = nil, 'Failed on 5');
|
||||
lCI := FC.Find('Ubuntu', False, True); // italic font
|
||||
CheckTrue(lCI = nil, 'Failed on 6');
|
||||
lCI := FC.Find('Ubuntu', True, True); // bold+italic font
|
||||
CheckTrue(lCI = nil, 'Failed on 7');
|
||||
|
||||
lCI := FC.Find('DejaVu Sans');
|
||||
CheckTrue(Assigned(lCI), 'Failed on 8');
|
||||
lCI := FC.Find('DejaVu Sans Bold');
|
||||
CheckTrue(lCI = nil, 'Failed on 9');
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest(TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
|
||||
RegisterTest(TFPFontCacheListTest{$ifdef fptest}.Suite{$endif});
|
||||
|
||||
end.
|
||||
|
||||
8
packages/fcl-pdf/tests/readme.txt
Normal file
8
packages/fcl-pdf/tests/readme.txt
Normal file
@ -0,0 +1,8 @@
|
||||
In order for the demos to work properly,
|
||||
the following 4 fonts must be downloaded and placed in the fonts directory:
|
||||
|
||||
DejaVuSans.ttf (and DejaVuSans.fnt)
|
||||
FreeSans.ttf
|
||||
LiberationSans-Regular.ttf
|
||||
Ubuntu-R.ttf
|
||||
|
||||
5
packages/fcl-pdf/tests/testunits.inc
Normal file
5
packages/fcl-pdf/tests/testunits.inc
Normal file
@ -0,0 +1,5 @@
|
||||
,fpparsettf_test
|
||||
,fppdf_test
|
||||
,fpttf_test
|
||||
|
||||
|
||||
94
packages/fcl-pdf/tests/unittests_console.lpi
Normal file
94
packages/fcl-pdf/tests/unittests_console.lpi
Normal file
@ -0,0 +1,94 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InIDEConfig"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="unittests_console"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="FPCUnitConsoleRunner"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="unittests_console.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="testunits.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="fpparsettf_test.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="fppdf_test.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="unittests_console"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-dfptestX"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="2">
|
||||
<Item1>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item2>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
30
packages/fcl-pdf/tests/unittests_console.lpr
Normal file
30
packages/fcl-pdf/tests/unittests_console.lpr
Normal file
@ -0,0 +1,30 @@
|
||||
program unittests_console;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes
|
||||
,consoletestrunner
|
||||
{$i testunits.inc}
|
||||
;
|
||||
|
||||
type
|
||||
|
||||
{ TLazTestRunner }
|
||||
|
||||
TMyTestRunner = class(TTestRunner)
|
||||
protected
|
||||
// override the protected methods of TTestRunner to customize its behavior
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TMyTestRunner;
|
||||
|
||||
begin
|
||||
DefaultFormat:=fPlain;
|
||||
DefaultRunAllTests:=True;
|
||||
Application := TMyTestRunner.Create(nil);
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
94
packages/fcl-pdf/tests/unittests_gui.lpi
Normal file
94
packages/fcl-pdf/tests/unittests_gui.lpi
Normal file
@ -0,0 +1,94 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InIDEConfig"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="unittests_gui"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="FPCUnitTestRunner"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="unittests_gui.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="testunits.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="fpparsettf_test.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="fppdf_test.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="unittests_gui"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-dfptestX"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EAssertionFailedError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
26
packages/fcl-pdf/tests/unittests_gui.lpr
Normal file
26
packages/fcl-pdf/tests/unittests_gui.lpr
Normal file
@ -0,0 +1,26 @@
|
||||
program unittests_gui;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes
|
||||
,Interfaces
|
||||
,Forms
|
||||
,GuiTestRunner
|
||||
{$i testunits.inc}
|
||||
;
|
||||
|
||||
|
||||
|
||||
|
||||
procedure MainProc;
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TGUITestRunner, TestRunner);
|
||||
Application.Run;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
MainProc;
|
||||
end.
|
||||
83
packages/fcl-pdf/utils/mkpdffontdef.lpi
Normal file
83
packages/fcl-pdf/utils/mkpdffontdef.lpi
Normal file
@ -0,0 +1,83 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="mkpdffontdef"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="/usr/share/fonts/truetype/msttcorefonts/arial.ttf cp1252 arial.fnt"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="mkpdffontdef.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="fpttfencodings.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="fpparsettf.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="mkpdffontdef"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
<UnitOutputDirectory Value="units/"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
36
packages/fcl-pdf/utils/mkpdffontdef.pp
Normal file
36
packages/fcl-pdf/utils/mkpdffontdef.pp
Normal file
@ -0,0 +1,36 @@
|
||||
{
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 2014 by Michael Van Canneyt
|
||||
|
||||
This small program reads a TTF font file and creates a definition in a .ini file for later use
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
|
||||
program mkpdffontdef;
|
||||
|
||||
uses sysutils, fpttfencodings, fpparsettf;
|
||||
|
||||
begin
|
||||
if (ParamCount<3) then
|
||||
begin
|
||||
writeln('Usage : ',ExtractFileName(paramstr(0)),' ttffilename encoding fntfilename');
|
||||
Halt(1);
|
||||
end;
|
||||
With TTFFileInfo.Create do
|
||||
try
|
||||
LoadFromFile(ParamStr(1));
|
||||
MakePDFFontDef(Paramstr(3),Paramstr(2),False)
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end.
|
||||
|
||||
@ -125,4 +125,5 @@
|
||||
add_zlib(ADirectory+IncludeTrailingPathDelimiter('zlib'));
|
||||
add_libenet(ADirectory+IncludeTrailingPathDelimiter('libenet'));
|
||||
add_zorba(ADirectory+IncludeTrailingPathDelimiter('zorba'));
|
||||
add_Google(ADirectory+IncludeTrailingPathDelimiter('googleapi'));
|
||||
add_Google(ADirectory+IncludeTrailingPathDelimiter('googleapi'));
|
||||
add_fcl_pdf(ADirectory+IncludeTrailingPathDelimiter('fcl-pdf'));
|
||||
@ -725,3 +725,8 @@ end;
|
||||
|
||||
{$include googleapi/fpmake.pp}
|
||||
|
||||
procedure add_fcl_pdf(const ADirectory: string);
|
||||
begin
|
||||
with Installer do
|
||||
{$include fcl-pdf/fpmake.pp}
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user