mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 03:48:07 +02:00
# revisions: 44293,44294,44435,44877,45188,45539
git-svn-id: branches/fixes_3_2@45686 -
This commit is contained in:
marco
parent
0e01824ae1
commit
dd481d3952
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -3653,6 +3653,7 @@ 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/diamond.png -text svneol=unset#image/png
|
||||
packages/fcl-pdf/examples/metautf16.pp 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
|
||||
@ -4529,6 +4530,7 @@ packages/fcl-xml/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
packages/fcl-xml/buildfclxml.lpi svneol=native#text/plain
|
||||
packages/fcl-xml/buildfclxml.pp svneol=native#text/plain
|
||||
packages/fcl-xml/examples/htmlwithsax.lpr svneol=native#text/plain
|
||||
packages/fcl-xml/examples/reducexml.lpi svneol=native#text/plain
|
||||
packages/fcl-xml/examples/reducexml.pp svneol=native#text/plain
|
||||
packages/fcl-xml/examples/test.html svneol=native#text/html
|
||||
|
||||
@ -1174,7 +1174,7 @@ const idxhdrmagic ='T#SM';
|
||||
procedure TChmWriter.CreateIDXHDRStream;
|
||||
var i : Integer;
|
||||
begin
|
||||
if fmergefiles.count=0 then // I assume text/site properties could also trigger idxhdr
|
||||
if (fmergefiles.count=0) and not HasBinaryIndex then // I assume text/site properties could also trigger idxhdr
|
||||
exit;
|
||||
|
||||
FIDXHdrStream.setsize(4096);
|
||||
@ -2295,7 +2295,7 @@ begin
|
||||
mapstream.size:=2;
|
||||
mapstream.position:=2;
|
||||
propertystream :=TMemoryStream.Create;
|
||||
propertystream.write(NToLE(0),sizeof(4));
|
||||
propertystream.write(NToLE(0),sizeof(longint));
|
||||
// we iterate over all entries and write listingblocks directly to the stream.
|
||||
// and the first (and maybe last) level is written to blockn.
|
||||
// we can't do higher levels yet because we don't know how many listblocks we get
|
||||
@ -2442,6 +2442,19 @@ begin
|
||||
hdr.unknown4 :=NToLE(0); // unknown 0
|
||||
hdr.unknown5 :=NToLE(0); // unknown 0
|
||||
|
||||
if totalentries<>0 then
|
||||
begin
|
||||
// If there are no links of this type in the CHM then this will be a zero DWORD. Othewise it contains the following DWORDs: 0, 0, 0, 0xC, 1, 1, 0, 0. AFAICS this file is pretty much useless.
|
||||
// we already have written the first 0 dword
|
||||
propertystream.write(NToLE(0),sizeof(longint));
|
||||
propertystream.write(NToLE(0),sizeof(longint));
|
||||
propertystream.write(NToLE($C),sizeof(longint));
|
||||
propertystream.write(NToLE(1),sizeof(longint));
|
||||
propertystream.write(NToLE(1),sizeof(longint));
|
||||
propertystream.write(NToLE(0),sizeof(longint));
|
||||
propertystream.write(NToLE(0),sizeof(longint));
|
||||
end;
|
||||
|
||||
IndexStream.Position:=0;
|
||||
IndexStream.write(hdr,sizeof(hdr));
|
||||
{$ifdef binindex}
|
||||
|
||||
@ -101,17 +101,17 @@ type
|
||||
);
|
||||
|
||||
// Extract program version information in 1 call.
|
||||
Function GetProgramVersion (Var Version : TVersionQuad) : Boolean;
|
||||
Function GetProgramVersion (Var Version : TProgramVersion) : Boolean;
|
||||
Function GetProgramVersion (Out Version : TVersionQuad) : Boolean;
|
||||
Function GetProgramVersion (Out Version : TProgramVersion) : Boolean;
|
||||
// Compare 2 versions
|
||||
Function CompareVersionQuads(Quad1,Quad2 : TVersionQuad) : TVersionCompare;
|
||||
Function CompareProgramVersion(Version1,Version2 : TProgramVersion) : TVersionCompare;
|
||||
// Convert version quad to string
|
||||
Function VersionQuadToStr(Const Quad : TVersionQuad) : String;
|
||||
Function ProgramversionToStr(Const Version : TProgramVersion) : String;
|
||||
Function ProgramVersionToStr(Const Version : TProgramVersion) : String;
|
||||
// Try to convert string to version quad.
|
||||
Function TryStrToVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
|
||||
Function TryStrToProgramVersion(S : String; Var Version : TProgramVersion) : Boolean;
|
||||
Function TryStrToVersionQuad(S : String; Out Quad : TVersionQuad) : Boolean;
|
||||
Function TryStrToProgramVersion(S : String; Out Version : TProgramVersion) : Boolean;
|
||||
// Convert string to version quad, raise exception if invalid string.
|
||||
Function StrToVersionQuad(Const S : String) : TVersionQuad;
|
||||
Function StrToProgramVersion(Const S : String ): TProgramVersion;
|
||||
@ -183,7 +183,7 @@ end;
|
||||
procedure TVersionInfo.Load(Const AFileName : String);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
I : LongWord;
|
||||
|
||||
begin
|
||||
FreeResources;
|
||||
@ -265,8 +265,7 @@ procedure TFileVersionInfo.ReadFileInfo;
|
||||
Var
|
||||
VI : TVersionInfo;
|
||||
ST : TVersionStringTable;
|
||||
TI,I,J : Integer;
|
||||
S: String;
|
||||
TI,I : Integer;
|
||||
|
||||
begin
|
||||
FEnabled:=True;
|
||||
@ -304,9 +303,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
ST:=VI.StringFileInfo.Items[Ti];
|
||||
for J:=0 to ST.Count-1 do
|
||||
if (FFilter.Count=0) or (FFilter.IndexOf(ST.Keys[j])<>-1) then
|
||||
FVersionStrings.Add(ST.Keys[j]+'='+ST.Values[j]);
|
||||
for i:=0 to ST.Count-1 do
|
||||
if (FFilter.Count=0) or (FFilter.IndexOf(ST.Keys[i])<>-1) then
|
||||
FVersionStrings.Add(ST.Keys[i]+'='+ST.Values[i]);
|
||||
finally
|
||||
FreeAndNil(VI);
|
||||
end;
|
||||
@ -347,7 +346,7 @@ end;
|
||||
|
||||
{ Convenience function }
|
||||
|
||||
Function GetProgramVersion (Var Version : TVersionQuad) : Boolean;
|
||||
Function GetProgramVersion (Out Version : TVersionQuad) : Boolean;
|
||||
|
||||
Var
|
||||
VI : TVersionInfo;
|
||||
@ -370,7 +369,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetProgramVersion (Var Version : TProgramVersion) : Boolean;
|
||||
Function GetProgramVersion (Out Version : TProgramVersion) : Boolean;
|
||||
Var
|
||||
VQ : TVersionQuad;
|
||||
begin
|
||||
@ -435,7 +434,7 @@ begin
|
||||
Result:=Format('%d.%d.%d.%d',[Version.Major,Version.Minor,Version.Revision,Version.Build]);
|
||||
end;
|
||||
|
||||
Function TryStrToProgramVersion(S : String; Var Version : TProgramVersion) : Boolean;
|
||||
Function TryStrToProgramVersion(S : String; Out Version : TProgramVersion) : Boolean;
|
||||
|
||||
Var
|
||||
Q : TVersionQuad;
|
||||
@ -445,7 +444,7 @@ begin
|
||||
Version:=Q;
|
||||
end;
|
||||
|
||||
Function TryStrToVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
|
||||
Function TryStrToVersionQuad(S : String; Out Quad : TVersionQuad) : Boolean;
|
||||
|
||||
Var
|
||||
I,P,Dots,Q : Integer;
|
||||
@ -488,12 +487,12 @@ end;
|
||||
Function NewerVersion(V1,V2 : TProgramVersion) : Boolean;
|
||||
|
||||
Var
|
||||
Q1,Q2 : TversionQuad;
|
||||
Q1,Q2 : TVersionQuad;
|
||||
|
||||
begin
|
||||
Q1:=V1;
|
||||
Q2:=V2;
|
||||
Result:=Newerversion(Q1,Q2);
|
||||
Result:=NewerVersion(Q1,Q2);
|
||||
end;
|
||||
|
||||
Function NewerVersion(Q1,Q2 : TVersionQuad) : Boolean;
|
||||
|
||||
@ -664,22 +664,22 @@ type
|
||||
|
||||
const
|
||||
HtmlColorNameToFPColorMap: array[THtmlColorName] of TFPColor = (
|
||||
(red: $ff; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnWhite
|
||||
(red: $c0; green: $c0; blue: $c0; alpha: alphaOpaque), //hcnSilver
|
||||
(red: $80; green: $80; blue: $80; alpha: alphaOpaque), //hcnGray
|
||||
(red: $00; green: $00; blue: $00; alpha: alphaOpaque), //hcnBlack
|
||||
(red: $ff; green: $00; blue: $00; alpha: alphaOpaque), //hcnRed
|
||||
(red: $80; green: $00; blue: $00; alpha: alphaOpaque), //hcnMaroon
|
||||
(red: $ff; green: $ff; blue: $00; alpha: alphaOpaque), //hcnYellow
|
||||
(red: $80; green: $80; blue: $00; alpha: alphaOpaque), //hcnOlive
|
||||
(red: $00; green: $ff; blue: $00; alpha: alphaOpaque), //hcnLime
|
||||
(red: $00; green: $80; blue: $00; alpha: alphaOpaque), //hcnGreen
|
||||
(red: $00; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnAqua
|
||||
(red: $00; green: $80; blue: $80; alpha: alphaOpaque), //hcnTeal
|
||||
(red: $00; green: $00; blue: $ff; alpha: alphaOpaque), //hcnBlue
|
||||
(red: $00; green: $00; blue: $80; alpha: alphaOpaque), //hcnNavy
|
||||
(red: $ff; green: $00; blue: $ff; alpha: alphaOpaque), //hcnFuchsia
|
||||
(red: $80; green: $00; blue: $80; alpha: alphaOpaque) //hcnPurple
|
||||
(red: $ff or $ff shl 8; green: $ff or $ff shl 8; blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnWhite
|
||||
(red: $c0 or $c0 shl 8; green: $c0 or $c0 shl 8; blue: $c0 or $c0 shl 8; alpha: alphaOpaque), //hcnSilver
|
||||
(red: $80 or $80 shl 8; green: $80 or $80 shl 8; blue: $80 or $80 shl 8; alpha: alphaOpaque), //hcnGray
|
||||
(red: $00; green: $00; blue: $00; alpha: alphaOpaque), //hcnBlack
|
||||
(red: $ff or $ff shl 8; green: $00; blue: $00; alpha: alphaOpaque), //hcnRed
|
||||
(red: $80 or $80 shl 8; green: $00; blue: $00; alpha: alphaOpaque), //hcnMaroon
|
||||
(red: $ff or $ff shl 8; green: $ff or $ff shl 8; blue: $00; alpha: alphaOpaque), //hcnYellow
|
||||
(red: $80 or $80 shl 8; green: $80 or $80 shl 8; blue: $00; alpha: alphaOpaque), //hcnOlive
|
||||
(red: $00; green: $ff or $ff shl 8; blue: $00; alpha: alphaOpaque), //hcnLime
|
||||
(red: $00; green: $80 or $80 shl 8; blue: $00; alpha: alphaOpaque), //hcnGreen
|
||||
(red: $00; green: $ff or $ff shl 8; blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnAqua
|
||||
(red: $00; green: $80 or $80 shl 8; blue: $80 or $80 shl 8; alpha: alphaOpaque), //hcnTeal
|
||||
(red: $00; green: $00; blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnBlue
|
||||
(red: $00; green: $00; blue: $80 or $80 shl 8; alpha: alphaOpaque), //hcnNavy
|
||||
(red: $ff or $ff shl 8; green: $00; blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnFuchsia
|
||||
(red: $80 or $80 shl 8; green: $00; blue: $80 or $80 shl 8; alpha: alphaOpaque) //hcnPurple
|
||||
);
|
||||
|
||||
function TryStrToHtmlColorName(const S: String; out AName: THtmlColorName): Boolean;
|
||||
|
||||
45
packages/fcl-pdf/examples/metautf16.pp
Normal file
45
packages/fcl-pdf/examples/metautf16.pp
Normal file
@ -0,0 +1,45 @@
|
||||
program metautf16;
|
||||
|
||||
{$codepage utf-8}
|
||||
|
||||
uses sysutils,fpPDF;
|
||||
|
||||
var
|
||||
D:TpdfDocument;
|
||||
S:TPdfSection;
|
||||
P:TPdfPage;
|
||||
|
||||
begin
|
||||
D:=TpdfDocument.Create(nil);
|
||||
try
|
||||
D.Infos.Title := 'Урывак з паэмы "Новая Зямля"';
|
||||
D.Infos.Author := 'Якуб Колас';
|
||||
D.Infos.Producer := 'fcl-pdf';
|
||||
D.Infos.ApplicationName := 'нейкі тэст';
|
||||
D.Infos.CreationDate := Now;
|
||||
D.Infos.KeyWords:='fcl-pdf report';
|
||||
|
||||
D.Options := [poPageOriginAtTop,poSubsetFont,poCompressFonts,poCompressImages,poUseImageTransparency,poUTF16Info];
|
||||
|
||||
D.StartDocument;
|
||||
D.AddFont('fonts/FreeSans.ttf','FreeSans');
|
||||
|
||||
|
||||
S:=D.Sections.AddSection;
|
||||
|
||||
P:=D.Pages.AddPage;
|
||||
P.PaperType := ptA4;
|
||||
P.UnitOfMeasure := uomPixels;
|
||||
P.Orientation:=ppoPortrait;
|
||||
S.AddPage(P);
|
||||
|
||||
P.SetFont(0,10);
|
||||
P.WriteText(100,100,'Мой родны кут,');
|
||||
P.WriteText(100,150,'Як ты мне мілы');
|
||||
P.WriteText(100,200,'Забыць цябе');
|
||||
P.WriteText(100,250,'Не маю сілы');
|
||||
finally
|
||||
D.SaveToFile('test.pdf');
|
||||
D.Free;
|
||||
end;
|
||||
end.
|
||||
@ -70,7 +70,7 @@ type
|
||||
TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels);
|
||||
|
||||
TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts,
|
||||
poPageOriginAtTop, poSubsetFont, poMetadataEntry, poNoTrailerID, poUseImageTransparency);
|
||||
poPageOriginAtTop, poSubsetFont, poMetadataEntry, poNoTrailerID, poUseImageTransparency,poUTF16info);
|
||||
TPDFOptions = set of TPDFOption;
|
||||
|
||||
EPDF = Class(Exception);
|
||||
@ -282,6 +282,16 @@ type
|
||||
property Value: AnsiString read FValue;
|
||||
end;
|
||||
|
||||
TPDFUTF16String = class(TPDFAbstractString)
|
||||
private
|
||||
FValue: UnicodeString;
|
||||
protected
|
||||
procedure Write(const AStream: TStream); override;
|
||||
public
|
||||
constructor Create(Const ADocument : TPDFDocument; const AValue: UnicodeString; const AFontIndex : Integer); overload;
|
||||
property Value: UnicodeString read FValue;
|
||||
end;
|
||||
|
||||
{ TPDFRawHexString }
|
||||
|
||||
TPDFRawHexString = class(TPDFDocumentObject)
|
||||
@ -424,6 +434,17 @@ type
|
||||
property Text: TPDFUTF8String read FString;
|
||||
end;
|
||||
|
||||
TPDFUTF16Text = class(TPDFBaseText)
|
||||
private
|
||||
FString: TPDFUTF16String;
|
||||
protected
|
||||
procedure Write(const AStream: TStream); override;
|
||||
public
|
||||
constructor Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UnicodeString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); overload;
|
||||
destructor Destroy; override;
|
||||
property Text: TPDFUTF16String read FString;
|
||||
end;
|
||||
|
||||
|
||||
TPDFLineSegment = class(TPDFDocumentObject)
|
||||
private
|
||||
@ -601,6 +622,7 @@ type
|
||||
procedure AddInteger(const AKey : String; AInteger : Integer);
|
||||
procedure AddReference(const AKey : String; AReference : Integer);
|
||||
procedure AddString(const AKey, AString : String);
|
||||
procedure AddString(const AKey:string;const AString : UnicodeString);
|
||||
function IndexOfKey(const AValue: string): integer;
|
||||
procedure Write(const AStream: TStream); override;
|
||||
procedure WriteDictionary(const AObject: integer; const AStream: TStream);
|
||||
@ -1069,7 +1091,7 @@ type
|
||||
procedure CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary); virtual;
|
||||
function CreateContentsEntry(const APageNum: integer): integer;virtual;
|
||||
function CreateCatalogEntry: integer;virtual;
|
||||
procedure CreateInfoEntry;virtual;
|
||||
procedure CreateInfoEntry(UseUTF16 : Boolean);virtual;
|
||||
procedure CreateMetadataEntry;virtual;
|
||||
procedure CreateTrailerID;virtual;
|
||||
procedure CreatePreferencesEntry;virtual;
|
||||
@ -1095,6 +1117,7 @@ type
|
||||
function CreateCIDToGIDMap(const AFontNum: integer): integer; virtual;
|
||||
procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
|
||||
Function CreateString(Const AValue : String) : TPDFString;
|
||||
Function CreateUTF16String(Const AValue : UnicodeString; const AFontIndex: integer) : TPDFUTF16String;
|
||||
Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
|
||||
Function CreateGlobalXRef: TPDFXRef;
|
||||
Function AddGlobalXRef(AXRef : TPDFXRef) : Integer;
|
||||
@ -1117,6 +1140,7 @@ type
|
||||
Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
|
||||
Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFText; overload;
|
||||
Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF8Text; overload;
|
||||
Function CreateText(X,Y : TPDFFloat; AText : UnicodeString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF16Text; overload;
|
||||
Function CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean) : TPDFRectangle;
|
||||
function CreateRoundedRectangle(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRoundedRectangle;
|
||||
Function CreateColor(AColor : TARGBColor; AStroke : Boolean) : TPDFColor;
|
||||
@ -3431,6 +3455,54 @@ begin
|
||||
FValue := InsertEscape(FValue);
|
||||
end;
|
||||
|
||||
|
||||
{ TPDFUTF16String }
|
||||
|
||||
constructor TPDFUTF16String.Create(Const ADocument : TPDFDocument; const AValue: Unicodestring; const AFontIndex : Integer);
|
||||
begin
|
||||
inherited Create(ADocument);
|
||||
FValue := AValue;
|
||||
FFontIndex:=aFontIndex;
|
||||
end;
|
||||
|
||||
function oct_str(b:byte):string;
|
||||
begin
|
||||
Result:='';
|
||||
repeat
|
||||
Result:=IntToStr(b and $7)+Result;
|
||||
b:=b shr 3;
|
||||
until b=0;
|
||||
end;
|
||||
|
||||
procedure TPDFUTF16String.Write(const AStream: TStream);
|
||||
var
|
||||
i:integer;
|
||||
us:utf8string;
|
||||
s:ansistring;
|
||||
wv:word;
|
||||
begin
|
||||
us := Utf8Encode(FValue);
|
||||
if (length(us)<>length(fValue)) then // quote
|
||||
begin
|
||||
s:='\376\377'; // UTF-16BE BOM
|
||||
for i:=1 to length(fValue) do
|
||||
begin
|
||||
wv:=word(fValue[i]);
|
||||
s:=s+'\'+oct_str(hi(wv));
|
||||
s:=s+'\'+oct_str(lo(wv));
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
if (Pos('(', FValue) > 0) or (Pos(')', FValue) > 0) or (Pos('\', FValue) > 0) then
|
||||
s := InsertEscape(FValue)
|
||||
else
|
||||
s:=fValue;
|
||||
end;
|
||||
WriteString('('+s+')', AStream);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TPDFUTF8String }
|
||||
|
||||
function TPDFUTF8String.RemapedText: AnsiString;
|
||||
@ -3858,6 +3930,101 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TPDFUTF16Text }
|
||||
|
||||
procedure TPDFUTF16Text.Write(const AStream: TStream);
|
||||
var
|
||||
t1, t2, t3: string;
|
||||
rad: single;
|
||||
lFC: TFPFontCacheItem;
|
||||
lWidth: single;
|
||||
lTextWidthInMM: single;
|
||||
lHeight: single;
|
||||
lTextHeightInMM: single;
|
||||
lColor: string;
|
||||
lLineWidth: string;
|
||||
lDescender: single;
|
||||
v : UTF8String;
|
||||
|
||||
begin
|
||||
inherited Write(AStream);
|
||||
WriteString('BT'+CRLF, AStream);
|
||||
if Degrees <> 0.0 then
|
||||
begin
|
||||
rad := DegToRad(-Degrees);
|
||||
t1 := FloatStr(Cos(rad));
|
||||
t2 := FloatStr(-Sin(rad));
|
||||
t3 := FloatStr(Sin(rad));
|
||||
WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
|
||||
end;
|
||||
FString.Write(AStream);
|
||||
WriteString(' Tj'+CRLF, AStream);
|
||||
WriteString('ET'+CRLF, AStream);
|
||||
|
||||
if (not Underline) and (not StrikeThrough) then
|
||||
Exit;
|
||||
|
||||
// implement Underline and Strikethrough here
|
||||
lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
|
||||
if not Assigned(lFC) then
|
||||
Exit; // we can't do anything further
|
||||
|
||||
// result is in Font Units
|
||||
v:=UTF8Encode(FString.Value);
|
||||
lWidth := lFC.TextWidth(v, Font.PointSize);
|
||||
lHeight := lFC.TextHeight(v, Font.PointSize, lDescender);
|
||||
{ convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
|
||||
lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
|
||||
lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
|
||||
|
||||
if Degrees <> 0.0 then
|
||||
// angled text
|
||||
WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
|
||||
else
|
||||
// horizontal text
|
||||
WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
|
||||
|
||||
{ set up a pen width and stroke color }
|
||||
lColor := TPDFColor.Command(True, Color);
|
||||
lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
|
||||
WriteString(lLineWidth + lColor + CRLF, AStream);
|
||||
|
||||
{ line segment is relative to matrix translation coordinate, set above }
|
||||
if Underline then
|
||||
WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
|
||||
if StrikeThrough then
|
||||
WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
|
||||
|
||||
{ restore graphics state to before the translation matrix adjustment }
|
||||
WriteString('Q' + CRLF, AStream);
|
||||
|
||||
end;
|
||||
|
||||
constructor TPDFUTF16Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UnicodeString;
|
||||
const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
|
||||
begin
|
||||
inherited Create(ADocument);
|
||||
X := AX;
|
||||
Y := AY;
|
||||
Font := AFont;
|
||||
Degrees := ADegrees;
|
||||
Underline := AUnderline;
|
||||
if Assigned(AFont) and Assigned(AFont.Page) then
|
||||
Color := AFont.Page.FLastFontColor;
|
||||
StrikeThrough := AStrikeThrough;
|
||||
FString := ADocument.CreateUTF16String(AText, AFont.FontIndex);
|
||||
end;
|
||||
|
||||
destructor TPDFUTF16Text.Destroy;
|
||||
begin
|
||||
FreeAndNil(FString);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TPDFLineSegment }
|
||||
|
||||
procedure TPDFLineSegment.Write(const AStream: TStream);
|
||||
@ -4202,6 +4369,11 @@ begin
|
||||
AddElement(AKey,Document.CreateString(AString));
|
||||
end;
|
||||
|
||||
procedure TPDFDictionary.AddString(const AKey:string;const AString: UnicodeString);
|
||||
begin
|
||||
AddElement(AKey,Document.CreateUTF16String(AString,-1));
|
||||
end;
|
||||
|
||||
function TPDFDictionary.IndexOfKey(const AValue: string): integer;
|
||||
var
|
||||
i: integer;
|
||||
@ -4578,7 +4750,7 @@ begin
|
||||
FInfos.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TPDFDocument.SetOptions(AValue: TPDFOptions);
|
||||
procedure TPDFDocument.SetOptions(aValue: TPDFOptions);
|
||||
begin
|
||||
if FOptions=AValue then Exit;
|
||||
if (poNoEmbeddedFonts in aValue) then
|
||||
@ -4772,26 +4944,31 @@ begin
|
||||
Result:=GlobalXRefCount-1;
|
||||
end;
|
||||
|
||||
procedure TPDFDocument.CreateInfoEntry;
|
||||
procedure TPDFDocument.CreateInfoEntry(UseUTF16 : Boolean);
|
||||
|
||||
var
|
||||
IDict: TPDFDictionary;
|
||||
|
||||
Procedure DoEntry(aName, aValue : String; NoUnicode: boolean = false);
|
||||
|
||||
begin
|
||||
if aValue='' then exit;
|
||||
if UseUTF16 and not NoUnicode then
|
||||
IDict.AddString(aName,utf8decode(aValue))
|
||||
else
|
||||
IDict.AddString(aName,aValue);
|
||||
end;
|
||||
|
||||
begin
|
||||
IDict:=CreateGlobalXRef.Dict;
|
||||
Trailer.AddReference('Info', GLobalXRefCount-1);
|
||||
(Trailer.ValueByName('Size') as TPDFInteger).Value:=GLobalXRefCount;
|
||||
if Infos.Title <> '' then
|
||||
IDict.AddString('Title',Infos.Title);
|
||||
if Infos.Author <> '' then
|
||||
IDict.AddString('Author',Infos.Author);
|
||||
if Infos.ApplicationName <> '' then
|
||||
IDict.AddString('Creator',Infos.ApplicationName);
|
||||
IDict.AddString('Producer',Infos.Producer);
|
||||
if Infos.CreationDate <> 0 then
|
||||
IDict.AddString('CreationDate',DateToPdfDate(Infos.CreationDate));
|
||||
if Infos.Keywords <> '' then
|
||||
IDict.AddString('Keywords', Infos.Keywords);
|
||||
DoEntry('Title',Infos.Title);
|
||||
DoEntry('Author',Infos.Author);
|
||||
DoEntry('Creator',Infos.ApplicationName);
|
||||
DoEntry('Producer',Infos.Producer);
|
||||
DoEntry('CreationDate',DateToPdfDate(Infos.CreationDate),True);
|
||||
DoEntry('Keywords',Infos.Keywords);
|
||||
end;
|
||||
|
||||
procedure TPDFDocument.CreateMetadataEntry;
|
||||
@ -5530,7 +5707,7 @@ begin
|
||||
CreateRefTable;
|
||||
CreateTrailer;
|
||||
FCatalogue:=CreateCatalogEntry;
|
||||
CreateInfoEntry;
|
||||
CreateInfoEntry(poUTF16Info in Options);
|
||||
if poMetadataEntry in Options then
|
||||
CreateMetadataEntry;
|
||||
if not (poNoTrailerID in Options) then
|
||||
@ -5840,6 +6017,12 @@ begin
|
||||
Result := TPDFUTF8Text.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
|
||||
end;
|
||||
|
||||
function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UnicodeString; const AFont: TPDFEmbeddedFont;
|
||||
const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean): TPDFUTF16Text;
|
||||
begin
|
||||
Result := TPDFUTF16Text.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
|
||||
end;
|
||||
|
||||
function TPDFDocument.CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRectangle;
|
||||
begin
|
||||
Result:=TPDFRectangle.Create(Self,X,Y,W,H,ALineWidth,AFill, AStroke);
|
||||
@ -5876,6 +6059,11 @@ begin
|
||||
Result:=TPDFString.Create(Self,AValue);
|
||||
end;
|
||||
|
||||
function TPDFDocument.CreateUTF16String(const AValue: UnicodeString; const AFontIndex: integer): TPDFUTF16String;
|
||||
begin
|
||||
Result:=TPDFUTF16String.Create(Self,AValue,aFontIndex);
|
||||
end;
|
||||
|
||||
function TPDFDocument.CreateUTF8String(const AValue: UTF8String; const AFontIndex: integer): TPDFUTF8String;
|
||||
begin
|
||||
Result := TPDFUTF8String.Create(self, AValue, AFontIndex);
|
||||
|
||||
117
packages/fcl-xml/examples/htmlwithsax.lpr
Normal file
117
packages/fcl-xml/examples/htmlwithsax.lpr
Normal file
@ -0,0 +1,117 @@
|
||||
program htmlwithsax;
|
||||
|
||||
uses sysutils, classes, sax,sax_html, custapp;
|
||||
|
||||
Type
|
||||
|
||||
{ TMyApp }
|
||||
|
||||
TMyApp = Class(TCustomApplication)
|
||||
Private
|
||||
Indent : string;
|
||||
procedure DoEndDocument(Sender: TObject);
|
||||
procedure DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
|
||||
procedure DoFile(const aFileName: String);
|
||||
procedure DoStartDocument(Sender: TObject);
|
||||
procedure DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
|
||||
Protected
|
||||
Procedure DoRun; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TMyApp }
|
||||
|
||||
procedure TMyApp.DoFile(const aFileName : String);
|
||||
|
||||
var
|
||||
F : TFileStream;
|
||||
MyReader : THTMLReader;
|
||||
|
||||
begin
|
||||
MyReader:=Nil;
|
||||
F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
MyReader:=THTMLReader.Create;
|
||||
MyReader.OnStartDocument:=@DoStartDocument;
|
||||
MyReader.OnStartElement:=@DoStartElement;
|
||||
MyReader.OnEndElement:=@DoEndElement;
|
||||
MyReader.OnEndDocument:=@DoEndDocument;
|
||||
MyReader.ParseStream(F);
|
||||
finally
|
||||
FreeAndNil(MyReader);
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMyApp.DoRun;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
StopOnException:=True;
|
||||
Terminate;
|
||||
if ParamCount<1 then
|
||||
begin
|
||||
Writeln('Usage : ',ExtractFileName(ExeName),' <htmlfile1> [htmlfile2 [htmlfile3]]');
|
||||
Exit;
|
||||
end;
|
||||
for I:=1 to ParamCount do
|
||||
DoFile(Params[i]);
|
||||
end;
|
||||
|
||||
procedure TMyApp.DoStartDocument(Sender: TObject);
|
||||
begin
|
||||
Writeln('Document start');
|
||||
Indent:='';
|
||||
end;
|
||||
|
||||
procedure TMyApp.DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
|
||||
begin
|
||||
Indent:=Copy(Indent,1,Length(Indent)-2);
|
||||
end;
|
||||
|
||||
procedure TMyApp.DoEndDocument(Sender: TObject);
|
||||
begin
|
||||
Writeln('Document end');
|
||||
Indent:='';
|
||||
end;
|
||||
|
||||
procedure TMyApp.DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
S : unicodestring;
|
||||
|
||||
begin
|
||||
S:='';
|
||||
if Assigned(Atts) then
|
||||
for I:=0 to Atts.Length-1 do
|
||||
begin
|
||||
if S<>'' then S:=S+', ';
|
||||
S:=S+Atts.LocalNames[i];
|
||||
end;
|
||||
Write(Indent,'Tag: <',LocalName,'>');
|
||||
if NameSpaceURI<>'' then
|
||||
Write(' xmlns: ',NameSpaceURI);
|
||||
if QName<>'' then
|
||||
Write(', full tag: ',QName);
|
||||
If S<>'' then
|
||||
Write(', attrs: ',S);
|
||||
Writeln;
|
||||
Indent:=Indent+' ';
|
||||
end;
|
||||
|
||||
|
||||
|
||||
begin
|
||||
With TMyApp.Create(Nil) do
|
||||
try
|
||||
Initialize;
|
||||
Run;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1 +1 @@
|
||||
'2020-03-20 rev 44315'
|
||||
'2020-06-20 rev 45662'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user