<div dir="ltr"><div class="gmail_default" style="font-family:verdana,sans-serif">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:<br>________________________________________________________<br>...<br>uses<br> Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,<br> StdCtrls,<br><br> LCLIntf, LCLType,<br><br> fpimage,<br> IntfGraphics, GraphType, //Intf basic routines<br> EasyLazFreeType, LazFreeTypeIntfDrawer //EasyFreeType with Intf<br> ;<br>type<br> { TForm1 }<br> TForm1 = class(TForm)<br> BtnHaz: TButton;<br> Bmp: TImage;<br> procedure BtnHazClick(Sender: TObject); <br> ...<br><br>procedure TForm1.BtnHazClick(Sender: TObject);<br>var<br> bmp2: TBitmap;<br> lazimg: TLazIntfImage;<br> drawer: TIntfFreeTypeDrawer;<br> ftFont1: TFreeTypeFont;<br>begin<br> SetBkMode(Form1.bmp.Canvas.Handle, TRANSPARENT);<br> Form1.bmp.Canvas.FillRect(0,0, Form1.bmp.width,Form1.bmp.height);<br> Form1.bmp.Canvas.Brush.Color:=RGBToColor(255,255,255);<br><br> bmp2 := TBitmap.Create;<br> lazimg := TLazIntfImage.Create(0,0, [riqfRGB]);<br> drawer := TIntfFreeTypeDrawer.Create(lazimg);<br> ftFont1 := nil;<br> ftFont1 := TFreeTypeFont.Create;<br> ftFont1.Name := 'AstroGadget.ttf';<br> ftFont1.SizeInPoints := 27;<br> lazimg.SetSize(Form1.bmp.Width,Form1.bmp.Height);<br> drawer.FillPixels(TColorToFPColor(clWhite));<br> ftFont1.Hinted := true;<br> ftFont1.ClearType := true;<br> ftFont1.Quality := grqHighQuality;<br> ftFont1.SmallLinePadding := false;<br> SetBkMode(bmp2.Canvas.Handle, TRANSPARENT);<br> drawer.DrawTextRect('ABCDEFGHIJKLMNOPQRSTUVWXYZ', ftFont1, 0,0, 350,90,<br> colBlack, [ftaLeft, ftaBottom]);<br> bmp2.LoadFromIntfImage(lazimg);<br> bmp2.Canvas.Brush.Style := bsClear;<br> bmp2.Canvas.Ellipse(10,10,90,90);<br> Form1.bmp.Canvas.Draw(0, 0, bmp2);// Copia bmp2 a bmp<br> bmp2.Free;<br>________________________________________________________<br><br></div><div class="gmail_default" style="font-family:verdana,sans-serif">Gracias :-)<br></div></div><div class="gmail_extra"><br><div class="gmail_quote">El 11 de febrero de 2015, 23:24, Juan M. Puertas <span dir="ltr"><<a href="mailto:soft.sirius@gmail.com" target="_blank">soft.sirius@gmail.com</a>></span> escribió:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr"><div class="gmail_default" style="font-family:verdana,sans-serif">Muchas gracias José. Elijo la solución "sencilla" :-)<br></div><div class="gmail_default" style="font-family:verdana,sans-serif">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. <br></div><div class="gmail_default" style="font-family:verdana,sans-serif">Gracias también a ti, Iván por el intento. ;-)<br></div></div><div class="gmail_extra"><br><div class="gmail_quote">El 11 de febrero de 2015, 15:26, José Mejuto <span dir="ltr"><<a href="mailto:joshyfun@gmail.com" target="_blank">joshyfun@gmail.com</a>></span> escribió:<div><div class="h5"><br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span>El 11/02/2015 a las 12:34, Juan M. Puertas escribió:<br>
</span><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
Hola.<span><br>
He hecho una aplicación que dibuja en un TImage una serie de canvas con<br>
elipses, líneas, etc. y quisiera añadir unos símbolos de una fuente ttf<br>
que no está en el Sistema.<br>
</span></blockquote>
<br>
Hola,<br>
<br>
Tienes dos opciones, la "sencilla" es usar la unit freetype o LazFreeType <a href="http://wiki.lazarus.freepascal.org/LazFreeType" target="_blank">http://wiki.lazarus.<u></u>freepascal.org/LazFreeType</a><br>
<br>
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.<br>
<br>
El primer modo es multiplataforma, el segundo sólo Windows.<br>
<br>
Sólo para Windows sería algo como esto, en versión simplificada.<br>
<br>
procedure TForm1.FormCreate(Sender: TObject) ;<br>
begin<br>
AddFontResource('c:\FONTS\<u></u>MyFont.TTF') ;<br>
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;<br>
end;<br>
<br>
// Al cerrar el form principal!<br>
procedure TForm1.FormDestroy(Sender: TObject) ;<br>
begin<br>
RemoveFontResource('C:\FONTS\<u></u>MyFont.TTF') ;<br>
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;<br>
end;<br>
<br>
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.<span><font color="#888888"><br>
<br>
-- <br></font></span><div><div>
<br>
<br>
______________________________<u></u>_________________<br>
Lazarus-es mailing list<br>
<a href="mailto:Lazarus-es@lists.lazarus.freepascal.org" target="_blank">Lazarus-es@lists.lazarus.<u></u>freepascal.org</a><br>
<a href="http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es" target="_blank">http://lists.lazarus.<u></u>freepascal.org/mailman/<u></u>listinfo/lazarus-es</a><br>
</div></div></blockquote></div></div></div><span class="HOEnZb"><font color="#888888"><br><br clear="all"><br>-- <br><div><i><font size="1"><span>Nota: Por problemas con el e-mail. Puede que recibas de nuevo este mensaje
en un tiempo.</span></font></i></div>
</font></span></div>
</blockquote></div><br><br clear="all"><br>-- <br><div class="gmail_signature"><i><font size="1"><span>Nota: Por problemas con el e-mail. Puede que recibas de nuevo este mensaje
en un tiempo.</span></font></i></div>
</div>