mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-06 09:19:37 +01:00
cairocanvas: fix printing stricked/underlined text, issue #26624
git-svn-id: trunk@46077 -
This commit is contained in:
jesus
parent
6cbf4971ee
commit
46c9fdc58b
@ -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}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user