fonts and Tfont

[Paul Beier]

I want to use a private font in my delphi .net app, but I can't find much
documentation about it.
Here is what I've done so far (I don't know if this is the right method):

// string with my uninstalled font:
S := 'myfont.ttf';
// create the PrivateFontCollection
PrivFonts := PrivateFontCollection.Create;
// add the font
PrivFonts.AddFontFile(S);
// get the fontfamily object
myfontfamily := TabFonts.families[0];
// get the font (ffont is a 'font' object) (is this correct?)
ffont := font.Create(FF,10);
// here is the part I don't get: how to get the tfont object to represent my
font. This doesn't work:
MyTFont.Handle := ffont.ToHfont;

Any suggestions?
Thanks, pb

[lycj]

Greetings

I am not sure how to convert Font to TFont, but the following is
implemented through WinForms.

/// <Summary>
/// Load font resource to PrivateFontCollection.
/// Note that you have to embeded a font resource first (e.g. {$R
Yourfont.tif})
/// then Load the font
(LoadFontFromResource('Yourfont.tif',yourform,miniHtml.userFontCollection)
/// then you can use the font as usual.
/// </Summary>
function LoadFontFromResource(resourceName : string; F : Form; var pfc :
PrivateFontCollection) : boolean;
var fontStream : System.IO.Stream;
Data : System.IntPtr;
fontData : Array of Byte;
begin
result := true;
try //load the resource
fontStream :=
F.GetType.Assembly.GetManifestResourceStream(resourceName);
Data := Marshal.AllocCoTaskMem(fontStream.Length); //create an unsafe
memory block for the data
SetLength(fontData,fontStream.Length); //create a buffer to
read in to
fontStream.Read(fontdata, 0, fontStream.Length); //fetch the font
program from the resource
Marshal.Copy(fontdata, 0, data, fontStream.Length); //copy the bytes to
the unsafe memory block
if not Assigned(pfc) then pfc := PrivateFontCollection.Create;
pfc.AddMemoryFont(data, fontStream.Length); //pass the font to
the font collection
fontStream.Close; //close the resource
stream
Marshal.FreeCoTaskMem(data); //free the unsafe
memory
except
result := false;
end;
end;

//This is used to check if the font exists
function UserFontExists(fontName : string; pfc : PrivateFontCollection) :
boolean;
var i : integer;
family : FontFamily;
families : Array of FontFamily;
begin
{$IFNDEF CE_FRAMEWORK}
Result := false;
if fontName = '' then exit;
if not assigned(pfc) then exit;

for family in pfc.Families do
begin
if (family.Name as String).ToLower.toLower.Equals(fontName.ToLower)
then
begin Result := true; exit; end;
end;
{$ELSE}
Result := false;
{$ENDIF}
end;

// Create a font
function createFont(Name : string; userFontCollecction :
PrivateFontCollection) : Font;
var f : FontStyle;
families : FontFamily;
begin
f := FontStyle.Regular;
if (FontStyle.Bold in FntStyle) then f := f or FontStyle.Bold;
if (FontStyle.Italic in FntStyle) then f := f or FontStyle.Italic;
if (FontStyle.Underline in FntStyle) then f := f or FontStyle.Underline;
if (FontStyle.Strikeout in FntStyle) then f := f or FontStyle.Strikeout;
if (targetURL <> '') then f := f or FontStyle.Underline;

if (Name = '') then Result := Font.Create(DefaultFntName,fntSize,f) else
if FontExists(Name,aGraphics) then
Result := Font.Create(Name,fntSize,f)
else
{$IFNDEF CE_FRAMEWORK}
//with (parentHtml as qzMiniHtml) do
if UserFontExists(Name,userFontCollection) then
begin
for families in userFontCollection.Families do
if families.Name.ToLower.Equals(Name.ToLower) then
Result := System.Drawing.Font.Create(families,fntSize,f);
end else Result := Font.Create(DefaultFntName,fntSize,f);
{$ENDIF}
end;

Regards
Joseph Leung

"Paul Beier" <be...@libero.it> wrote in message
news:4412bce5$1...@newsgroups.borland.com...

[Paul Beier]

Thank you, Joseph, your help is very interesting and useful. However, the
main problem remains: now that I have loaded my Font object with the correct
font, what do I do next to make my Tcanvas.Font use it?

var newfont : font;
// [...] create newfont Font object from Fontfamily, loading from resource,
etc, as in previous mail [...]

// this gives an error:
Mycanvas.font.assign(newfont);

// this too:
Mycanvas.font := newfont;

// and this does nothing:
Mycanvas.font.Handle := Hfont(ffont.ToHfont);

How do I get my canvas TFont to load or use the Font object?

thanks, pb

"lycj" <ly...@noreply.com> wrote in message
news:44133770$1...@newsgroups.borland.com...

[Rudy Velthuis [TeamB]]

At 13:04:59, 11.03.2006, Paul Beier wrote:

> I want to use a private font in my delphi .net app, but I can't find
> much documentation about it. Here is what I've done so far (I don't
> know if this is the right method):
>
> // string with my uninstalled font:
> S := 'myfont.ttf';
> // create the PrivateFontCollection
> PrivFonts := PrivateFontCollection.Create;
> // add the font
> PrivFonts.AddFontFile(S);
> // get the fontfamily object
> myfontfamily := TabFonts.families[0];
> // get the font (ffont is a 'font' object) (is this correct?)

That depends. Since you say you are using TCanvas, I assume you are using
VCL.NET. TCanvas.Font is a Borland.Vcl.Graphics.TFont, not a
System.Drawing.Font.

Now are you sure your Canvas actually valid?
--
Rudy Velthuis [TeamB] http://rvelthuis.de/

"Rarely is the question asked: Is our children learning?"
-- George W. Bush

[Paul Beier]

Dear Rudy,
Thanks for your response and question.
Answer: yes - it is a BDS06 "VCL Forms Application" .Net project using
DrawText on a Tgraphicobject.canvas. The canvas is valid, in that if the new
font doesn't load, it uses the default font, but still draws the text. You
hit the nail on the head, in that the problem is precicely that I do not
know how to use my newly created System.Drawing.Font.with the
Borland.Vcl.Graphics.TFont object or the Tcanvas. Here is the incriminated
code, which in any case does draw the text:

type
TMyControl = class( TGraphicControl)
[...]
function TMyControl.GetBitmap: TBitmap;
begin
Result := TBitmap.Create;

[...] assign properties, etc...
// does not work (see my previous post):
Result.Canvas.Font.assign(Mynewsystemdrawingfont);
OutRect := Rect( 0, 0, Result.Width, Result.Height);
SetBkMode( Result.Canvas.Handle, Transparent);
DrawText( Result.Canvas.Handle, Textstr, Length( Textstr), OutRect,
DT_LEFT or DT_NOCLIP);

thanks, pb

"Rudy Velthuis [TeamB]" <velt...@gmail.com> wrote in message
news:xn0ejnhd15u5n...@www.teamb.com...