[RESOLVED] Problem using AddFontResourceEx

[jmsrickland]

I thought using AddFontResourceEx was to have your own font set so you can use your special fonts in your program without the need to install it in the system's Font folder (C:\Windows\Fonts) but I can not get it to work.

Here is my code

Private Declare Function AddFontResourceEx Lib "gdi32" Alias AddFontResourceExA" _
 (ByVal sFIleName As String, ByVal lFlags As Long, ByVal lReserved As Long) As Long

Private Const FR_PRIVATE As Long = &H10

Public Function InstallFont(pFontPath As String) As Long
 InstallFont = AddFontResourceEx(pFontPath, FR_PRIVATE, 0&)
End Function

Private Sub Command1_Click()
 InstallFont App.Path & "myfont.ttf"

 Text1.Font.Name = "myfont"
 Text1.Font.Size = 8

 Text1.Text = Chr(&H41)
End Sub

When I click on Command1 it does not print the "A" from my font file but rather the "A" from the font that is set at design time which is MS Sans Serif.

If I copy myfont.ttf to the system's font folder then I can use it but then I don't need the AddFontResourceEx API as I can just set it at design time.

[ColinE66]

What I said in your other thread:

In code, you need to refer to the font name, rather than the filename.

Let's say you create a font called 'MyFont'. This is its name irrespective of the filename it is saved as. So, you'd call InstallFont(MyFontFileName.ttf) to load it but, when assigning it to your textbox you'd use Text1.Font.Name = 'MyFont'

To see what I mean, open your font file in Windows and you will see that it has a name that exists independently of whatever you call the file.

So, are you sure that your font is really called 'Myfont'?

EDIT:
And are you sure that the InstallFont call is succeeding? I ask as I don't see a backslash in your InstallFont App.Path & "myfont.ttf" call.

Basically, instead of assuming that the api call doesn't work, you should have checked what you already had; i.e. are you passing the right value to the InstallFont function and is its return value indicating success or failure.

[jmsrickland]

OMG! It was the \ I didn't put in the path

Now I have another situation:

When I use a RichTextBox and print Chr(&H41) I get the special "A" from MyFont.ttf however when I use a regular TextBox and print Chr(&H41) I get the "A" from MS San Serif although both text boxes have MS San Serif as the default font set at design time

So....

Private Sub Command1_Click()
 InstallFont App.Path & "\MyFont.ttf"
 RichTextBox1.Font.Name = "MyFont"
 RichTextBox1.Font.Size = 12
 RichTextBox1.Text = Chr(&H41)
End Sub

...... prints the "A" from MyFont.ttf

But...

Private Sub Command2_Click()
 InstallFont App.Path & "\MyFont.ttf"
 Text1.Font.Name = "MyFont"
 Text1.Font.Size = 12
 Text1.Text = Chr(&H41)
End Sub

....prints the "A" from MS Sans Serif

[ColinE66]

You don't need to keep re-installing the font as you have done in your example. just do it once in form load.

But anyway, with the above code what happens when you click Command1 (since we know that is working) and then click Command2, having changed the Command2 code to

Private Sub Command2_Click()
  Set Text1.font = RichTextBox1.font
  Text1.Text = Chr(&H41)
End Sub

[ColinE66]

As a matter of fact, if you are going to be reusing the font many times in your app, use something like

Option Explicit
Private Declare Function AddFontResourceEx Lib "gdi32" Alias "AddFontResourceExA" (ByVal sFIleName As String, ByVal lFlags As Long, ByVal lReserved As Long) As Long

Private Const FR_PRIVATE As Long = &H10

Public Function InstallFont(pFontPath As String) As Long
 InstallFont = AddFontResourceEx(pFontPath, FR_PRIVATE, 0&)
End Function


Private Sub Form_Load()
Dim MyReusableFont As StdFont

   InstallFont "C:\MyFont.ttf"
   Set MyReusableFont = New StdFont
   With MyReusableFont
      .Name = "MyFont"
      .Bold = True
      .Size = 24
   End With

   Set Text1.Font = MyReusableFont
   Set RichTextBox1.Font = MyReusableFont
End Sub

[jmsrickland]

I know I don't need to re-install the font I just posted that as an example

Anyway setting Text1.Font to RichTextBox1.Font doesn't change anything.

There is nothing special or weird about my font and in the past I have used very strange looking characters without any problems in Text1 using this same approach.

Also, I can add the font to the system's font folder and then assign it to Text1 at design time and still it does not print the correct letters

[ColinE66]

Copied/pasted your code from #3 and it's working just fine on my machine...

Can you attach a small project that exhibits the incorrect behaviour?

[jmsrickland]

Copied/pasted your code from #3 and it's working just fine on my machine...

Can you attach a small project that exhibits the incorrect behaviour?

How can you do that? You need my font to test with. I have been able to use other fonts and it worked for Text1 it's just this font I just made today and I only made one letter to test with. I'll post my VB Project and the font file I'm using

[ColinE66]

Well, when I said a small project I was just going to sanity check your code but I took it as a given that you'd include your font file, which is what I was really after. Just attach that if you like; I suspect the problem lies in there anyway...

[jmsrickland]

Well, when I said a small project I was just going to sanity check your code but I took it as a given that you'd include your font file, which is what I was really after. Just attach that if you like; I suspect the problem lies in there anyway...

OK, here is my small project

[ColinE66]

Well, I don't exactly know what is wrong with your font but it definitely looks odd when you double-click on the ttf file in Explorer - no preview of your A character at any of the standard sizes. Also, your code does work but only when you set the font size to 52 or more! Opening the file in my own font editor (Font Creator v6), nothing looks untoward to me but, then again, I'm no expert and there are a lot of settings and metrics involved in font-making.

My advice; whatever you created this font in, stop using it as it clearly seems to produce garbage! Did you make it using an on-line creator? FontStruct perhaps?

[jmsrickland]

Um, when I display MyFont.ttf using Character Map it shows the "A" in the correct position and when I double click on the file it also shows the "A" in the correct position before the number 12. I only made one letter so there should no other characters except for one capital "A" and everything else looks like solid black rectangles because there are no characters made for what it wants to show so it shows rectangles instead but you should see this:

[jmsrickland]

OK, I got it to work. All I had to do was to add more characters to the font set.

BTW:

How do you make the characters colored for a RTB. I don't see any ForeColor property

[baka]

when you install a "new" font, you can get the name by calling: Screen.Fonts(Screen.FontCount - 1) as it will be placed at the end of in the list.
you can also enumerate all fonts if you want to figure out if the font is already installed or not.

[georgekar]

I use this

Public Function LoadFont(FntFileName As String) As Boolean
    Dim FntRC As Long
        FntRC = AddFontResource(FntFileName)
        If FntRC = 0 Then
         LoadFont = False
        Else 'success
         LoadFont = True
        End If
End Function
Public Function RemoveFont(FntFileName As String) As Boolean
     Dim rc As Long
     Do
       rc = RemoveFontResource(FntFileName)
     Loop Until rc = 0
End Function

The name of the font is not the name of the file.
You need to take account that the file maybe missing so the LOADFONT() return true if font is loaded. I use that

Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long

So before I close the program I remove the font