🚀 go-pugleaf

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" <beier@libero.it> wrote in message 
news:4412bce5$1@newsgroups.borland.com...
>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
>
> 

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" <lycj@noreply.com> wrote in message 
news:44133770$1@newsgroups.borland.com...
> 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" <beier@libero.it> wrote in message 
> news:4412bce5$1@newsgroups.borland.com...
>>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
>>
>>
>
> 

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

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]" <velthuis@gmail.com> wrote in message 
news:xn0ejnhd15u5nn00i-velthuis@www.teamb.com...
> 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