diff --git a/components/cairocanvas/cairocanvas.pas b/components/cairocanvas/cairocanvas.pas index a478bc84f0..44c5cd51e0 100644 --- a/components/cairocanvas/cairocanvas.pas +++ b/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} diff --git a/components/cairocanvas/tests/24217/unit1.lfm b/components/cairocanvas/tests/24217/unit1.lfm index 446af51b3e..870d38d43e 100644 --- a/components/cairocanvas/tests/24217/unit1.lfm +++ b/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 - Height = 80 + Left = 520 + 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 - ClientWidth = 93 + ClientHeight = 65 + 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 diff --git a/components/cairocanvas/tests/24217/unit1.pas b/components/cairocanvas/tests/24217/unit1.pas index f74c738db5..05bb1f3f01 100644 --- a/components/cairocanvas/tests/24217/unit1.pas +++ b/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.