paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-27 18:09:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

CairoCanvas, Implements TextOut using CairoPango, from Julio Jiménez Borreguero

Browse Source 
git-svn-id: trunk@40668 -
This commit is contained in:
jesus 2013-03-29 19:41:35 +00:00
parent e4fb69076a
commit b067464acc
1 changed files with 54 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
components/cairocanvas/cairocanvas.pas
View File

@ -37,6 +37,10 @@ type
procedure FillAndStroke; procedure FillAndStroke;
procedure FillOnly; procedure FillOnly;
procedure StrokeOnly; procedure StrokeOnly;
{$ifdef pangocairo}
function StylesToStr(Styles: TFontStyles):string;
function StyleToStr(Style: TFontStyle):string;
{$endif}
protected protected
cr: Pcairo_t; cr: Pcairo_t;
ScaleX, ScaleY, FontScale: Double; ScaleX, ScaleY, FontScale: Double;
@ -389,6 +393,26 @@ begin
end; end;
end; end;
{$ifdef pangocairo}
function TCairoPrinterCanvas.StylesToStr(Styles: TFontStyles): string;
begin
Result := '';
if fsBold in Styles then
Result := Result + 'bold ';
if fsItalic in Styles then
Result := Result + 'italic ';
end;
function TCairoPrinterCanvas.StyleToStr(Style: TFontStyle): string;
begin
result := '';
case Style of
fsBold: result := 'bold ';
fsItalic: result := 'italic ';
end;
end;
{$endif}
procedure TCairoPrinterCanvas.FillAndStroke; procedure TCairoPrinterCanvas.FillAndStroke;
begin begin
if Brush.Style <> bsClear then begin if Brush.Style <> bsClear then begin
@ -583,25 +607,52 @@ end;
procedure TCairoPrinterCanvas.TextOut(X, Y: Integer; const Text: String); procedure TCairoPrinterCanvas.TextOut(X, Y: Integer; const Text: String);
var var
e: cairo_font_extents_t; e: cairo_font_extents_t;
{$ifdef pangocairo}
Layout: PPangoLayout;
desc: PPangoFontDescription;
theFont: string;
{$endif}
begin begin
Changing; Changing;
RequiredState([csHandleValid, csFontValid, csBrushValid]); RequiredState([csHandleValid, csFontValid, csBrushValid]);
SelectFont; SelectFont;
cairo_font_extents(cr, @e); cairo_font_extents(cr, @e);
cairo_save(cr);
{$ifdef pangocairo}
// use absolute font size sintax (px)
theFOnt := format('%s %s %dpx',[Font.name, StylesToStr(Font.Style), abs(Font.Size)]);
Layout := Pango_Cairo_Create_Layout(cr);
desc := pango_font_description_from_string(pchar(TheFont));
pango_layout_set_font_description(layout, desc);
{$endif}
if Font.Orientation = 0 then if Font.Orientation = 0 then
begin begin
cairo_move_to(cr, SX(X), SY(Y)+e.ascent); cairo_move_to(cr, SX(X), SY(Y)+e.ascent);
{$ifdef pangocairo}
pango_layout_set_text(layout, PChar(Text), -1);
{$else}
cairo_show_text(cr, PChar(Text)); //Reference point is on the base line cairo_show_text(cr, PChar(Text)); //Reference point is on the base line
{$endif}
end end
else else
begin begin
cairo_save(cr);
cairo_move_to(cr, SX(X)+e.ascent, SY(Y)); cairo_move_to(cr, SX(X)+e.ascent, SY(Y));
cairo_rotate(cr, -gradtorad(Font.Orientation)); cairo_rotate(cr, -gradtorad(Font.Orientation));
cairo_show_text(cr, PChar(Text)); {$ifdef pangocairo}
cairo_restore(cr); pango_layout_set_text(layout, PChar(Text), -1);
{$else}
cairo_show_text(cr, PChar(Text)); //Reference point is on the base line
{$endif}
end; end;
{$ifdef pangocairo}
pango_cairo_update_layout(cr, layout);
// get the same text origin as cairo_show_text (baseline left, instead of Pango's top left)
pango_cairo_show_layout_line (cr, pango_layout_get_line (layout, 0));
g_object_unref(layout);
pango_font_description_free(desc);
{$endif}
cairo_restore(cr);
Changed; Changed;
end; end;
@ -650,25 +701,6 @@ var
LastBreakEndL := 0; LastBreakEndL := 0;
LastBreakStart := 0; LastBreakStart := 0;
end; end;
{$ifdef pangocairo}
function StylesToStr(Styles: TFontStyles):string;
begin
Result := '';
if fsBold in Styles then
Result := Result + 'bold ';
if fsItalic in Styles then
Result := Result + 'italic ';
end;
function StyleToStr(Style: TFontStyle):string;
begin
result := '';
case Style of
fsBold: result := 'bold ';
fsItalic: result := 'italic ';
end;
end;
{$endif}
var var
te: cairo_text_extents_t; te: cairo_text_extents_t;
fd: TFontData; fd: TFontData;
@ -679,7 +711,6 @@ var
BreakBoxWidth: Double; BreakBoxWidth: Double;
x, y: Double; x, y: Double;
{$ifdef pangocairo} {$ifdef pangocairo}
//--------
Layout: PPangoLayout; Layout: PPangoLayout;
desc: PPangoFontDescription; desc: PPangoFontDescription;
theFont: string; theFont: string;