Hola. He estado haciendo pruebas en un peque�o programa para manejar fuentes y canvas en un TBitmap y luego pasar la imagen a un TImage. Pongo aqu� el c�digo por si a alguien le hiciera falta alguna vez: ________________________________________________________ ...
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);
...
procedure TForm1.BtnHazClick(Sender: TObject);
var
bmp2: TBitmap;
lazimg: TLazIntfImage;
drawer: TIntfFreeTypeDrawer;
ftFont1: TFreeTypeFont;
begin
SetBkMode(Form1.bmp.Canvas.Handle, TRANSPARENT);
Form1.bmp.Canvas.FillRect(0,0, Form1.bmp.width,Form1.bmp.height);
Form1.bmp.Canvas.Brush.Color:=RGBToColor(255,255,255);
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);
drawer.DrawTextRect('ABCDEFGHIJKLMNOPQRSTUVWXYZ', ftFont1, 0,0, 350,90,
colBlack, [ftaLeft, ftaBottom]);
bmp2.LoadFromIntfImage(lazimg);
bmp2.Canvas.Brush.Style := bsClear;
bmp2.Canvas.Ellipse(10,10,90,90);
Form1.bmp.Canvas.Draw(0, 0, bmp2);// Copia bmp2 a bmp
bmp2.Free;
________________________________________________________
Gracias :-)
El 11 de febrero de 2015, 23:24, Juan M. Puertas <soft.sirius en gmail.com> escribi�:
Show quoted text 64 lines
Muchas gracias Jos�. Elijo la soluci�n "sencilla" :-)
He estado investigando , y voy a tener que reconvertir tres objetos Timage
con sus numerosos Canvas, etc., a TBitmap. Seguro que se me ocurre alg�n
truco para que no sea engorroso.
Gracias tambi�n a ti, Iv�n por el intento. ;-)
El 11 de febrero de 2015, 15:26, Jos� Mejuto <joshyfun en gmail.com>
escribi�:
El 11/02/2015 a las 12:34, Juan M. Puertas escribi�:
>
>> ?Hola.
>> He hecho una aplicaci�n que dibuja en un TImage una serie de canvas con
>> elipses, l�neas, etc. y quisiera a�adir unos s�mbolos de una fuente ttf
>> que no est� en el Sistema.
>>
>
> Hola,
>
> Tienes dos opciones, la "sencilla" es usar la unit freetype o LazFreeType
>
http://wiki.lazarus.freepascal.org/LazFreeType
>
> La "complicada" es que para usar una font en Windows has de registrarla
> en el sistema, lo que es b�sicamente lo mismo que instalar la fuente, pero
> puedes hacerlo de modo temporal, esto es, que el registro s�lo es v�lido
> mientras tu programa est� en ejecuci�n y se desregistra al salir. Adem�s no
> necesita que la fuente est� en Windows\fonts si no que puede estar donde tu
> quieras.
>
> El primer modo es multiplataforma, el segundo s�lo Windows.
>
> S�lo para Windows ser�a algo como esto, en versi�n simplificada.
>
> procedure TForm1.FormCreate(Sender: TObject) ;
> begin
> AddFontResource('c:\FONTS\MyFont.TTF') ;
> SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
> end;
>
> // Al cerrar el form principal!
> procedure TForm1.FormDestroy(Sender: TObject) ;
> begin
> RemoveFontResource('C:\FONTS\MyFont.TTF') ;
> SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
> end;
>
> Aunque yo lo har�a en el lpr, no en el form, para que la fuente est�
> disponible para todos los forms, y lo proteger�a con un try...finally.
>
> --
>
>
> _______________________________________________
> Lazarus-es mailing list
> Lazarus-es en lists.lazarus.freepascal.org
>
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es
>
--
*Nota: Por problemas con el e-mail. Puede que recibas de nuevo este
mensaje en un tiempo.*
