diff --git a/packages/fcl-pdf/src/fpparsettf.pp b/packages/fcl-pdf/src/fpparsettf.pp index 49a0ae6982..38fba3c04f 100644 --- a/packages/fcl-pdf/src/fpparsettf.pp +++ b/packages/fcl-pdf/src/fpparsettf.pp @@ -31,26 +31,6 @@ type // Tables recognized in this unit. TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost); - TPDFFontDefinition = Record - FontType : String; - FontName : String; - Ascender : Integer; - Descender : Integer; - CapHeight : Integer; - Flags : Integer; - BBox : Array[0..3] of Integer; - ItalicAngle : Integer; - StemV : Integer; - MissingWidth : integer; - FontUp : Integer; - FontUt : Integer; - Encoding : String; - FontFile : String; - Diffs : String; - CharWidths : String; - OriginalSize : integer; - end; - TSmallintArray = Packed Array of Int16; TWordArray = Packed Array of UInt16; @@ -253,10 +233,11 @@ Type FWidths: TLongHorMetrics; // hmtx data // Needed to create PDF font def. FOriginalSize : Cardinal; - MissingWidth: Integer; + FMissingWidth: Integer; FNameEntries: TNameEntries; { This only applies to TFixedVersionRec values. } function FixMinorVersion(const AMinor: word): word; + function GetMissingWidth: integer; Protected // Stream reading functions. Function IsNativeData : Boolean; virtual; @@ -273,23 +254,10 @@ Type procedure ParseOS2(AStream : TStream); virtual; procedure ParsePost(AStream : TStream); virtual; // Make differences for postscript fonts - procedure PrepareEncoding(Const AEnCoding : String); + procedure PrepareEncoding(Const AEncoding : String); function MakeDifferences: String; virtual; // Utility function to convert FShort to natural units Function ToNatural(AUnit: Smallint) : Smallint; - // Some utility functions to create the PDF font definition - Procedure MakePDFFontDefinitionFile(Const FontFile,Section,AEncoding: string); virtual; - Function Flags : Integer; - Function Bold: Boolean; - Function StemV: SmallInt; - Function Embeddable : Boolean; - Function Ascender: SmallInt; - Function Descender: SmallInt; - { Also know as the linegap. "Leading" is the gap between two lines. } - Function Leading: SmallInt; - Function CapHeight: SmallInt; - { Returns the glyph advance width, based on the AIndex (glyph index) value. The result is in font units. } - function GetAdvanceWidth(AIndex: word): word; public Chars: TWordArray; CharWidth: array[0..255] of SmallInt; @@ -304,17 +272,32 @@ Type // Load a TTF file from file or stream. Procedure LoadFromFile(const AFileName : String); Procedure LoadFromStream(AStream: TStream); virtual; - // Checks if Embedded is allowed, and also prepares CharWidths array + // Checks if Embedded is allowed, and also prepares CharWidths array. NOTE: this is possibly not needed any more. procedure PrepareFontDefinition(const Encoding:string; Embed: Boolean); - // Fill record with PDF Font definition data. - Procedure FillPDFFontDefinition(Out ADef: TPDFFontDefinition; Const AFontFile,AEncoding : String); - // Write Font Definition data to a file named FontFile. - procedure MakePDFFontDef(const FontFile: string; const Encoding: string; Embed: Boolean); + // The following are only valid after the file was succesfully read. - // Font file header info. + + Function Flags : Integer; + Function Bold: Boolean; + Function StemV: SmallInt; + Function Embeddable : Boolean; + Function Ascender: SmallInt; + Function Descender: SmallInt; + { Also know as the linegap. "Leading" is the gap between two lines. } + Function Leading: SmallInt; + Function CapHeight: SmallInt; + { Returns the glyph advance width, based on the AIndex (glyph index) value. The result is in font units. } + function GetAdvanceWidth(AIndex: word): word; + function ItalicAngle: LongWord; + { max glyph bounding box values - as space separated values } + function BBox: string; + property MissingWidth: Integer read GetMissingWidth; + { original font file size } + property OriginalSize: Cardinal read FOriginalSize; + property Filename: string read FFilename; Property Directory : TTableDirectory Read FTableDir; Property Tables : TTableDirectoryEntries Read FTables; - // The various tables as present in the font file. + Property Head : THead Read FHead; Property HHead : THHead Read FHHead; property CmapH : TCMapHeader Read FCmapH; @@ -338,12 +321,9 @@ type // Convert string to known table type Function GetTableType(Const AName : String) : TTTFTableType; -// Utility functions for text encoding conversions -function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt; Src: PChar; SrcCharCount: SizeUInt; - Options: TConvertOptions; out ActualWideCharCount: SizeUInt): TConvertResult; -function UTF8ToUTF16(const P: PChar; ByteCnt: SizeUInt): UnicodeString; -function UTF8ToUTF16(const S: AnsiString): UnicodeString; function StrToUTF16Hex(const AValue: UnicodeString; AIncludeBOM: boolean = True): AnsiString; +{ To overcome the annoying compiler hint: "Local variable does not seem to be initialized" } +procedure FillMem(Dest: pointer; Size: longint; Data: Byte ); Const @@ -373,8 +353,6 @@ Const implementation -uses - inifiles; resourcestring rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding'; @@ -386,222 +364,6 @@ begin Result:=Pred(Result); end; -{------------------------------------------------------------------------------ - Name: ConvertUTF8ToUTF16 - Params: Dest - Pointer to destination string - DestWideCharCount - Wide char count allocated in destination string - Src - Pointer to source string - SrcCharCount - Char count allocated in source string - Options - Conversion options, if none is set, both - invalid and unfinished source chars are skipped - - toInvalidCharError - Stop on invalid source char and report - error - toInvalidCharToSymbol - Replace invalid source chars with '?' - toUnfinishedCharError - Stop on unfinished source char and - report error - toUnfinishedCharToSymbol - Replace unfinished source char with '?' - - ActualWideCharCount - Actual wide char count converted from source - string to destination string - Returns: - trNoError - The string was successfully converted without - any error - trNullSrc - Pointer to source string is nil - trNullDest - Pointer to destination string is nil - trDestExhausted - Destination buffer size is not big enough to hold - converted string - trInvalidChar - Invalid source char has occured - trUnfinishedChar - Unfinished source char has occured - - Converts the specified UTF-8 encoded string to UTF-16 encoded (system endian) - ------------------------------------------------------------------------------} -function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt; - Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions; - out ActualWideCharCount: SizeUInt): TConvertResult; -var - DestI, SrcI: SizeUInt; - B1, B2, B3, B4: Byte; - W: Word; - C: Cardinal; - - function UnfinishedCharError: Boolean; - begin - if toUnfinishedCharToSymbol in Options then - begin - Dest[DestI] := System.WideChar('?'); - Inc(DestI); - Result := False; - end - else - if toUnfinishedCharError in Options then - begin - ConvertUTF8ToUTF16 := trUnfinishedChar; - Result := True; - end - else Result := False; - end; - - function InvalidCharError(Count: SizeUInt): Boolean; inline; - begin - if not (toInvalidCharError in Options) then - begin - if toInvalidCharToSymbol in Options then - begin - Dest[DestI] := System.WideChar('?'); - Inc(DestI); - end; - - Dec(SrcI, Count); - - // skip trailing UTF-8 char bytes - while (Count > 0) do - begin - if (Byte(Src[SrcI]) and %11000000) <> %10000000 then Break; - Inc(SrcI); - Dec(Count); - end; - - Result := False; - end - else - if toInvalidCharError in Options then - begin - ConvertUTF8ToUTF16 := trUnfinishedChar; - Result := True; - end; - end; - -begin - ActualWideCharCount := 0; - - if not Assigned(Src) then - begin - Result := trNullSrc; - Exit; - end; - - if not Assigned(Dest) then - begin - Result := trNullDest; - Exit; - end; - SrcI := 0; - DestI := 0; - - while (DestI < DestWideCharCount) and (SrcI < SrcCharCount) do - begin - B1 := Byte(Src[SrcI]); - Inc(SrcI); - - if B1 < 128 then // single byte UTF-8 char - begin - Dest[DestI] := System.WideChar(B1); - Inc(DestI); - end - else - begin - if SrcI >= SrcCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - B2 := Byte(Src[SrcI]); - Inc(SrcI); - - if (B1 and %11100000) = %11000000 then // double byte UTF-8 char - begin - if (B2 and %11000000) = %10000000 then - begin - Dest[DestI] := System.WideChar(((B1 and %00011111) shl 6) or (B2 and %00111111)); - Inc(DestI); - end - else // invalid character, assume single byte UTF-8 char - if InvalidCharError(1) then Exit(trInvalidChar); - end - else - begin - if SrcI >= SrcCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - B3 := Byte(Src[SrcI]); - Inc(SrcI); - - if (B1 and %11110000) = %11100000 then // triple byte UTF-8 char - begin - if ((B2 and %11000000) = %10000000) and ((B3 and %11000000) = %10000000) then - begin - W := ((B1 and %00011111) shl 12) or ((B2 and %00111111) shl 6) or (B3 and %00111111); - if (W < $D800) or (W > $DFFF) then // to single wide char UTF-16 char - begin - Dest[DestI] := System.WideChar(W); - Inc(DestI); - end - else // invalid UTF-16 character, assume double byte UTF-8 char - if InvalidCharError(2) then Exit(trInvalidChar); - end - else // invalid character, assume double byte UTF-8 char - if InvalidCharError(2) then Exit(trInvalidChar); - end - else - begin - if SrcI >= SrcCharCount then - if UnfinishedCharError then Exit(trInvalidChar) - else Break; - - B4 := Byte(Src[SrcI]); - Inc(SrcI); - - if ((B1 and %11111000) = %11110000) and ((B2 and %11000000) = %10000000) - and ((B3 and %11000000) = %10000000) and ((B4 and %11000000) = %10000000) then - begin // 4 byte UTF-8 char - C := ((B1 and %00011111) shl 18) or ((B2 and %00111111) shl 12) - or ((B3 and %00111111) shl 6) or (B4 and %00111111); - // to double wide char UTF-16 char - Dest[DestI] := System.WideChar($D800 or ((C - $10000) shr 10)); - Inc(DestI); - if DestI >= DestWideCharCount then Break; - Dest[DestI] := System.WideChar($DC00 or ((C - $10000) and %0000001111111111)); - Inc(DestI); - end - else // invalid character, assume triple byte UTF-8 char - if InvalidCharError(3) then Exit(trInvalidChar); - end; - end; - end; - end; - - if DestI >= DestWideCharCount then - begin - DestI := DestWideCharCount - 1; - Result := trDestExhausted; - end - else - Result := trNoError; - - Dest[DestI] := #0; - ActualWideCharCount := DestI + 1; -end; - -function UTF8ToUTF16(const P: PChar; ByteCnt: SizeUInt): UnicodeString; -var - L: SizeUInt; -begin - if ByteCnt=0 then - exit(''); - SetLength(Result, ByteCnt); - // wide chars of UTF-16 <= bytes of UTF-8 string - if ConvertUTF8ToUTF16(PWideChar(Result), Length(Result) + 1, P, ByteCnt, - [toInvalidCharToSymbol], L) = trNoError - then SetLength(Result, L - 1) - else Result := ''; -end; - -function UTF8ToUTF16(const S: AnsiString): UnicodeString; -begin - Result:=UTF8ToUTF16(PChar(S),length(S)); -end; - function StrToUTF16Hex(const AValue: UnicodeString; AIncludeBOM: boolean = True): AnsiString; var pc: ^Word; @@ -618,6 +380,11 @@ begin end; end; +procedure FillMem(Dest: pointer; Size: longint; Data: Byte ); +begin + FillChar(Dest^, Size, Data); +end; + function TTFFileInfo.ReadULong(AStream: TStream): Longword;inline; begin Result:=0; @@ -755,7 +522,7 @@ begin While (UE>=0) and ((FSubtables[UE].PlatformID<>3) or (FSubtables[UE].EncodingID<> 1)) do Dec(UE); if (UE=-1) then - Raise ETTF.Create('No Format 4 map (unicode) table found'); + Raise ETTF.Create('No Format 4 map (unicode) table found <'+FFileName + ' - ' + PostScriptName+'>'); TT:=TableStartPos+FSubtables[UE].Offset; AStream.Position:=TT; FUnicodeMap.Format:= ReadUShort(AStream); // 2 bytes - Format of subtable @@ -839,12 +606,8 @@ begin StringOffset:=ReadUShort(AStream); // 2 bytes E := FNameEntries; SetLength(E,Count); + FillMem(@N, SizeOf(TNameRecord), 0); // Read Descriptors -{$IFDEF VER3} - N := Default(TNameRecord); -{$ELSE} - FillChar(N,SizeOf(TNameRecord),0); -{$ENDIF} for I:=0 to Count-1 do begin AStream.ReadBuffer(N,SizeOf(TNameRecord)); @@ -1027,7 +790,7 @@ begin ttcmap: ParseCmap(AStream); ttname: ParseName(AStream); ttos2 : ParseOS2(AStream); - ttPost: ParsePost(AStream); // lecture table "Post" + ttPost: ParsePost(AStream); end; end; end; @@ -1041,52 +804,17 @@ begin raise ETTF.Create(rsFontEmbeddingNotAllowed); PrepareEncoding(Encoding); // MissingWidth:=ToNatural(Widths[Chars[CharCodes^[32]]].AdvanceWidth); // Char(32) - Space character - MissingWidth:=Widths[Chars[CharCodes^[32]]].AdvanceWidth; // Char(32) - Space character + FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth; // Char(32) - Space character for I:=0 to 255 do begin if (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then CharWidth[I]:= ToNatural(Widths[Chars[CharCodes^[I]]].AdvanceWidth) else - CharWidth[I]:= MissingWidth; + CharWidth[I]:= FMissingWidth; end; end; -procedure TTFFileInfo.FillPDFFontDefinition(out ADef: TPDFFontDefinition; const AFontFile, AEncoding: String); - -Var - I : Integer; - S : String; - -begin - ADef.FontType:='TrueType'; // DON'T LOCALIZE - ADef.FontName:=PostScriptName; - ADef.Ascender:=Ascender; - ADef.Descender:=Descender; - ADef.CapHeight:=Capheight; - ADef.Flags:=Flags; - For I:=0 to 3 do - ADef.BBox[i]:=ToNatural(FHead.BBox[I]); - ADef.ItalicAngle:=FPostScript.ItalicAngle; - ADef.StemV:=StemV; - ADef.MissingWidth:=MissingWidth; - ADef.FontUp:=ToNatural(FPostScript.UnderlinePosition); - ADef.FontUt:=ToNatural(FPostScript.UnderlineThickness); - ADef.Encoding:=AEncoding; - ADef.OriginalSize:=FOriginalSize; - ADef.FontFile:=ChangeFileExt(AFontFile,'.z'); - if (Lowercase(AEncoding)<>'cp1252') then - ADef.Diffs:=MakeDifferences; - S:=''; - for I:=32 to 255 do - begin - if I>32 then - S:=S+' '; - S:=S+IntToStr(CharWidth[I]); - end; - ADef.CharWidths:=S; -end; - -procedure TTFFileInfo.PrepareEncoding(const AEnCoding: String); +procedure TTFFileInfo.PrepareEncoding(const AEncoding: String); var TE : TTTFEncoding; V : PTTFEncodingValues; @@ -1098,49 +826,6 @@ begin GetEncodingTables(Te,CharBase,V); end; -procedure TTFFileInfo.MakePDFFontDefinitionFile(const FontFile, Section, AEncoding: string); - -var - Ini : TMemIniFile; - S: String; - I : Integer; - Def : TPDFFontDefinition; - -begin - FillPDFFontDefinition(Def,FontFile,AEncoding); - Ini:=TMemIniFile.Create(FontFile); - With Ini Do - try - WriteString(Section,'FontType',Def.FontType); - WriteString(Section,'FontName',Def.FontName); - WriteInteger(Section,'Ascent',Def.Ascender); - WriteInteger(Section,'Descent',Def.Descender); - WriteInteger(Section,'CapHeight',Def.CapHeight); - WriteInteger(Section,'Flags',Def.Flags); - S:=''; - for i:=0 to 3 do - begin - if I>0 then - S:=S+' '; - S:=S+IntToStr(Def.BBox[I]); - end; - WriteString(Section,'FontBBox',S); - WriteInteger(Section,'ItalicAngle',Def.ItalicAngle); - WriteInteger(Section,'StemV',Def.StemV); - WriteInteger(Section,'MissingWidth',Def.MissingWidth); - WriteInteger(Section,'FontUp',Def.FontUp); - WriteInteger(Section,'FontUt',Def.FontUt); - WriteString(Section,'Encoding',Def.Encoding); - WriteString(Section,'FontFile',Def.FontFile); - WriteInteger(Section,'OriginalSize',Def.OriginalSize); - WriteString(Section,'Diffs',Def.Diffs); - WriteString(Section,'CharWidth',Def.CharWidths); - UpdateFile; - finally - Ini.Free; - end; -end; - function TTFFileInfo.MakeDifferences: String; var i,l: Integer; @@ -1212,6 +897,24 @@ begin Result := Widths[AIndex].AdvanceWidth; end; +function TTFFileInfo.ItalicAngle: LongWord; +begin + Result := FPostScript.ItalicAngle; +end; + +function TTFFileInfo.BBox: string; +var + i: integer; +begin + Result := ''; + for i := 0 to 3 do + begin + if i > 0 then + Result := Result + ' '; + Result := Result + IntToStr(ToNatural(FHead.BBox[I])); + end; +end; + destructor TTFFileInfo.Destroy; begin SetLength(FNameEntries, 0); @@ -1228,6 +931,15 @@ begin Result := round(d*10000); end; +function TTFFileInfo.GetMissingWidth: integer; +begin + if FMissingWidth = 0 then + begin + FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth; // Char(32) - Space character + end; + Result := FMissingWidth; +end; + function TTFFileInfo.IsNativeData: Boolean; begin Result:=False; @@ -1250,12 +962,4 @@ begin Result := Result+64; end; -procedure TTFFileInfo.MakePDFFontDef(const FontFile: string; const Encoding:string; Embed: Boolean); -begin - PrepareFontDefinition(Encoding, Embed); - MakePDFFontDefinitionFile(FontFile,PostScriptName,Encoding); -end; - - end. - diff --git a/packages/fcl-pdf/src/fppdf.pp b/packages/fcl-pdf/src/fppdf.pp index 21971d0f93..46f30558f4 100644 --- a/packages/fcl-pdf/src/fppdf.pp +++ b/packages/fcl-pdf/src/fppdf.pp @@ -613,6 +613,7 @@ type TPDFFont = CLass(TCollectionItem) private FColor: TARGBColor; + FIsStdFont: boolean; FName: String; FFontFilename: String; FTrueTypeFile: TTFFileInfo; @@ -629,6 +630,7 @@ type Property Name: String Read FName Write FName; Property Color: TARGBColor Read FColor Write FColor; property TextMapping: TTextMappingList read FTextMappingList; + property IsStdFont: boolean read FIsStdFont write FIsStdFont; end; @@ -721,13 +723,11 @@ type TPDFToUnicode = class(TPDFDocumentObject) private - FFontDef: TFontDef; FEmbeddedFontNum: integer; protected procedure Write(const AStream: TStream);override; public - constructor Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer; AFontDef : TFontDef); overload; - property FontDef: TFontDef read FFontDef; + constructor Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer); overload; property EmbeddedFontNum: integer read FEmbeddedFontNum; end; @@ -801,16 +801,15 @@ type function CreatePageEntry(Parent, PageNum: integer): integer;virtual; function CreateOutlines: integer;virtual; function CreateOutlineEntry(Parent, SectNo, PageNo: integer; ATitle: string): integer;virtual; - function LoadFont(AFont: TPDFFont; Out FontDef : TFontDef): string; + function LoadFont(AFont: TPDFFont): boolean; procedure CreateStdFont(EmbeddedFontName: string; EmbeddedFontNum: integer);virtual; - procedure CreateTTFFont(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual; - procedure CreateTTFDescendantFont(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual; - procedure CreateTTFCIDSystemInfo(const EmbeddedFontNum: integer; FontDef: TFontDef);virtual; + procedure CreateTTFFont(const EmbeddedFontNum: integer);virtual; + procedure CreateTTFDescendantFont(const EmbeddedFontNum: integer);virtual; + procedure CreateTTFCIDSystemInfo;virtual; procedure CreateTp1Font(const EmbeddedFontNum: integer);virtual; - procedure CreateFontDescriptor(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual; - procedure CreateToUnicode(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual; - procedure CreateFontWidth(FontDef : TFontDef);virtual; - procedure CreateFontFileEntry(const EmbeddedFontNum: integer; FontDef: TFontDef);virtual; + procedure CreateFontDescriptor(const EmbeddedFontNum: integer);virtual; + procedure CreateToUnicode(const EmbeddedFontNum: integer);virtual; + procedure CreateFontFileEntry(const EmbeddedFontNum: integer);virtual; procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual; procedure CreatePageStream(APage : TPDFPage; PageNum: integer); Function CreateGlobalXRef: TPDFXRef; @@ -1028,20 +1027,19 @@ Type var d: TDecompressionStream; + {$IFDEF NOHEADERWORKADOUND} + I: integer; + {$ENDIF} Count : Integer; Buffer : TBuffer; - + begin if AFrom.Size = 0 then begin ATo.Size := 0; Exit; //==> end; -{$IFDEF VER3} - Buffer := Default(TBuffer); -{$ELSE} - FillChar(Buffer,SizeOf(TBuffer),0); -{$ENDIF}; + FillMem(@Buffer, SizeOf(TBuffer), 0); AFrom.Position := 0; AFrom.Seek(0,soFromEnd); @@ -1212,6 +1210,7 @@ begin FTextMappingList := TTextMappingList.Create; FTrueTypeFile := TTFFileInfo.Create; FTrueTypeFile.LoadFromFile(FFontFilename); + FTrueTypeFile.PrepareFontDefinition('cp1252', True); end; end; @@ -1236,6 +1235,8 @@ var c: word; begin Result := ''; + if Length(AText) = 0 then + Exit; for i := 1 to Length(AText) do begin c := Word(AText[i]); @@ -1580,7 +1581,7 @@ var begin if AText = '' then Exit; - str := UTF8ToUTF16(AText); + str := UTF8Decode(AText); Document.Fonts[FFontIndex].AddTextToMappingList(str); end; @@ -2231,7 +2232,7 @@ function TPDFUTF8String.RemapedText: AnsiString; var s: UnicodeString; begin - s := UTF8ToUTF16(FValue); + s := UTF8Decode(FValue); Result := Document.Fonts[FontIndex].GetGlyphIndices(s); end; @@ -2862,11 +2863,10 @@ begin WriteString('end'+CRLF, AStream); end; -constructor TPDFToUnicode.Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer; AFontDef: TFontDef); +constructor TPDFToUnicode.Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer); begin inherited Create(ADocument); FEmbeddedFontNum := AEmbeddedFontNum; - FFontDef := AFontDef; end; { TPDFDocument } @@ -3154,18 +3154,16 @@ begin N := CreateName('F'+IntToStr(EmbeddedFontNum)); FDict.AddElement('Name',N); AddFontNameToPages(N.Name,GLobalXRefCount-1); - // add font reference to all page dictionary + // add font reference to global page dictionary FontFiles.Add(''); end; -function TPDFDocument.LoadFont(AFont: TPDFFont; out FontDef: TFontDef): string; +function TPDFDocument.LoadFont(AFont: TPDFFont): boolean; var - lFontFile: TTFFileInfo; - lFontDef: TPDFFontDefinition; lFName: string; - i: integer; s: string; begin + Result := False; if ExtractFilePath(AFont.FontFile) <> '' then // assume AFont.FontFile is the full path to the TTF file lFName := AFont.FontFile @@ -3175,40 +3173,14 @@ begin if FileExists(lFName) then begin - lFontFile := TTFFileInfo.Create; - lFontFile.LoadFromFile(lFName); - lFontFile.PrepareFontDefinition('cp1252', True); - lFontFile.FillPDFFontDefinition(lFontDef, ExtractBaseFontName(AFont.Name), 'cp1252'); - FontDef.FType := lFontDef.FontType; - FontDef.FName := lFontDef.FontName; - FontDef.FAscent := IntToStr(lFontDef.Ascender); - FontDef.FDescent := IntToStr(lFontDef.Descender); - FontDef.FCapHeight := IntToStr(lFontDef.CapHeight); - FontDef.FFlags := IntToStr(lFontDef.Flags); - s := ''; - for i := 0 to 3 do - begin - if i > 0 then - s := s+' '; - s := s + IntToStr(lFontDef.BBox[i]); - end; - FontDef.FFontBBox := s; - FontDef.FItalicAngle := IntToStr(lFontDef.ItalicAngle); - FontDef.FStemV := IntToStr(lFontDef.StemV); - FontDef.FMissingWidth := IntToStr(lFontDef.MissingWidth); - FontDef.FEncoding := lFontDef.Encoding; - FontDef.FFile := lFName; - FontDef.FOriginalSize := IntToStr(lFontDef.OriginalSize); - FontDef.FDiffs := lFontDef.Diffs; - FontDef.FCharWidth := lFontDef.CharWidths; - Result := lFontDef.FontType; - lFontFile.Free; + s := LowerCase(ExtractFileExt(lFName)); + Result := (s = '.ttf') or (s = '.otf'); end else Raise EPDF.CreateFmt(rsErrReportFontFileMissing, [lFName]); end; -procedure TPDFDocument.CreateTTFFont(const EmbeddedFontNum: integer; FontDef : TFontDef); +procedure TPDFDocument.CreateTTFFont(const EmbeddedFontNum: integer); var FDict: TPDFDictionary; N: TPDFName; @@ -3218,22 +3190,22 @@ begin FDict := CreateGlobalXRef.Dict; FDict.AddName('Type', 'Font'); FDict.AddName('Subtype', 'Type0'); - FDict.AddName('BaseFont', FontDef.FName); + FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name); FDict.AddName('Encoding', 'Identity-H'); // add name element to font dictionary N:=CreateName('F'+IntToStr(EmbeddedFontNum)); FDict.AddElement('Name',N); - Self.AddFontNameToPages(N.Name,GlobalXRefCount-1); - CreateTTFDescendantFont(EmbeddedFontNum, FontDef); + AddFontNameToPages(N.Name,GlobalXRefCount-1); + CreateTTFDescendantFont(EmbeddedFontNum); Arr := CreateArray; FDict.AddElement('DescendantFonts', Arr); Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount-4)); - CreateToUnicode(EmbeddedFontNum, FontDef); + CreateToUnicode(EmbeddedFontNum); FDict.AddReference('ToUnicode', GlobalXRefCount-1); - FontFiles.Add(FontDef.FFile); + FontFiles.Add(Fonts[EmbeddedFontNum].FTrueTypeFile.Filename); end; -procedure TPDFDocument.CreateTTFDescendantFont(const EmbeddedFontNum: integer; FontDef: TFontDef); +procedure TPDFDocument.CreateTTFDescendantFont(const EmbeddedFontNum: integer); var FDict: TPDFDictionary; Arr: TPDFArray; @@ -3242,13 +3214,13 @@ begin FDict := CreateGlobalXRef.Dict; FDict.AddName('Type', 'Font'); FDict.AddName('Subtype', 'CIDFontType2'); - FDict.AddName('BaseFont', FontDef.FName); + FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name); - CreateTTFCIDSystemInfo(EmbeddedFontNum, FontDef); + CreateTTFCIDSystemInfo; FDict.AddReference('CIDSystemInfo', GlobalXRefCount-1); // add fontdescriptor reference to font dictionary - CreateFontDescriptor(EmbeddedFontNum,FontDef); + CreateFontDescriptor(EmbeddedFontNum); FDict.AddReference('FontDescriptor',GlobalXRefCount-2); Arr := CreateArray; @@ -3256,7 +3228,7 @@ begin Arr.AddItem(TPDFTrueTypeCharWidths.Create(self, EmbeddedFontNum)); end; -procedure TPDFDocument.CreateTTFCIDSystemInfo(const EmbeddedFontNum: integer; FontDef: TFontDef); +procedure TPDFDocument.CreateTTFCIDSystemInfo; var FDict: TPDFDictionary; begin @@ -3271,59 +3243,46 @@ begin Assert(EmbeddedFontNum<>-1); end; -procedure TPDFDocument.CreateFontDescriptor(const EmbeddedFontNum: integer; FontDef : TFontDef); +procedure TPDFDocument.CreateFontDescriptor(const EmbeddedFontNum: integer); var Arr: TPDFArray; FDict: TPDFDictionary; begin FDict:=CreateGlobalXRef.Dict; FDict.AddName('Type', 'FontDescriptor'); - FDict.AddName('FontName', FontDef.FName); + FDict.AddName('FontName', Fonts[EmbeddedFontNum].Name); FDict.AddName('FontFamily', Fonts[EmbeddedFontNum].FTrueTypeFile.FamilyName); - FDict.AddInteger('Ascent', StrToInt(FontDef.FAscent)); - FDict.AddInteger('Descent', StrToInt(FontDef.FDescent)); - FDict.AddInteger('CapHeight', StrToInt(FontDef.FCapHeight)); + FDict.AddInteger('Ascent', Fonts[EmbeddedFontNum].FTrueTypeFile.Ascender); + FDict.AddInteger('Descent', Fonts[EmbeddedFontNum].FTrueTypeFile.Descender); + FDict.AddInteger('CapHeight', Fonts[EmbeddedFontNum].FTrueTypeFile.CapHeight); FDict.AddInteger('Flags', 32); Arr:=CreateArray; FDict.AddElement('FontBBox',Arr); - Arr.AddIntArray(FontDef.FFontBBox); - FDict.AddInteger('ItalicAngle',StrToInt(FontDef.FItalicAngle)); - FDict.AddInteger('StemV',StrToInt(FontDef.FStemV)); - FDict.AddInteger('MissingWidth', StrToInt(FontDef.FMissingWidth)); - CreateFontFileEntry(EmbeddedFontNum,FontDef); + Arr.AddIntArray(Fonts[EmbeddedFontNum].FTrueTypeFile.BBox); + FDict.AddInteger('ItalicAngle',Fonts[EmbeddedFontNum].FTrueTypeFile.ItalicAngle); + FDict.AddInteger('StemV', Fonts[EmbeddedFontNum].FTrueTypeFile.StemV); + FDict.AddInteger('MissingWidth', Fonts[EmbeddedFontNum].FTrueTypeFile.MissingWidth); + CreateFontFileEntry(EmbeddedFontNum); FDict.AddReference('FontFile2',GlobalXRefCount-1); end; -procedure TPDFDocument.CreateToUnicode(const EmbeddedFontNum: integer; FontDef: TFontDef); +procedure TPDFDocument.CreateToUnicode(const EmbeddedFontNum: integer); var lXRef: TPDFXRef; begin lXRef := CreateGlobalXRef; lXRef.FStream := CreateStream(True); - lXRef.FStream.AddItem(TPDFToUnicode.Create(self, EmbeddedFontNum, FontDef)); + lXRef.FStream.AddItem(TPDFToUnicode.Create(self, EmbeddedFontNum)); end; - -procedure TPDFDocument.CreateFontWidth(FontDef : TFontDef); -var - Arr: TPDFArray; - FDict: TPDFDictionary; - -begin - FDict:=CreateGlobalXRef.Dict; - Arr:=CreateArray; - FDict.AddElement('',Arr); - Arr.AddIntArray(FontDef.FCharWidth); -end; - -procedure TPDFDocument.CreateFontFileEntry(const EmbeddedFontNum: integer; FontDef: TFontDef); +procedure TPDFDocument.CreateFontFileEntry(const EmbeddedFontNum: integer); var FDict: TPDFDictionary; begin FDict:=CreateGlobalXRef.Dict; if poCompressFonts in Options then FDict.AddName('Filter','FlateDecode'); - FDict.AddInteger('Length1 '+IntToStr(EmbeddedFontNum),StrToInt(FontDef.FOriginalSize)); + FDict.AddInteger('Length1 '+IntToStr(EmbeddedFontNum), Fonts[EmbeddedFontNum].FTrueTypeFile.OriginalSize); end; procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer); @@ -3595,7 +3554,6 @@ var i: integer; NumFont: integer; FontName: string; - FontDef: TFontDef; begin // select the font type NumFont:=0; @@ -3611,8 +3569,8 @@ begin begin CreateStdFont(FontName, NumFont); end - else if (LoadFont(Fonts[i], FontDef)='TrueType') then - CreateTtfFont(NumFont,FontDef) + else if LoadFont(Fonts[i]) then + CreateTtfFont(NumFont) else CreateTp1Font(NumFont); // not implemented yet Inc(NumFont); @@ -3767,6 +3725,7 @@ begin F := Fonts.AddFontDef; F.Name := AName; F.Color := AColor; + F.IsStdFont := True; Result := Fonts.Count-1; end; @@ -3795,6 +3754,7 @@ begin F.FontFile := lFName; F.Name := AName; F.Color := AColor; + F.IsStdFont := False; Result := Fonts.Count-1; end; diff --git a/packages/fcl-pdf/tests/fpparsettf_test.pas b/packages/fcl-pdf/tests/fpparsettf_test.pas index c0096118fb..9e92597413 100644 --- a/packages/fcl-pdf/tests/fpparsettf_test.pas +++ b/packages/fcl-pdf/tests/fpparsettf_test.pas @@ -190,10 +190,6 @@ type procedure TestPostScript_minMemType1; procedure TestPostScript_maxMemType1; - { PDF Font Definition } - procedure TestPDFFontDefinition; - procedure TestMakePDFFontDefinition; - { Utility functions } procedure TestGetGlyphIndex; procedure TestGetAdvanceWidth; @@ -353,10 +349,6 @@ type procedure TestPostScript_maxMemType42; procedure TestPostScript_minMemType1; procedure TestPostScript_maxMemType1; - - { PDF Font Definition } - procedure TestPDFFontDefinition; - procedure TestMakePDFFontDefinition; end; implementation @@ -1124,78 +1116,6 @@ begin AssertEquals('Failed on 1', 0, FI.PostScript.maxMemType1); end; -procedure TTestLiberationFont.TestPDFFontDefinition; -var - Def: TPDFFontDefinition; - s: string; -begin - FI.FillPDFFontDefinition(Def, cFont1, 'cp1252'); - AssertEquals('Failed on 1', 'TrueType', Def.FontType); - AssertEquals('Failed on 2', 'LiberationSans', Def.FontName); - AssertEquals('Failed on 3', 728, Def.Ascender); - AssertEquals('Failed on 4', -210, Def.Descender); - AssertEquals('Failed on 5', 688, Def.CapHeight); - AssertEquals('Failed on 6', 32, Def.Flags); - - s := IntToStr(Def.BBox[0]) + ' ' + IntToStr(Def.BBox[1]) + ' ' + - IntToStr(Def.BBox[2]) + ' ' + IntToStr(Def.BBox[3]); - AssertEquals('Failed on 7', '-544 -303 1302 980', s); - - AssertEquals('Failed on 8', 0, Def.ItalicAngle); - AssertEquals('Failed on 9', 70, Def.StemV); - AssertEquals('Failed on 10', 0, Def.MissingWidth); - AssertEquals('Failed on 11', -106, Def.FontUp); - AssertEquals('Failed on 12', 73, Def.FontUt); - AssertEquals('Failed on 13', 'cp1252', Def.Encoding); - AssertEquals('Failed on 14', ReplaceStr(cFont1, '.ttf', '.z'), Def.FontFile); // 'fonts/LiberationSans-Regular.z' - AssertEquals('Failed on 15', '', Def.Diffs); - - { CharWidths is only valid if we called MakePDFFontDef } -// AssertEquals('Failed on 16', '', Def.CharWidths); - - AssertEquals('Failed on 17', 350200, Def.OriginalSize); -end; - -procedure TTestLiberationFont.TestMakePDFFontDefinition; -const - cSection = 'LiberationSans'; -var - lFile: string; - ini: TINIFile; -begin - lFile := ChangeFileExt(GetTempFileName, '.ini'); -// writeln( lFile); - AssertTrue('Failed on 1', FileExists(lFile) = False); - try - FI.MakePDFFontDef(lFile, 'cp1252', True); - AssertTrue('Failed on 2', FileExists(lFile) = True); - ini := TINIFile.Create(lFile); - try - AssertEquals('Failed on 3', 'TrueType', ini.ReadString(cSection, 'FontType', '')); - AssertEquals('Failed on 4', 'LiberationSans', ini.ReadString(cSection, 'FontName', '')); - AssertEquals('Failed on 5', 728, ini.ReadInteger(cSection, 'Ascent', 0)); - AssertEquals('Failed on 6', -210, ini.ReadInteger(cSection, 'Descent', 0)); - AssertEquals('Failed on 7', 688, ini.ReadInteger(cSection, 'CapHeight', 0)); - AssertEquals('Failed on 8', 32, ini.ReadInteger(cSection, 'Flags', 0)); - AssertEquals('Failed on 9', '-544 -303 1302 980', ini.ReadString(cSection, 'FontBBox', '')); - AssertEquals('Failed on 10', 0, ini.ReadInteger(cSection, 'ItalicAngle', 0)); - AssertEquals('Failed on 11', 70, ini.ReadInteger(cSection, 'StemV', 0)); - AssertEquals('Failed on 12', 569, ini.ReadInteger(cSection, 'MissingWidth', 0)); - AssertEquals('Failed on 13', -106, ini.ReadInteger(cSection, 'FontUp', 0)); - AssertEquals('Failed on 14', 73, ini.ReadInteger(cSection, 'FontUt', 0)); - AssertEquals('Failed on 15', 'cp1252', ini.ReadString(cSection, 'Encoding', '')); - AssertEquals('Failed on 16', ReplaceStr(lFile, '.ini', '.z'), ini.ReadString(cSection, 'FontFile', '')); - AssertEquals('Failed on 17', '', ini.ReadString(cSection, 'Diffs', '')); - AssertTrue('Failed on 18', ini.ReadString(cSection, 'CharWidth', '') <> ''); - AssertEquals('Failed on 19', 350200, ini.ReadInteger(cSection, 'OriginalSize', 0)); - finally - ini.Free; - end; - finally - DeleteFile(lFile); - end -end; - procedure TTestLiberationFont.TestGetGlyphIndex; begin AssertEquals('Failed on 1.1', 67, Ord('C')); @@ -1976,80 +1896,6 @@ begin AssertEquals('Failed on 1', 0, FI.PostScript.maxMemType1); end; -procedure TTestFreeSansFont.TestPDFFontDefinition; -var - Def: TPDFFontDefinition; - s: string; -begin - FI.FillPDFFontDefinition(Def, cFont1, 'cp1252'); - AssertEquals('Failed on 1', 'TrueType', Def.FontType); - AssertEquals('Failed on 2', 'FreeSans', Def.FontName); - AssertEquals('Failed on 3', 800, Def.Ascender); - AssertEquals('Failed on 4', -200, Def.Descender); - AssertEquals('Failed on 5', 729, Def.CapHeight); - AssertEquals('Failed on 6', 32, Def.Flags); - - s := IntToStr(Def.BBox[0]) + ' ' + IntToStr(Def.BBox[1]) + ' ' + - IntToStr(Def.BBox[2]) + ' ' + IntToStr(Def.BBox[3]); - AssertEquals('Failed on 7', '-1166 -638 2260 1050', s); - - AssertEquals('Failed on 8', 0, Def.ItalicAngle); - AssertEquals('Failed on 9', 70, Def.StemV); - AssertEquals('Failed on 10', 0, Def.MissingWidth); - AssertEquals('Failed on 11', -176, Def.FontUp); - AssertEquals('Failed on 12', 50, Def.FontUt); - AssertEquals('Failed on 13', 'cp1252', Def.Encoding); - AssertEquals('Failed on 14', ReplaceStr(cFont1, '.ttf', '.z'), Def.FontFile); // 'fonts/LiberationSans-Regular.z' - AssertEquals('Failed on 15', '', Def.Diffs); - - { CharWidths is only valid if we called MakePDFFontDef } -// AssertEquals('Failed on 16', '', Def.CharWidths); - - AssertEquals('Failed on 17', 1563256, Def.OriginalSize); -end; - -procedure TTestFreeSansFont.TestMakePDFFontDefinition; -const - cSection = 'FreeSans'; -var - lFile: string; - ini: TINIFile; -begin - lFile := ChangeFileExt(GetTempFileName, '.ini'); -// writeln( lFile); - AssertTrue('Failed on 1', FileExists(lFile) = False); - try - FI.MakePDFFontDef(lFile, 'cp1252', True); - AssertTrue('Failed on 2', FileExists(lFile) = True); - ini := TINIFile.Create(lFile); - try - AssertEquals('Failed on 3', 'TrueType', ini.ReadString(cSection, 'FontType', '')); - AssertEquals('Failed on 4', 'FreeSans', ini.ReadString(cSection, 'FontName', '')); - AssertEquals('Failed on 5', 800, ini.ReadInteger(cSection, 'Ascent', 0)); - AssertEquals('Failed on 6', -200, ini.ReadInteger(cSection, 'Descent', 0)); - AssertEquals('Failed on 7', 729, ini.ReadInteger(cSection, 'CapHeight', 0)); - AssertEquals('Failed on 8', 32, ini.ReadInteger(cSection, 'Flags', 0)); - AssertEquals('Failed on 9', '-1166 -638 2260 1050', ini.ReadString(cSection, 'FontBBox', '')); - AssertEquals('Failed on 10', 0, ini.ReadInteger(cSection, 'ItalicAngle', 0)); - AssertEquals('Failed on 11', 70, ini.ReadInteger(cSection, 'StemV', 0)); - AssertEquals('Failed on 12', 250, ini.ReadInteger(cSection, 'MissingWidth', 0)); - AssertEquals('Failed on 13', -176, ini.ReadInteger(cSection, 'FontUp', 0)); - AssertEquals('Failed on 14', 50, ini.ReadInteger(cSection, 'FontUt', 0)); - AssertEquals('Failed on 15', 'cp1252', ini.ReadString(cSection, 'Encoding', '')); - AssertEquals('Failed on 16', ReplaceStr(lFile, '.ini', '.z'), ini.ReadString(cSection, 'FontFile', '')); - AssertEquals('Failed on 17', '', ini.ReadString(cSection, 'Diffs', '')); - AssertTrue('Failed on 18', ini.ReadString(cSection, 'CharWidth', '') <> ''); - AssertEquals('Failed on 19', 1563256, ini.ReadInteger(cSection, 'OriginalSize', 0)); - finally - ini.Free; - end; - finally - DeleteFile(lFile); - end -end; - - - initialization RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif}); diff --git a/packages/fcl-pdf/tests/fppdf_test.pas b/packages/fcl-pdf/tests/fppdf_test.pas index ff29c5f5ac..fca334e5ae 100644 --- a/packages/fcl-pdf/tests/fppdf_test.pas +++ b/packages/fcl-pdf/tests/fppdf_test.pas @@ -292,7 +292,7 @@ procedure TTestPDFObject.TestFloatStr; Var C : Char; - + begin AssertEquals('Failed on 1', '0.12', TMockPDFObject.FloatStr(TPDFFLoat(0.12))); AssertEquals('Failed on 2', ' 12', TMockPDFObject.FloatStr(TPDFFLoat(12.00))); @@ -309,7 +309,7 @@ begin AssertEquals('Failed on 9', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34))); finally FormatSettings.DecimalSeparator:=C; - end; + end; // Set ThousandSeparator C:=FormatSettings.ThousandSeparator; FormatSettings.ThousandSeparator:=' '; @@ -1247,7 +1247,6 @@ end; procedure TTestPDFImage.TestWrite; var o: TMockPDFImage; - ar: TPDFCoordArray; x, y: TPDFFLoat; begin x := 100; @@ -1265,7 +1264,6 @@ begin 'Q'+CRLF, S.DataString); finally - SetLength(ar, 0); o.Free; end; end;