unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, EasyLazFreeType;
type
{ TForm1 }
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FFont: TFreeTypeFont;
procedure DrawOnIntfImage;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
fpImage, fpCanvas,
IntfGraphics, LazFreeTypeIntfDrawer, LazFreeTypeFontCollection;
procedure TForm1.DrawOnIntfImage;
const
FontFile = 'arial.ttf';
var
bmp: TBitmap;
img: TLazIntfImage;
drawer: TIntfFreeTypeDrawer;
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf32Bit;
bmp.SetSize(Image1.Width, Image1.Height);
img := bmp.CreateIntfImage;
try
drawer := TIntfFreeTypeDrawer.Create(img);
try
if FFont = nil then
begin
FFont := TFreeTypeFont.Create;
FFont.Name := FontCollection.AddFile('c:\windows\fonts\' + FontFile).Family.FamilyName;
end;
FFont.SizeInPoints := 24;
drawer.DrawTextRect('This is a test', FFont, 0,0, img.Width, img.Height, colRed, [ftaCenter, ftaVerticalCenter]);
finally
drawer.Free;
end;
bmp.LoadFromIntfImage(img);
Image1.Picture.Assign(bmp);
finally
img.Free;
end;
finally
bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DrawOnIntfImage;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FFont);
end;