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

aggpas: improved font position and size

Browse Source 
git-svn-id: trunk@22924 -
This commit is contained in:
mattias 2009-12-02 14:06:15 +00:00
parent 2925e33ef7
commit 0d614ca60b
4 changed files with 59 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/aggpas/lazarus/example/AggPasInLCLDemo1.lpi
View File

@ -6,7 +6,6 @@
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<TargetFileExt Value=""/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>

23
components/aggpas/lazarus/example/unit2.pas
View File

@ -30,6 +30,9 @@ implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
HasFont: Boolean;
FontFilename: String;
begin
Bitmap1:=TBitmap.Create;
AggLCLCanvas:=TAggLCLCanvas.Create;
@ -37,9 +40,22 @@ begin
Image.PixelFormat:=afpimRGBA32;
Image.SetSize(250,250);
end;
{$IFDEF LCLGtk2}
HasFont:=true;
{$ELSE}
HasFont:=false;
{$ENDIF}
// paint to agg canvas
with AggLCLCanvas do begin
if HasFont then begin
FontFilename:=SetDirSeparators('../../verdana.ttf');
if not FileExists(FontFilename) then raise Exception.Create('file not found: '+FontFilename+' CurDir='+GetCurrentDirUTF8);
Font.LoadFromFile(FontFilename);
Font.Size:=18;
Font.Color:=clRed;
end;
// solid white background
Brush.Color:=clWhite;
FillRect(0,0,Width,Height);
@ -56,6 +72,8 @@ begin
Ellipse(55,10,65,20);
//GradientFill(Rect(70,10,80,20),clRed,clBlue,gdVertical);
Frame(85,10,95,20);
TextOut(10,40,'Font.Size='+IntToStr(Font.Size));
end;
// convert to LCL native pixel format
@ -63,6 +81,9 @@ begin
// paint with widgetset to bitmap
with Bitmap1.Canvas do begin
Font.Size:=18;
Font.Color:=clRed;
Brush.Color:=clBlue;
Pen.Color:=clRed;
Pen.Width:=1;
@ -75,6 +96,8 @@ begin
Ellipse(55,22,65,32);
GradientFill(Rect(70,22,80,32),clRed,clBlue,gdVertical);
Frame(85,22,95,32);
TextOut(10,65,'Font.Size='+IntToStr(Font.Size));
end;
end;

15
components/aggpas/src/agg_fpimage.pas
View File

@ -368,6 +368,8 @@ type
const NewCache : TAggFontCacheType = AGG_VectorFontCache;
const NewAngle : double = 0.0 ;
const NewHinting: boolean = true);
function AggHeightToSize(const h: double): double; virtual;
function SizeToAggHeight(const s: double): double; virtual;
property AggColor: TAggColor read FAggColor write SetAggColor;
property AggAlignX: TAggTextAlignment read FAggAlignX write SetAggAlignX default AGG_AlignLeft;
property AggAlignY: TAggTextAlignment read FAggAlignY write SetAggAlignY default AGG_AlignBottom;
@ -3421,6 +3423,7 @@ var
begin
if FAggHeight=AValue then exit;
FAggHeight:=AValue;
inherited SetSize(round(AggHeightToSize(FAggHeight)));
{$IFDEF AGG2D_USE_FREETYPE}
c:=TAggFPCanvas(Canvas);
if FAggCache = AGG_VectorFontCache then
@ -3443,7 +3446,17 @@ end;
procedure TAggFPFont.SetSize(AValue: integer);
begin
AggHeight:=AValue;
AggHeight:=SizeToAggHeight(AValue);
end;
function TAggFPFont.AggHeightToSize(const h: double): double;
begin
Result:=h;
end;
function TAggFPFont.SizeToAggHeight(const s: double): double;
begin
Result:=s;
end;
procedure TAggFPFont.SetFPColor(const AValue: TFPColor);

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

@ -58,11 +58,16 @@ type
TAggLCLFont = class(TAggFPFont)
private
FColor: TColor;
FPixelsPerInch: Integer;
protected
procedure SetColor(const AValue: TColor); virtual;
procedure SetFPColor(const AValue: TFPColor); override;
public
constructor Create; override;
function AggHeightToSize(const h: double): double; override;
function SizeToAggHeight(const s: double): double; override;
property Color: TColor read FColor write SetColor;
property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
end;
{ TAggLCLCanvas }
@ -278,7 +283,7 @@ end;
procedure TAggLCLCanvas.AggTextOut(const x, y: double; str: AnsiString;
roundOff: boolean; const ddx: double; const ddy: double);
begin
inherited AggTextOut(x, y+Font.Size, str, roundOff, ddx, ddy);
inherited AggTextOut(x+0.5, y+Font.Size+0.5, str, roundOff, ddx, ddy);
end;
procedure TAggLCLCanvas.Frame(const ARect: TRect);
@ -348,6 +353,22 @@ begin
FColor:=FPColorToTColor(FPColor);
end;
constructor TAggLCLFont.Create;
begin
FPixelsPerInch := ScreenInfo.PixelsPerInchY;
inherited Create;
end;
function TAggLCLFont.AggHeightToSize(const h: double): double;
begin
Result:=h*72 / FPixelsPerInch;
end;
function TAggLCLFont.SizeToAggHeight(const s: double): double;
begin
Result:=s*FPixelsPerInch / 72;
end;
{ TAggLCLImage }
procedure TAggLCLImage.ReallocData;