Browse Source

* Add miter/penstyle, allow font in floating point size, allow simulation of italic/bold. Patch by Joeny Ang. Fixes issue #39836

Michaël Van Canneyt 1 year ago
parent
commit
e1715d6d1a
1 changed files with 417 additions and 103 deletions
  1. 417 103
      packages/fcl-pdf/src/fppdf.pp

+ 417 - 103
packages/fcl-pdf/src/fppdf.pp

@@ -82,6 +82,7 @@ type
   TPDFPaperOrientation = (ppoPortrait,ppoLandscape);
   TPDFPenStyle = (ppsSolid,ppsDash,ppsDot,ppsDashDot,ppsDashDotDot);
   TPDFLineCapStyle = (plcsButtCap, plcsRoundCap, plcsProjectingSquareCap);
+  TPDFLineJoinStyle = (pljsMiterJoin, pljsRoundJoin, pljsBevelJoin);
   TPDFPageLayout = (lSingle, lTwo, lContinuous);
   TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels);
 
@@ -147,6 +148,7 @@ type
   // CharWidth array of standard PDF fonts
   TPDFFontWidthArray = array[0..255] of integer;
 
+  TDashArray = array of TPDFFloat;
 
   TPDFObject = class(TObject)
   Protected
@@ -396,16 +398,22 @@ type
     FTxtFont: integer;
     FTxtSize: string;
     FPage: TPDFPage;
+    FSimulateBold, FSimulateItalic: Boolean;
     function    GetPointSize: integer;
+    function    GetFontSize: TPDFFloat;
   protected
     procedure Write(const AStream: TStream); override;
     class function WriteEmbeddedFont(const ADocument: TPDFDocument; const Src: TMemoryStream; const AStream: TStream): int64;
     class function WriteEmbeddedSubsetFont(const ADocument: TPDFDocument; const AFontNum: integer; const AOutStream: TStream): int64;
   public
     constructor Create(const ADocument: TPDFDocument;const APage: TPDFPage; const AFont: integer; const ASize: string); overload;
+    constructor Create(const ADocument: TPDFDocument;const APage: TPDFPage; const AFont: integer; const ASize: TPDFFloat; const ASimulateBold, ASimulateItalic: Boolean); overload;
     property    FontIndex: integer read FTxtFont;
     property    PointSize: integer read GetPointSize;
+    property    FontSize: TPDFFloat read GetFontSize;
     property    Page: TPDFPage read FPage;
+    property    SimulateBold: Boolean read FSimulateBold;
+    property    SimulateItalic: Boolean read FSimulateItalic;
   end;
 
 
@@ -595,10 +603,42 @@ type
     FStyle: TPDFPenStyle;
     FPhase: integer;
     FLineWidth: TPDFFloat;
+    FLineMask: string;
   protected
     procedure Write(const AStream: TStream);override;
   public
     constructor Create(Const ADocument : TPDFDocument; AStyle: TPDFPenStyle; APhase: integer; ALineWidth: TPDFFloat); overload;
+    constructor Create(const ADocument : TPDFDocument; ADashArray: TDashArray; APhase: integer; ALineWidth: TPDFFloat); overload;
+  end;
+
+
+  TPDFCapStyle = class(TPDFDocumentObject)
+  private
+    FStyle: TPDFLineCapStyle;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; AStyle: TPDFLineCapStyle); overload;
+  end;
+
+
+  TPDFJoinStyle = class(TPDFDocumentObject)
+  private
+    FStyle: TPDFLineJoinStyle;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; AStyle: TPDFLineJoinStyle); overload;
+  end;
+
+
+  TPDFMiterLimit = class(TPDFDocumentObject)
+  private
+    FMiterLimit: TPDFFloat;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; AMiterLimit: TPDFFloat); overload;
   end;
 
 
@@ -731,10 +771,15 @@ type
     Destructor Destroy; override;
     Procedure AddObject(AObject : TPDFObject);
     // Commands. These will create objects in the objects list of the page.
-    Procedure SetFont(AFontIndex : Integer; AFontSize : Integer); virtual;
+    Procedure SetFont(AFontIndex : Integer; AFontSize : TPDFFloat; const
+      ASimulateBold: Boolean = False; const ASimulateItalic: Boolean = False); virtual;
     // used for stroking and nonstroking colors - purpose determined by the AStroke parameter
     Procedure SetColor(AColor : TARGBColor; AStroke : Boolean = True); virtual;
     Procedure SetPenStyle(AStyle : TPDFPenStyle; const ALineWidth: TPDFFloat = 1.0); virtual;
+    procedure SetPenStyle(ADashArray: TDashArray; const ALineWidth: TPDFFloat = 1.0);
+    procedure SetLineCapStyle(AStyle: TPDFLineCapStyle); virtual;
+    procedure SetLineJoinStyle(AStyle: TPDFLineJoinStyle); virtual;
+    procedure SetMiterLimit(AMiterLimit: TPDFFloat); virtual;
     // Set color and pen style from line style
     Procedure SetLineStyle(AIndex : Integer; AStroke : Boolean = True); overload;
     Procedure SetLineStyle(S : TPDFLineStyleDef; AStroke : Boolean = True); overload;
@@ -1042,12 +1087,14 @@ type
     FColor: TARGBColor;
     FLineWidth: TPDFFloat;
     FPenStyle: TPDFPenStyle;
+    FDashArray: TDashArray;
   Public
     Procedure Assign(Source : TPersistent); override;
   Published
     Property LineWidth : TPDFFloat Read FLineWidth Write FLineWidth;
     Property Color : TARGBColor Read FColor Write FColor Default clBlack;
     Property PenStyle : TPDFPenStyle Read FPenStyle Write FPenStyle Default ppsSolid;
+    property DashArray : TDashArray read FDashArray write FDashArray;
   end;
 
 
@@ -1163,7 +1210,8 @@ type
     Procedure SaveToFile(Const AFileName : String);
     function  IsStandardPDFFont(AFontName: string): boolean;
     // Create objects, owned by this document.
-    Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
+    Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex : Integer; AFontSize : TPDFFloat;
+      const ASimulateBold: Boolean = False; const ASimulateItalic: Boolean = False) : 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;
@@ -1174,6 +1222,10 @@ type
     Function CreateInteger(AValue : Integer) : TPDFInteger;
     Function CreateReference(AValue : Integer) : TPDFReference;
     Function CreateLineStyle(APenStyle: TPDFPenStyle; const ALineWidth: TPDFFloat) : TPDFLineStyle;
+    function CreateLineStyle(ADashArray: TDashArray; const ALineWidth: TPDFFloat): TPDFLineStyle;
+    function CreateLineCapStyle(ALineCapStyle: TPDFLineCapStyle): TPDFCapStyle;
+    function CreateLineJoinStyle(ALineJoinStyle: TPDFLineJoinStyle): TPDFJoinStyle;
+    function CreateMiterLimit(AMiterLimit: TPDFFloat): TPDFMiterLimit;
     Function CreateName(AValue : String; const AMustEscape: boolean = True) : TPDFName;
     Function CreateStream(OwnsObjects : Boolean = True) : TPDFStream;
     Function CreateDictionary : TPDFDictionary;
@@ -1183,6 +1235,7 @@ type
     Function AddFont(AName : String) : Integer; overload;
     Function AddFont(AFontFile: String; AName : String) : Integer; overload;
     Function AddLineStyleDef(ALineWidth : TPDFFloat; AColor : TARGBColor = clBlack; APenStyle : TPDFPenStyle = ppsSolid) : Integer;
+    function AddLineStyleDef(ALineWidth : TPDFFloat; AColor : TARGBColor = clBlack; ADashArray : TDashArray = []) : Integer;
     procedure AddOutputIntent(const Subtype, OutputConditionIdentifier, Info: string; ICCProfile: TStream);
     procedure AddPDFA1sRGBOutputIntent;virtual;
     Property Fonts : TPDFFontDefs Read FFonts Write SetFonts;
@@ -1264,6 +1317,7 @@ function cmToPDF(cm: single): TPDFFloat;
 function PDFtoCM(APixels: TPDFFloat): single;
 function InchesToPDF(Inches: single): TPDFFloat;
 function PDFtoInches(APixels: TPDFFloat): single;
+function FontUnitsTomm(AUnits, APointSize: TPDFFloat; AUnitsPerEm: Integer): single;
 
 function PDFCoord(x, y: TPDFFloat): TPDFCoord;
 
@@ -1498,6 +1552,12 @@ begin
   Result := APixels / cDefaultDPI;
 end;
 
+function FontUnitsTomm(AUnits, APointSize: TPDFFloat; AUnitsPerEm: Integer): single;
+begin
+  Result := AUnits * APointSize * gTTFontCache.DPI / (72 * AUnitsPerEm);
+  Result := Result * cInchToMM / gTTFontCache.DPI;
+end;
+
 function XMLEscape(const Data: string): string;
 var
   iPos, i: Integer;
@@ -2108,6 +2168,7 @@ begin
     LineWidth:=L.LineWidth;
     Color:=L.Color;
     PenStyle:=L.PenStyle;
+    DashArray:=L.DashArray;
     end
   else
     Inherited;
@@ -2410,11 +2471,12 @@ begin
   FObjects.Add(AObject);
 end;
 
-procedure TPDFPage.SetFont(AFontIndex: Integer; AFontSize: Integer);
+procedure TPDFPage.SetFont(AFontIndex: Integer; AFontSize: TPDFFloat;
+  const ASimulateBold: Boolean; const ASimulateItalic: Boolean);
 Var
   F : TPDFEmbeddedFont;
 begin
-  F:=Document.CreateEmbeddedFont(self, AFontIndex, AFontSize);
+  F:=Document.CreateEmbeddedFont(self, AFontIndex, AFontSize, ASimulateBold, ASimulateItalic);
   AddObject(F);
   FLastFont := F;
 end;
@@ -2437,6 +2499,40 @@ begin
   AddObject(L);
 end;
 
+procedure TPDFPage.SetPenStyle(ADashArray: TDashArray; const
+  ALineWidth: TPDFFloat);
+var
+  L: TPDFLineStyle;
+begin
+  L := Document.CreateLineStyle(ADashArray, ALineWidth);
+  AddObject(L);
+end;
+
+procedure TPDFPage.SetLineCapStyle(AStyle: TPDFLineCapStyle);
+var
+  C: TPDFCapStyle;
+begin
+  Document.LineCapStyle := AStyle;
+  C := Document.CreateLineCapStyle(AStyle);
+  AddObject(C);
+end;
+
+procedure TPDFPage.SetLineJoinStyle(AStyle: TPDFLineJoinStyle);
+var
+  J: TPDFJoinStyle;
+begin
+  J := Document.CreateLineJoinStyle(AStyle);
+  AddObject(J);
+end;
+
+procedure TPDFPage.SetMiterLimit(AMiterLimit: TPDFFloat);
+var
+  M: TPDFMiterLimit;
+begin
+  M := Document.CreateMiterLimit(AMiterLimit);
+  AddObject(M);
+end;
+
 procedure TPDFPage.SetLineStyle(AIndex: Integer; AStroke : Boolean = True);
 begin
   SetLineStyle(Document.LineStyles[Aindex],AStroke);
@@ -2445,7 +2541,10 @@ end;
 procedure TPDFPage.SetLineStyle(S: TPDFLineStyleDef; AStroke: Boolean = True);
 begin
   SetColor(S.Color,AStroke);
-  SetPenStyle(S.PenStyle,S.LineWidth);
+  if Length(S.DashArray) = 0 then
+    SetPenStyle(S.PenStyle, S.LineWidth)
+  else
+    SetPenStyle(S.DashArray, S.LineWidth);
 end;
 
 procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String; const ADegrees: single;
@@ -3732,7 +3831,12 @@ end;
 
 function TPDFEmbeddedFont.GetPointSize: integer;
 begin
-  Result := StrToInt(FTxtSize);
+  Result := Round(StrToFloatDef(FTxtSize, 10));
+end;
+
+function TPDFEmbeddedFont.GetFontSize: TPDFFloat;
+begin
+  Result := StrToFloatDef(FTxtSize, 10);
 end;
 
 procedure TPDFEmbeddedFont.Write(const AStream: TStream);
@@ -3803,6 +3907,17 @@ begin
   FPage := APage;
 end;
 
+constructor TPDFEmbeddedFont.Create(const ADocument: TPDFDocument; const APage: TPDFPage; const AFont: integer;
+  const ASize: TPDFFloat; const ASimulateBold, ASimulateItalic: Boolean);
+begin
+  inherited Create(ADocument);
+  FTxtFont := AFont;
+  FTxtSize := FloatStr(ASize);
+  FPage := APage;
+  FSimulateBold := ASimulateBold;
+  FSimulateItalic := ASimulateItalic;
+end;
+
 { TPDFBaseText }
 
 constructor TPDFBaseText.Create(const ADocument: TPDFDocument);
@@ -3952,8 +4067,7 @@ end;
 
 procedure TPDFUTF8Text.Write(const AStream: TStream);
 var
-  t1, t2, t3: string;
-  rad, rads, radc: single;
+  rad: single;
   lFC: TFPFontCacheItem;
   lWidth: single;
   lTextWidthInMM: single;
@@ -3962,62 +4076,119 @@ var
   lColor: string;
   lLineWidth: string;
   lDescender: single;
+  lUnderlinePos, lUnderlineSize, lStrikeOutPos, lStrikeOutSize: Single;
+  a1, b1, c1, d1, a2, b2, c2, d2: Single;
 begin
   inherited Write(AStream);
-  WriteString('BT'+CRLF, AStream);
-  if Degrees <> 0.0 then
-  begin
-    rad := DegToRad(-Degrees);
-    sincos(rad, rads, radc);
-    t1 := FloatStr(radc);
-    t2 := FloatStr(-rads);
-    t3 := FloatStr(rads);
-    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);
+  WriteString('q' + CRLF, AStream);
+  try
+    WriteString('BT'+CRLF, AStream);
 
-  if (not Underline) and (not StrikeThrough) then
-    Exit;
+    a1 := 1; b1 := 0; c1 := 0; d1 := 1;
+    if Degrees <> 0.0 then
+    begin
+      rad := DegToRad(-Degrees);
+      a1 := Cos(rad); b1 := -Sin(rad);
+      c1 := Sin(rad); d1 := a1;
+    end
+    else
+      WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
 
-  // 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
+    lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
 
-  // result is in Font Units
-  lWidth := lFC.TextWidth(FString.Value, Font.PointSize);
-  lHeight := lFC.TextHeight(FString.Value, 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;
+    { set up a pen stroke color }
+    lColor := TPDFColor.Command(True, Color);
 
-  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);
+    // do simulated bold/italic here
+    if Assigned(lFC) then
+    begin
+      if Font.SimulateBold and not lFC.IsBold then
+      begin
+        WriteString(lColor + CRLF, AStream);
+        // stroke ptSize/30 outline to simulate bold
+        WriteString(Format('2 Tr %s w', [FloatStr(Font.PointSize / 30)]) + CRLF, AStream);
+      end;
+      if Font.SimulateItalic and not lFC.IsItalic then
+      begin
+        // skew by 12 degrees
+        a2 := 1;                 b2 := 0;
+        c2 := Tan(DegToRad(12)); d2 := 1;
+        // combine matrices: skew x rotate (skew first, then rotate)
+        a1 := a2 * a1 + b2 * c1;
+        b1 := a2 * b1 + b2 * d1;
+        c1 := c2 * a1 + d2 * c1;
+        d1 := c2 * b1 + d2 * d1;
+      end;
+    end;
+    // write transformation matrix (Tm)
+    if (Degrees <> 0.0) or (Font.SimulateItalic and not lFC.IsItalic) then
+      WriteString(Format('%s %s %s %s %s %s Tm',
+        [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1),
+         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);
+    FString.Write(AStream);
+    WriteString(' Tj'+CRLF, AStream);
+    WriteString('ET'+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);
+    if (not Underline) and (not StrikeThrough) then
+      Exit;
 
-  { restore graphics state to before the translation matrix adjustment }
-  WriteString('Q' + CRLF, AStream);
+    // implement Underline and Strikethrough here
+    if not Assigned(lFC) then
+      Exit;  // we can't do anything further
 
+    // result is in Font Units
+    lWidth := lFC.TextWidth(FString.Value, Font.PointSize);
+    lHeight := lFC.TextHeight(FString.Value, 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('%s %s %s %s %s %s cm', [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1), FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+    else
+      // horizontal text
+      WriteString(Format('1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+    with lFC.FontData do
+    begin
+      { line segment is relative to matrix translation coordinate, set above }
+      if Underline then
+      begin
+        // fallback default values
+        lUnderlinePos := PDFTomm(-1.5);
+        lUnderlineSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if PostScript.UnderlinePosition <> 0 then
+          lUnderlinePos := FontUnitsTomm(PostScript.UnderlinePosition, Font.PointSize, Head.UnitsPerEm);
+        if PostScript.underlineThickness <> 0 then
+          lUnderlineSize := FontUnitsTomm(PostScript.underlineThickness, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lUnderlineSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lUnderlinePos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+      if StrikeThrough then
+      begin
+        // fallback default values
+        lStrikeOutPos := lTextHeightInMM / 2;
+        lStrikeOutSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if OS2Data.yStrikeoutPosition <> 0 then
+          lStrikeOutPos := FontUnitsTomm(OS2Data.yStrikeoutPosition, Font.PointSize, Head.UnitsPerEm);
+        if OS2Data.yStrikeoutSize <> 0 then
+          lStrikeOutSize := FontUnitsTomm(OS2Data.yStrikeoutSize, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lStrikeOutSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lStrikeOutPos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+    end;
+  finally
+    { restore graphics state to before the translation matrix adjustment }
+    WriteString('Q' + CRLF, AStream);
+  end;
 end;
 
 constructor TPDFUTF8Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String;
@@ -4055,65 +4226,122 @@ var
   lColor: string;
   lLineWidth: string;
   lDescender: single;
+  lUnderlinePos, lUnderlineSize, lStrikeOutPos, lStrikeOutSize: Single;
+  a1, b1, c1, d1, a2, b2, c2, d2: Single;
   v : UTF8String;
   
 begin
   inherited Write(AStream);
-  WriteString('BT'+CRLF, AStream);
-  if Degrees <> 0.0 then
-  begin
-    rad := DegToRad(-Degrees);
-    sincos(rad, rads, radc);
-    t1 := FloatStr(radc);
-    t2 := FloatStr(-rads);
-    t3 := FloatStr(rads);
-    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);
+  WriteString('q' + CRLF, AStream);
+  try
+    WriteString('BT'+CRLF, AStream);
 
-  if (not Underline) and (not StrikeThrough) then
-    Exit;
+    a1 := 1; b1 := 0; c1 := 0; d1 := 1;
+    if Degrees <> 0.0 then
+    begin
+      rad := DegToRad(-Degrees);
+      a1 := Cos(rad); b1 := -Sin(rad);
+      c1 := Sin(rad); d1 := a1;
+    end
+    else
+      WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
 
-  // 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
+    lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
 
-  // 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;
+    { set up a pen stroke color }
+    lColor := TPDFColor.Command(True, Color);
 
-  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);
+    // do simulated bold/italic here
+    if Assigned(lFC) then
+    begin
+      if Font.SimulateBold and not lFC.IsBold then
+      begin
+        WriteString(lColor + CRLF, AStream);
+        // stroke ptSize/30 outline to simulate bold
+        WriteString(Format('2 Tr %s w', [FloatStr(Font.PointSize / 30)]) + CRLF, AStream);
+      end;
+      if Font.SimulateItalic and not lFC.IsItalic then
+      begin
+        // skew by 12 degrees
+        a2 := 1;                 b2 := 0;
+        c2 := Tan(DegToRad(12)); d2 := 1;
+        // combine matrices: skew x rotate (skew first, then rotate)
+        a1 := a2 * a1 + b2 * c1;
+        b1 := a2 * b1 + b2 * d1;
+        c1 := c2 * a1 + d2 * c1;
+        d1 := c2 * b1 + d2 * d1;
+      end;
+    end;
+    // write transformation matrix (Tm)
+    if (Degrees <> 0.0) or (Font.SimulateItalic and not lFC.IsItalic) then
+      WriteString(Format('%s %s %s %s %s %s Tm',
+        [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1),
+         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);
+    FString.Write(AStream);
+    WriteString(' Tj'+CRLF, AStream);
+    WriteString('ET'+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);
+    if (not Underline) and (not StrikeThrough) then
+      Exit;
 
-  { restore graphics state to before the translation matrix adjustment }
-  WriteString('Q' + CRLF, AStream);
+    // implement Underline and Strikethrough here
+    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('%s %s %s %s %s %s cm', [FloatStr(a1), FloatStr(b1), FloatStr(c1), FloatStr(d1), FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+    else
+      // horizontal text
+      WriteString(Format('1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
 
+    with lFC.FontData do
+    begin
+      { line segment is relative to matrix translation coordinate, set above }
+      if Underline then
+      begin
+        // fallback default values
+        lUnderlinePos := PDFTomm(-1.5);
+        lUnderlineSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if PostScript.UnderlinePosition <> 0 then
+          lUnderlinePos := FontUnitsTomm(PostScript.UnderlinePosition, Font.PointSize, Head.UnitsPerEm);
+        if PostScript.underlineThickness <> 0 then
+          lUnderlineSize := FontUnitsTomm(PostScript.underlineThickness, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lUnderlineSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lUnderlinePos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+      if StrikeThrough then
+      begin
+        // fallback default values
+        lStrikeOutPos := lTextHeightInMM / 2;
+        lStrikeOutSize := lTextHeightInMM / 12;
+        // use font metrics, if present
+        if OS2Data.yStrikeoutPosition <> 0 then
+          lStrikeOutPos := FontUnitsTomm(OS2Data.yStrikeoutPosition, Font.PointSize, Head.UnitsPerEm);
+        if OS2Data.yStrikeoutSize <> 0 then
+          lStrikeOutSize := FontUnitsTomm(OS2Data.yStrikeoutSize, Font.PointSize, Head.UnitsPerEm);
+
+        lLineWidth := FloatStr(mmToPDF(lStrikeOutSize)) + ' w ';
+        WriteString(lLineWidth + lColor + CRLF, AStream);
+        WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lStrikeOutPos)), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+      end;
+    end;
+  finally
+    { restore graphics state to before the translation matrix adjustment }
+    WriteString('Q' + CRLF, AStream);
+  end;
 end;
 
 constructor TPDFUTF16Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UnicodeString;
@@ -4317,6 +4545,9 @@ var
   w: TPDFFloat;
 begin
   w := FLineWidth;
+  if FLineMask <> '' then
+    lMask := FLineMask
+  else
   case FStyle of
     ppsSolid:
       begin
@@ -4349,6 +4580,58 @@ begin
   FStyle := AStyle;
   FPhase := APhase;
   FLineWidth := ALineWidth;
+  FLineMask := '';
+end;
+
+constructor TPDFLineStyle.Create(const ADocument : TPDFDocument;
+  ADashArray: TDashArray; APhase: integer; ALineWidth: TPDFFloat);
+var
+  i: Integer;
+begin
+  Create(ADocument, ppsSolid, APhase, ALineWidth);
+  // custom line style
+  for i := Low(ADashArray) to High(ADashArray) do
+  begin
+    if FLineMask <> '' then FLineMask := FLineMask + ' ';
+    FLineMask := FLineMask + FloatStr(ADashArray[i] * ALineWidth);
+  end;
+end;
+
+procedure TPDFCapStyle.Write(const AStream: TStream);
+begin
+  inherited Write(AStream);
+  WriteString(IntToStr(Ord(FStyle)) + ' J' + CRLF, AStream);
+end;
+
+constructor TPDFCapStyle.Create(const ADocument: TPDFDocument;
+  AStyle: TPDFLineCapStyle);
+begin
+  inherited Create(ADocument);
+  FStyle := AStyle;
+end;
+
+procedure TPDFJoinStyle.Write(const AStream: TStream);
+begin
+  inherited Write(AStream);
+  WriteString(IntToStr(Ord(FStyle)) + ' j' + CRLF, AStream);
+end;
+
+constructor TPDFJoinStyle.Create(const ADocument: TPDFDocument; AStyle: TPDFLineJoinStyle);
+begin
+  inherited Create(ADocument);
+  FStyle := AStyle;
+end;
+
+procedure TPDFMiterLimit.Write(const AStream: TStream);
+begin
+  inherited Write(AStream);
+  WriteString(FloatStr(FMiterLimit) + ' M' + CRLF, AStream);
+end;
+
+constructor TPDFMiterLimit.Create(const ADocument: TPDFDocument; AMiterLimit: TPDFFloat);
+begin
+  inherited Create(ADocument);
+  FMiterLimit := AMiterLimit;
 end;
 
 Function ARGBGetRed(AColor : TARGBColor) : Byte;
@@ -6120,9 +6403,11 @@ begin
     Result := False;
 end;
 
-function TPDFDocument.CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize: Integer): TPDFEmbeddedFont;
+function TPDFDocument.CreateEmbeddedFont(const APage: TPDFPage; AFontIndex: Integer;
+  AFontSize: TPDFFloat; const ASimulateBold: Boolean;
+  const ASimulateItalic: Boolean): TPDFEmbeddedFont;
 begin
-  Result:=TPDFEmbeddedFont.Create(Self, APage, AFontIndex, IntToStr(AFontSize))
+  Result:=TPDFEmbeddedFont.Create(Self, APage, AFontIndex, AFontSize, ASimulateBold, ASimulateItalic);
 end;
 
 function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont;
@@ -6194,6 +6479,27 @@ begin
   Result := TPDFLineStyle.Create(Self, APenStyle, 0, ALineWidth);
 end;
 
+function TPDFDocument.CreateLineStyle(ADashArray: TDashArray; const
+  ALineWidth: TPDFFloat): TPDFLineStyle;
+begin
+  Result := TPDFLineStyle.Create(Self, ADashArray, 0, ALineWidth);
+end;
+
+function TPDFDocument.CreateLineCapStyle(ALineCapStyle: TPDFLineCapStyle): TPDFCapStyle;
+begin
+  Result := TPDFCapStyle.Create(Self, ALineCapStyle);
+end;
+
+function TPDFDocument.CreateLineJoinStyle(ALineJoinStyle: TPDFLineJoinStyle): TPDFJoinStyle;
+begin
+  Result := TPDFJoinStyle.Create(Self, ALineJoinStyle);
+end;
+
+function TPDFDocument.CreateMiterLimit(AMiterLimit: TPDFFloat): TPDFMiterLimit;
+begin
+  Result := TPDFMiterLimit.Create(Self, AMiterLimit);
+end;
+
 function TPDFDocument.CreateName(AValue: String; const AMustEscape: boolean = True): TPDFName;
 begin
   Result:=TPDFName.Create(Self,AValue,AMustEscape);
@@ -6272,9 +6578,17 @@ begin
   F.LineWidth:=ALineWidth;
   F.Color:=AColor;
   F.PenStyle:=APenStyle;
+  F.DashArray:=[];
   Result:=FLineStyleDefs.Count-1;
 end;
 
+function TPDFDocument.AddLineStyleDef(ALineWidth: TPDFFloat; AColor: TARGBColor;
+  ADashArray: TDashArray) : Integer;
+begin
+  Result := AddLineStyleDef(ALineWidth, AColor, ppsSolid);
+  if Result >= 0 then
+    LineStyles[Result].DashArray := ADashArray;
+end;
 
 initialization
   PDFFormatSettings:= DefaultFormatSettings;