From dd67f6e7bc8c95d46f6f75e9c97a6d556dd21e7e Mon Sep 17 00:00:00 2001
From: jesus <jesus@lazarus-ide.org>
Date: Thu, 20 Nov 2014 20:13:11 +0000
Subject: [PATCH] LCL, PostscriptCanvas: improved underline position

git-svn-id: trunk@46908 -
---
 lcl/postscriptcanvas.pas | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

diff --git a/lcl/postscriptcanvas.pas b/lcl/postscriptcanvas.pas
index 85e4afaff4..f8289b2be1 100644
--- a/lcl/postscriptcanvas.pas
+++ b/lcl/postscriptcanvas.pas
@@ -79,7 +79,7 @@ Type
 
     procedure psDrawRect(ARect:TRect);
     procedure WriteHeader(St : String);
-    procedure Write(const St : String; Lst : TstringList = nil); overload;
+    procedure Write(const St : String; Lst : TStringList = nil); overload;
     procedure WriteB(const St : string);
     procedure ClearBuffer;
     procedure Write(Lst : TStringList); overload;
@@ -112,6 +112,7 @@ Type
     function  GetFontIndex: Integer;
     function  FontUnitsToPixelsX(const Value:Integer): Integer;
     function  FontUnitsToPixelsY(const Value:Integer): Integer;
+    function  FontUnitsToPixelsY(const Value:Double): Integer;
   protected
     procedure CreateHandle; override;
     procedure CreateBrush; override;
@@ -665,7 +666,7 @@ begin
 end;
 
 //Write an instruction in the document
-procedure TPostScriptPrinterCanvas.Write(const St: String; Lst : TStringList = Nil);
+procedure TPostScriptPrinterCanvas.Write(const St: String; Lst: TStringList = nil);
 begin
   If not Assigned(Lst) then
     Lst:=fDocument;
@@ -1152,6 +1153,17 @@ begin
   result := Round(Value*Abs(GetFontSize/72)*0.001*YDPI);
 end;
 
+function TPostScriptPrinterCanvas.FontUnitsToPixelsY(const Value: Double
+  ): Integer;
+var
+  FontSize: Integer;
+begin
+  FontSize := GetFontSize;
+  if FontSize<0 then
+    FontSize := -FontSize;
+  result := Round(Value*FontSize/72*0.001*YDPI);
+end;
+
 procedure TPostScriptPrinterCanvas.CreateHandle;
 begin
   SetHandle(1); // set dummy handle
@@ -2040,10 +2052,11 @@ end;
 //Out the text at the X,Y coord. Set the font
 procedure TPostScriptPrinterCanvas.TextOut(X, Y: Integer; const Text: String);
 var
-  PenUnder : Real;
+  PenUnder : Double;
   PosUnder : Integer;
   pp:TpsPoint;
   saved:boolean;
+  FontIndex: Integer;
 
   procedure rotate;
   begin
@@ -2073,10 +2086,19 @@ begin
   
   if fsUnderline in Font.Style then
   begin
+    FontIndex := GetFontIndex;
+
+    PosUnder := FontUnitsToPixelsY(cFontPSMetrics[FontIndex].ULPos);
+
+    // The current heuristics produces better underline thickness
+    {$IFDEF UseFontUnderlineThickness}
+    PenUnder := FontUnitsToPixelsY(cFontPSMetrics[FontIndex].ULThickness);
+    {$else}
     PenUnder:=0.5;
     if fsBold in Font.Style then
       PenUnder:=1.0;
-    PosUnder:=(Abs(Round(GetFontSize/3))*-1)+2;
+    {$endif}
+
     Write(format('%f %f uli',[pp.fx,pp.fy],FFs));
     if Font.Orientation<>0 then
       rotate();