mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 05:43:51 +02:00
* Added ability to use UTF16, expanded patch from Anton Kavalenka
git-svn-id: trunk@44435 -
This commit is contained in:
michael
parent
923c891b37
commit
13986a1f8f
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -3794,6 +3794,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
|
||||
|
||||
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);
|
||||
@ -273,6 +273,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)
|
||||
@ -415,6 +425,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
|
||||
@ -592,6 +613,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);
|
||||
@ -1050,7 +1072,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;
|
||||
@ -1076,6 +1098,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;
|
||||
@ -1098,6 +1121,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;
|
||||
@ -3366,6 +3390,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;
|
||||
@ -3793,6 +3865,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);
|
||||
@ -4137,6 +4304,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;
|
||||
@ -4513,7 +4685,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
|
||||
@ -4707,26 +4879,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;
|
||||
@ -5465,7 +5642,7 @@ begin
|
||||
CreateRefTable;
|
||||
CreateTrailer;
|
||||
FCatalogue:=CreateCatalogEntry;
|
||||
CreateInfoEntry;
|
||||
CreateInfoEntry(poUTF16Info in Options);
|
||||
if poMetadataEntry in Options then
|
||||
CreateMetadataEntry;
|
||||
if not (poNoTrailerID in Options) then
|
||||
@ -5775,6 +5952,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);
|
||||
@ -5811,6 +5994,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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user