diff --git a/.gitattributes b/.gitattributes index b5b4d8ba6b..8f3302b02a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/packages/fcl-pdf/examples/metautf16.pp b/packages/fcl-pdf/examples/metautf16.pp new file mode 100644 index 0000000000..5ef3875ad3 --- /dev/null +++ b/packages/fcl-pdf/examples/metautf16.pp @@ -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. \ No newline at end of file diff --git a/packages/fcl-pdf/src/fppdf.pp b/packages/fcl-pdf/src/fppdf.pp index f7ddb19ee0..1149513b62 100644 --- a/packages/fcl-pdf/src/fppdf.pp +++ b/packages/fcl-pdf/src/fppdf.pp @@ -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);