cairocanvas: fix printing stricked/underlined text, issue #26624

git-svn-id: trunk@46077 -

components/cairocanvas/cairocanvas.pas

@@ -35,6 +35,7 @@ type
     fFontDesc: PPangoFontDescription;
     fFontDescStr: string;
     function StylesToStr(Styles: TFontStyles):string;
+    procedure UpdatePangoLayout(Layout: PPangoLayout);
     {$endif}
     procedure SelectFontEx(AStyle: TFontStyles; const AName: string;
       ASize: double);
@@ -652,6 +653,40 @@ begin
   if fsItalic in Styles then
     Result := Result + 'italic ';
 end;
+
+procedure TCairoPrinterCanvas.UpdatePangoLayout(Layout: PPangoLayout);
+var
+  AttrListTemporary: Boolean;
+  AttrList: PPangoAttrList;
+  Attr: PPangoAttribute;
+begin
+  if Font.Underline or Font.StrikeThrough then begin
+
+    AttrListTemporary := false;
+    AttrList := pango_layout_get_attributes(Layout);
+    if (AttrList = nil) then
+    begin
+      AttrList := pango_attr_list_new();
+      AttrListTemporary := True;
+    end;
+    if Font.Underline then
+      Attr := pango_attr_underline_new(PANGO_UNDERLINE_SINGLE)
+    else
+      Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
+    pango_attr_list_change(AttrList, Attr);
+
+    Attr := pango_attr_strikethrough_new(Font.StrikeThrough);
+    pango_attr_list_change(AttrList, Attr);
+
+    pango_layout_set_attributes(Layout, AttrList);
+
+    pango_cairo_update_layout(cr, Layout);
+
+    if AttrListTemporary then
+      pango_attr_list_unref(AttrList);
+  end;
+end;
+
 {$endif}
 
 procedure TCairoPrinterCanvas.FillAndStroke;
@@ -941,6 +976,7 @@ begin
   // use absolute font size sintax  (px)
   Layout := Pango_Cairo_Create_Layout(cr);
   pango_layout_set_font_description(layout, fFontDesc);
+  UpdatePangoLayout(Layout);
   {$endif}
   if Font.Orientation = 0 then
   begin
@@ -1112,6 +1148,7 @@ begin
     {$ifdef pangocairo}
     Layout := Pango_Cairo_Create_Layout(cr);
     pango_layout_set_font_description(layout, fFontDesc);
+    UpdatePangolayout(Layout);
     {$else}
     cairo_font_extents(cr, @fe);
     {$endif}

components/cairocanvas/tests/24217/unit1.lfm

@@ -20,7 +20,7 @@ object Form1: TForm1
   object btn24217: TButton
     Left = 548
     Height = 25
-    Top = 36
+    Top = 32
     Width = 75
     Caption = 'btn24217'
     OnClick = btn24217Click
@@ -29,17 +29,17 @@ object Form1: TForm1
   object btn19435: TButton
     Left = 548
     Height = 25
-    Top = 68
+    Top = 64
     Width = 75
     Caption = 'btn19435'
     OnClick = btn19435Click
     TabOrder = 2
   end
   object chkTests: TCheckGroup
-    Left = 526
+    Left = 520
-    Height = 80
+    Height = 88
     Top = 144
-    Width = 97
+    Width = 103
     AutoFill = True
     Caption = 'Paint or Print'
     ChildSizing.LeftRightSpacing = 6
@@ -50,17 +50,18 @@ object Form1: TForm1
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
     ChildSizing.ControlsPerLine = 1
-    ClientHeight = 57
+    ClientHeight = 65
-    ClientWidth = 93
+    ClientWidth = 99
     Items.Strings = (
       '24217'
       '19435'
       'Other'
+      'Underline'
     )
     OnItemClick = chkTestsItemClick
     TabOrder = 3
     Data = {
-      03000000020202
+      0400000002020202
     }
   end
   object btnPrintAll: TButton
@@ -75,7 +76,7 @@ object Form1: TForm1
   object btnOther: TButton
     Left = 548
     Height = 25
-    Top = 100
+    Top = 96
     Width = 75
     Caption = 'btnOther'
     OnClick = btnOtherClick
@@ -139,6 +140,15 @@ object Form1: TForm1
     )
     TabOrder = 7
   end
+  object btnUnderline: TButton
+    Left = 548
+    Height = 25
+    Top = 124
+    Width = 75
+    Caption = 'btnUnderline'
+    OnClick = btnUnderlineClick
+    TabOrder = 8
+  end
   object PrintDialog1: TPrintDialog
     left = 129
     top = 28

components/cairocanvas/tests/24217/unit1.pas

@@ -13,6 +13,7 @@ type
   { TForm1 }
 
   TForm1 = class(TForm)
+    btnUnderline: TButton;
     Button1: TButton;
     btn24217: TButton;
     btn19435: TButton;
@@ -25,6 +26,7 @@ type
     procedure btn19435Click(Sender: TObject);
     procedure btnOtherClick(Sender: TObject);
     procedure btnPrintAllClick(Sender: TObject);
+    procedure btnUnderlineClick(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure btn24217Click(Sender: TObject);
     procedure chkTestsItemClick(Sender: TObject; Index: integer);
@@ -33,10 +35,12 @@ type
     procedure Draw19435(cnv: TCanvas; XDPI,YDPI: Integer);
     procedure Draw24217(cnv: TCanvas; XDPI,YDPI: Integer);
     procedure DrawOther(cnv: TCanvas; XDPI,YDPI: Integer);
+    procedure DrawUnderline(cnv: TCanvas; XDPI,YDPI: Integer);
     function GetOtherAlignment:TAlignment;
     function GetOtherLayout:TTextLayout;
     procedure GetReferencePoint(const r: TRect; cnv:TCanvas; out x, y: Integer);
     procedure PrintOther(aFileName: string = 'other'; aBackend: TCairoBackend = cbPDF);
+    procedure PrintUnderline(aFileName: string = 'underline'; aBackend: TCairoBackend = cbPDF);
   public
     { public declarations }
   end;
@@ -131,6 +135,11 @@ begin
   end;
 end;
 
+procedure TForm1.btnUnderlineClick(Sender: TObject);
+begin
+  PrintUnderline;
+end;
+
 procedure TForm1.btn24217Click(Sender: TObject);
 var
   CairoPrinter: TCairoFilePrinter;
@@ -160,6 +169,7 @@ begin
   if chkTests.Checked[0] then Draw24217(Canvas, ResX, ResY);
   if chkTests.Checked[1] then Draw19435(Canvas, ResX, ResY);
   if chkTests.Checked[2] then DrawOther(Canvas, ResX, ResY);
+  if chkTests.Checked[3] then DrawUnderline(Canvas, ResX, ResY);
 end;
 
 procedure TForm1.Draw19435(cnv: TCanvas; XDPI, YDPI: Integer);
@@ -375,6 +385,65 @@ begin
     format('Alignment: "%s" Layout: "%s" Orientation: %d° ',[sA, sL, radOtherAngle.ItemIndex * 90]));
 end;
 
+procedure TForm1.DrawUnderline(cnv: TCanvas; XDPI, YDPI: Integer);
+const
+  STEXT = 'Pájaro';
+var
+  y: Integer;
+  sz: TSize;
+  R: TRect;
+begin
+
+  // using TextOut
+  R := Rect(XDPI, YDPI, 0, 0);
+  cnv.Font.Name := 'Arial';
+  cnv.Font.Size := 40;
+  cnv.Font.Color := clBlue;
+  cnv.Font.Orientation:=0;
+  cnv.Font.Underline := false;
+  y := R.Top;
+  cnv.TextOut(R.Left, y, STEXT);
+  cnv.Font.Underline := true;
+
+  sz := cnv.TextExtent(STEXT);
+  inc(y, sz.cy);
+  cnv.TextOut(XDPI, y, STEXT);
+
+  cnv.Font.Underline := false;
+  cnv.Font.StrikeThrough := true;
+  inc(y, sz.cy);
+  cnv.TextOut(XDPI, y, STEXT);
+
+  cnv.Font.Underline := true;
+  cnv.Font.StrikeThrough := true;
+  inc(y, sz.cy);
+  cnv.TextOut(XDPI, y, STEXT);
+
+  // using TextRect
+  cnv.Font.Color:= clRed;
+  cnv.Font.Underline := false;
+  cnv.Font.StrikeThrough := false;
+  OffsetRect(R, 2*XDPI, 0);
+  R.Right := R.Left + sz.cx;
+  R.Bottom := R.Top + sz.cy;
+  cnv.TextRect(R, R.Left, R.Top, STEXT);
+
+  OffsetRect(R, 0, sz.cy);
+  cnv.Font.Underline := true;
+  cnv.Font.StrikeThrough := false;
+  cnv.TextRect(R, R.Left, R.Top, STEXT);
+
+  OffsetRect(R, 0, sz.cy);
+  cnv.Font.Underline := false;
+  cnv.Font.StrikeThrough := true;
+  cnv.TextRect(R, R.Left, R.Top, STEXT);
+
+  OffsetRect(R, 0, sz.cy);
+  cnv.Font.Underline := true;
+  cnv.Font.StrikeThrough := true;
+  cnv.TextRect(R, R.Left, R.Top, STEXT);
+end;
+
 function TForm1.GetOtherAlignment: TAlignment;
 begin
   case radOtherAlign.ItemIndex of
@@ -438,5 +507,20 @@ begin
   CairoPrinter.Free;
 end;
 
+procedure TForm1.PrintUnderline(aFileName: string = 'underline'; aBackend: TCairoBackend = cbPDF);
+var
+  CairoPrinter: TCairoFilePrinter;
+begin
+  CairoPrinter := TCairoFilePrinter.create;
+  //CairoPrinter.CairoBackend:=cbPS;
+  CairoPrinter.CairoBackend:=aBackend;
+  CairoPrinter.FileName:=aFileName;
+  CairoPrinter.BeginDoc;
+  with CairoPrinter do
+    DrawUnderline(Canvas, XDPI, YDPI);
+  CairoPrinter.EndDoc;
+  CairoPrinter.Free;
+end;
+
 end.