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

aggpas: started pango in agglcl

Browse Source 
git-svn-id: trunk@23074 -
This commit is contained in:
mattias 2009-12-10 19:06:46 +00:00
parent c982292bf9
commit 32b72756c1
2 changed files with 32 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/aggpas/lazarus/example/unit3.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, LCLProc, FileUtil, LResources, Forms, Controls, Graphics, Classes, SysUtils, LCLProc, FileUtil, LResources, Forms, Controls, Graphics,
Dialogs, FPimage, agg_fpimage, Agg_LCL, pango, LCLType, GTKProc, GtkDef, gtk2; Dialogs, FPimage, agg_fpimage, Agg_LCL;
type type
@ -20,7 +20,6 @@ type
public public
AggLCLCanvas: TAggLCLCanvas; AggLCLCanvas: TAggLCLCanvas;
Bitmap1: TBitmap; Bitmap1: TBitmap;
procedure CreatePangoFont(AggFont: TAggLCLFont);
end; end;
var var
@ -32,8 +31,6 @@ implementation
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
var var
HasFont: Boolean;
FontFilename: String;
s: String; s: String;
TxtW: integer; TxtW: integer;
TxtH: integer; TxtH: integer;
@ -46,17 +43,16 @@ begin
Image.PixelFormat:=afpimRGBA32; Image.PixelFormat:=afpimRGBA32;
Image.SetSize(500,500); Image.SetSize(500,500);
end; end;
HasFont:=true;
// paint to agg canvas // paint to agg canvas
with AggLCLCanvas do begin with AggLCLCanvas do begin
if HasFont then begin {if HasFont then begin
FontFilename:=SetDirSeparators('../../verdana.ttf'); FontFilename:=SetDirSeparators('../../verdana.ttf');
if not FileExists(FontFilename) then raise Exception.Create('file not found: '+FontFilename+' CurDir='+GetCurrentDirUTF8); if not FileExists(FontFilename) then raise Exception.Create('file not found: '+FontFilename+' CurDir='+GetCurrentDirUTF8);
Font.LoadFromFile(FontFilename); Font.LoadFromFile(FontFilename);}
Font.Size:=10; Font.Size:=10;
Font.Color:=clBlack; Font.Color:=clBlack;
end; Font.LoadViaPango;
// solid white background // solid white background
Brush.Color:=clWhite; Brush.Color:=clWhite;
@ -72,7 +68,6 @@ begin
TxtY:=40; TxtY:=40;
FillRect(TxtX,TxtY,TxtX+TxtW,TxtY+TxtH); FillRect(TxtX,TxtY,TxtX+TxtW,TxtY+TxtH);
TextOut(TxtX,TxtY,s); TextOut(TxtX,TxtY,s);
end; end;
// convert to LCL native pixel format // convert to LCL native pixel format
@ -107,24 +102,6 @@ begin
Canvas.Draw(0,0,Bitmap1); Canvas.Draw(0,0,Bitmap1);
end; end;
procedure TForm1.CreatePangoFont(AggFont: TAggLCLFont);
var
FullString: String;
PangoDesc: PPangoFontDescription;
PangoLayout: PPangoLayout;
begin
FullString := AggFont.Name+' '+IntToStr(AggFont.Size);
PangoDesc := pango_font_description_from_string(PChar(FullString));
if AggFont.Bold then
pango_font_description_set_weight(PangoDesc, FW_BOLD);
if AggFont.Italic then
pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC);
pango_font_description_set_size(PangoDesc, AggFont.Size*PANGO_SCALE);
PangoLayout:=gtk_widget_create_pango_layout(GetStyleWidget(lgsdefault), nil);
pango_layout_set_font_description(PangoLayout,PangoDesc);
end;
initialization initialization
{$I unit3.lrs} {$I unit3.lrs}

26
components/aggpas/src/agg_lcl.pas
View File

@ -12,6 +12,9 @@ uses
Windows , Windows ,
{$ENDIF} {$ENDIF}
Classes ,Graphics, LCLProc, types, IntfGraphics, GraphType, FPimage, FPCanvas, Classes ,Graphics, LCLProc, types, IntfGraphics, GraphType, FPimage, FPCanvas,
{$IFDEF LCLGtk2}
pango, LCLType, GTKProc, GtkDef, gtk2,
{$ENDIF}
agg_arc, GraphMath, agg_fpimage, agg_basics; agg_arc, GraphMath, agg_fpimage, agg_basics;
type type
@ -66,6 +69,9 @@ type
constructor Create; override; constructor Create; override;
function AggHeightToSize(const h: double): double; override; function AggHeightToSize(const h: double): double; override;
function SizeToAggHeight(const s: double): double; override; function SizeToAggHeight(const s: double): double; override;
{$IFDEF LCLGtk2}
procedure LoadViaPango;
{$ENDIF}
property Color: TColor read FColor write SetColor; property Color: TColor read FColor write SetColor;
property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch; property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
end; end;
@ -801,6 +807,26 @@ begin
Result:=s*FPixelsPerInch / 72; Result:=s*FPixelsPerInch / 72;
end; end;
{$IFDEF LCLGtk2}
procedure TAggLCLFont.LoadViaPango;
var
FullString: String;
PangoDesc: PPangoFontDescription;
PangoLayout: PPangoLayout;
begin
FullString := Name+' '+IntToStr(Size);
PangoDesc := pango_font_description_from_string(PChar(FullString));
if Bold then
pango_font_description_set_weight(PangoDesc, FW_BOLD);
if Italic then
pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC);
pango_font_description_set_size(PangoDesc, Size*PANGO_SCALE);
PangoLayout:=gtk_widget_create_pango_layout(GetStyleWidget(lgsdefault), nil);
pango_layout_set_font_description(PangoLayout,PangoDesc);
end;
{$ENDIF}
{ TAggLCLImage } { TAggLCLImage }
procedure TAggLCLImage.ReallocData; procedure TAggLCLImage.ReallocData;