如何在Lazarus 1.2.6中混合canvas和LazFreeType

时间:2015-02-17 10:24:19

标签: canvas fonts lazarus true-type-fonts

我需要开发一个以任何顺序混合Canvas和LazFreeType的程序,例如Line,Ellipse,LazFreetype字体,新的Ellipse等。 如果我首先绘制所有LazFreetype字体,然后是所有椭圆,线等,我只能设法做到这一点。 我需要以任何顺序和任何混合方式来做。 这是我的代码示例:

...
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, LCLIntf, LCLType, fpimage,
  IntfGraphics, GraphType,      //Intf basic routines
  EasyLazFreeType,  LazFreeTypeIntfDrawer;  //EasyFreeType with Intf                                        
...
type
  { TForm1 }
  TForm1 = class(TForm)
    BtnHaz: TButton;
    Bmp: TImage;
    procedure BtnHazClick(Sender: TObject);
  end;

var
  Form1: TForm1; 
...
procedure TForm1.BtnHazClick(Sender: TObject);
var
  bmp2: TBitmap;
  lazimg: TLazIntfImage;
  drawer: TIntfFreeTypeDrawer;
  ftFont1: TFreeTypeFont;
begin
  bmp2 := TBitmap.Create;
  lazimg := TLazIntfImage.Create(0,0, [riqfRGB]);
  drawer := TIntfFreeTypeDrawer.Create(lazimg);
  ftFont1 := nil;
  ftFont1 := TFreeTypeFont.Create;
  ftFont1.Name := 'AstroGadget.ttf';
  ftFont1.SizeInPoints := 27;

  lazimg.SetSize(Form1.bmp.Width,Form1.bmp.Height);
  drawer.FillPixels(TColorToFPColor(clWhite));
  ftFont1.Hinted := true;
  ftFont1.ClearType := true;
  ftFont1.Quality := grqHighQuality;
  ftFont1.SmallLinePadding := false;
  SetBkMode(bmp2.Canvas.Handle, TRANSPARENT);
  bmp2.Canvas.Ellipse(10,10,90,90); // <- Here don't work
  drawer.DrawTextRect('ABCDEFGHIJKLM', ftFont1, 0,0, 350,90, colBlack, [ftaLeft, ftaBottom]);// <- Here work
  bmp2.LoadFromIntfImage(lazimg);
  bmp2.Canvas.Brush.Style := bsClear;
  bmp2.Canvas.Ellipse(10,10,90,90); // <- Here work
  drawer.DrawTextRect('ABCDEFGHIJKLM', ftFont1, 0,0, 350,90, colBlack, [ftaLeft, ftaBottom]); // <- Here don't work
  Form1.bmp.Canvas.Draw(0, 0, bmp2);// bmp2 -> bmp
  bmp2.Free;
end;        
...

非常感谢你的帮助。

1 个答案:

答案 0 :(得分:0)

最后,我发现了TBGRABitmap的解决方案。以下是源代码:

    ...
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, LCLIntf, LCLType, fpimage,
  BGRABitmap,BGRABitmapTypes, //BGRABitmap
  BGRAFreeType,               //BGRABitmap FreeType support
  EasyLazFreeType;
type
  { TForm1 }
  TForm1 = class(TForm)
    BtnHaz: TButton;
    Bmp: TImage;
    procedure BtnHazClick(Sender: TObject);
  end;

var
  Form1: TForm1;
 ...
procedure TForm1.BtnHazClick(Sender: TObject);
var
  bmp2: TBGRABitmap; //TBitmap;
  drawer: TBGRAFreeTypeDrawer;
  ftFont1: TFreeTypeFont;
begin
  bmp2 := TBGRABitmap.Create(Form1.bmp.Width,Form1.bmp.Height,ColorToRGB(clBtnFace));
  ftFont1 := TFreeTypeFont.Create;
  ftFont1.Name := 'AstroGadget.ttf';
  ftFont1.SizeInPoints := 27;
  SetBkMode(bmp2.Canvas.Handle, TRANSPARENT);
  bmp2.Fill(ColorToBGRA(ColorToRGB(clWhite)));
  drawer := TBGRAFreeTypeDrawer.Create(bmp2);
  ftFont1.Hinted := true;
  ftFont1.ClearType := true;
  ftFont1.Quality := grqHighQuality;
  ftFont1.SmallLinePadding := false;
  bmp2.Canvas.Ellipse(10,10,80,90);
  drawer.DrawText('ABCDEFGHIJKLM',ftFont1,0,0,BGRABlack,[ftaTop,ftaLeft]);
  bmp2.Canvas.Brush.Style := bsClear;  // Transparent
  bmp2.Canvas.Ellipse(50,10,120,90);
  bmp2.Draw(Canvas,0,0);
  bmp2.Free;
  drawer.Free;
  ftFont1.Free;
end;             
...