[RESOLVED] [2005] Embedding a True Type Font

[VJgamer]

I am trying to embed a True Type font into one of my applications. The font is "Digital Readout Upright" which can be found at http://www.grsites.com/fonts/. I have read many articles on how to do this, and when I use this code it dosn't work.

I have the following code:

Public Class Form1
    Dim EmbedFonts As New PrivateFontCollection()
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load        
    Dim FontStream As IO.Stream = Me.GetType().Assembly.GetManifestResourceStream("EmbedFonts.DIGIREAD.TTF")
        Dim FontLoc As System.IntPtr = Marshal.AllocCoTaskMem(FontStream.Length)
        Dim FontData(FontStream.Length) As Byte
        FontStream.Read(FontData, 0, FontStream.Length)
        Marshal.Copy(FontData, 0, FontLoc, FontStream.Length)
        EmbedFonts.AddMemoryFont(FontLoc, FontStream.Length)
        FontStream.Close()
        Dim FontStream As IO.Stream = Me.GetType().Assembly.GetManifestResourceStream("EmbedFonts.DIGIREAD.TTF")
        Dim FontLoc As System.IntPtr = Marshal.AllocCoTaskMem(FontStream.Length)
        Dim FontData(FontStream.Length) As Byte
        FontStream.Read(FontData, 0, FontStream.Length)
        Marshal.Copy(FontData, 0, FontLoc, FontStream.Length)
        EmbedFonts.AddMemoryFont(FontLoc, FontStream.Length)
        FontStream.Close()
        Marshal.FreeCoTaskMem(FontLoc)
        lblVolume.ForeColor = Color.FromArgb(0, 192, 0)
        lblVolume.Font = New Font(EmbedFonts.Families(0), 31, FontStyle.Bold)
    End Sub
End Class

My Project name is EmbedFonts, and the font is in the Solution Explorer and the filename is DIGIREAD.TTF. I have DIGIREAD.TTF's Build Property set to Embedded Resource. Also if I look at EmbedFonts.Families(0).Name property it is "Digital Readout Upright".

The font in the the label lblVolume is still arial once the form loads.

Any help would be greatly appreciated!

[VJgamer]

Bump... Can anyone help me?

[MrGTI]

What is "Marshal" ?? It's not declared.

[kleinma]

Marshal is

System.Runtime.InteropServices.Marshal

VJgamer, is the font actually installed into windows?

[MrGTI]

That code has duplicates and doesn't even compile. I get an Object reference not set to an instance of an object error when i try to run it.

Here's what i was trying to run:

Dim EmbedFonts As New Drawing.Text.PrivateFontCollection()
        Dim FontStream As IO.Stream = Me.GetType().Assembly.GetManifestResourceStream("fake1.RUFBRUSH.TTF")
        Dim FontLoc As System.IntPtr = Runtime.InteropServices.Marshal.AllocCoTaskMem(FontStream.Length)
        Dim FontData(FontStream.Length) As Byte
        FontStream.Read(FontData, 0, FontStream.Length)
        System.Runtime.InteropServices.Marshal.Copy(FontData, 0, FontLoc, FontStream.Length)
        EmbedFonts.AddMemoryFont(FontLoc, FontStream.Length)
        FontStream.Close()
        System.Runtime.InteropServices.Marshal.FreeCoTaskMem(FontLoc)
        Label1.ForeColor = Color.FromArgb(0, 192, 0)
        Label1.Font = New Font(EmbedFonts.Families(0), 31, FontStyle.Bold)

The font i'm using isn't installed on the system. It's just embedded in the project.
.

[kleinma]

I believe a font needs to be installed to work. I could be wrong, and would be more than happy to have someone post some code showing how you can use a font in .NET without it being installed.

[gigemboy]

I think it can be done, and the code posted above looks similar to the code in the article I found:

http://www.bobpowell.net/embedfonts.htm

But I am confused as to what the problem is. Are there errors? Did MrGTI's code work? He didn't state whether his post was working or not, and I'm too lazy to download a font to test hehe...

[MrGTI]

I got it to work:

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim pfc As New Drawing.Text.PrivateFontCollection()
 
        ' Get our assembly.
        Dim executing_assembly As System.Reflection.Assembly = Reflection.Assembly.GetEntryAssembly()
        ' Get our namespace.
        Dim my_namespace As String = executing_assembly.GetName().Name.ToString()
 
        'load the resource
        Dim fontStream As IO.Stream = Me.GetType().Assembly.GetManifestResourceStream(my_namespace & ".RUFBRUSH.TTF")
        If Not (fontStream Is Nothing) Then
            'Windows.Forms.MessageBox.Show(Me, "font stream was loaded", "found", Windows.Forms.MessageBoxButtons.OK, Windows.Forms.MessageBoxIcon.Exclamation)
 
            'create an unsafe memory block for the data
            Dim data As System.IntPtr = Runtime.InteropServices.Marshal.AllocCoTaskMem(fontStream.Length)
 
            'create a buffer to read in to
            Dim fontdata() As Byte
            ReDim fontdata(fontStream.Length)
 
            'fetch the font program from the resource
            fontStream.Read(fontdata, 0, fontStream.Length)
 
            'copy the bytes to the unsafe memory block
            Runtime.InteropServices.Marshal.Copy(fontdata, 0, data, fontStream.Length)
 
            'pass the font to the font collection
            pfc.AddMemoryFont(data, fontStream.Length)
 
            'close the resource stream
            fontStream.Close()
 
            'free the unsafe memory
            Runtime.InteropServices.Marshal.FreeCoTaskMem(data)
 
            Dim fn As System.Drawing.Font
            fn = New Font(pfc.Families(0), 32, FontStyle.Regular)
 
            Label1.Font = fn
        End If
        
        Beep()
    End Sub

I used code examples from these places:

• http://www.vb-helper.com/howto_net_e...resources.html
• http://www.bobpowell.net/embedfonts.htm

[VJgamer]

Sorry for taking so long to reply, but I will try this code as soon as I make it home. Thank you for the help. It looks like it should work.

[kleinma]

I got it to work:

I used code examples from these places:

• http://www.vb-helper.com/howto_net_e...resources.html
• http://www.bobpowell.net/embedfonts.htm

Nice

[VJgamer]

You are truly a lifesaver. Big props! I was using the example from http://www.bobpowell.net/embedfonts.htm, and I had quickly glanced at the http://www.vb-helper.com/howto_net_e...resources.html example once before, but I never put the two together. Bravo, and Thank You!!

[extreme.aly]

the last code posted by MrGTI doesnt works on my pc.. i changed the font file name and add the label 1 and put that code in button 1...it makes a beep and then nothing happens...not even any error...it cannot reach this codition: "If Not (fontStream Is Nothing) Then"
i have also added a font in my resources

[VJgamer]

Here is what I am currently using. It only uses on API call. It is really easy to use because the function does all the work. The source is here: http://www.tek-tips.com/faqs.cfm?fid=4747


This code needs to be somewhere in your Form code.

Private Declare Auto Function AddFontMemResourceEx Lib "Gdi32.dll" (ByVal pbFont As IntPtr, ByVal cbFont As Integer, ByVal pdv As Integer, ByRef pcFonts As Integer) As IntPtr

    Public Function GetFont(ByVal FontResource() As String) As Drawing.Text.PrivateFontCollection
        'Get the namespace of the application    
        Dim NameSpc As String = _
            Reflection.Assembly.GetExecutingAssembly().GetName().Name.ToString()
        Dim FntStrm As IO.Stream
        Dim FntFC As New Drawing.Text.PrivateFontCollection()
        Dim i As Integer
        For i = 0 To FontResource.GetUpperBound(0)
            'Get the resource stream area where the font is located
            FntStrm = _
        Reflection.Assembly.GetExecutingAssembly().GetManifestResourceStream(NameSpc + "." + FontResource(i))
            'Load the font off the stream into a byte array 
            Dim ByteStrm(CType(FntStrm.Length, Integer)) As Byte
            FntStrm.Read(ByteStrm, 0, Int(CType(FntStrm.Length, Integer)))
            'Allocate some memory on the global heap
            Dim FntPtr As IntPtr = _
                Runtime.InteropServices.Marshal.AllocHGlobal( _
                Runtime.InteropServices.Marshal.SizeOf(GetType(Byte)) * ByteStrm.Length)
            'Copy the byte array holding the font into the allocated memory.
            Runtime.InteropServices.Marshal.Copy(ByteStrm, 0, FntPtr, ByteStrm.Length)
            'Add the font to the PrivateFontCollection
            FntFC.AddMemoryFont(FntPtr, ByteStrm.Length)
            Dim pcFonts As Int32
            pcFonts = 1
            AddFontMemResourceEx(FntPtr, ByteStrm.Length, 0, pcFonts)
            'Free the memory
            Runtime.InteropServices.Marshal.FreeHGlobal(FntPtr)
        Next
        Return FntFC
    End Function

Use this to apply the fonts. Replace the '31' with the font size you want
lblVolume & lblMute are labels.

'Global Variable
Dim EmbedFonts As New PrivateFontCollection()

'In Form.Load
Dim FontResources(0) As String
        FontResources(0) = "DIGIREAD.TTF"
        EmbedFonts = GetFont(FontResources)
        Dim VDFont As New Font(EmbedFonts.Families(0), 31, FontStyle.Regular)
        lblVolume.Font = VDFont
        lblMute.Font = VDFont

[extreme.aly]

IT IS GIVING ME THIS ERROR:

System.NullReferenceException was unhandled
  Message="Object reference not set to an instance of an object."
  Source="Monopoly (aLy Edition)"
  StackTrace:
       at Monopoly__aLy_Edition_.Form1.GetFont(String[] FontResource) in F:\VB Projects\Monopoly (aLy Edition)\Monopoly (aLy Edition)\Form1.Designer.vb:line 35
       at Monopoly__aLy_Edition_.Form1.Form1_Load(Object sender, EventArgs e) in F:\VB Projects\Monopoly (aLy Edition)\Monopoly (aLy Edition)\Form1.vb:line 629
       at System.EventHandler.Invoke(Object sender, EventArgs e)
       at System.Windows.Forms.Form.OnLoad(EventArgs e)
       at System.Windows.Forms.Form.OnCreateControl()
       at System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
       at System.Windows.Forms.Control.CreateControl()
       at System.Windows.Forms.Control.WmShowWindow(Message& m)
       at System.Windows.Forms.Control.WndProc(Message& m)
       at System.Windows.Forms.ScrollableControl.WndProc(Message& m)
       at System.Windows.Forms.ContainerControl.WndProc(Message& m)
       at System.Windows.Forms.Form.WmShowWindow(Message& m)
       at System.Windows.Forms.Form.WndProc(Message& m)
       at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
       at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
       at System.Windows.Forms.NativeWindow.DebuggableCallback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
       at System.Windows.Forms.SafeNativeMethods.ShowWindow(HandleRef hWnd, Int32 nCmdShow)
       at System.Windows.Forms.Control.SetVisibleCore(Boolean value)
       at System.Windows.Forms.Form.SetVisibleCore(Boolean value)
       at System.Windows.Forms.Control.set_Visible(Boolean value)
       at System.Windows.Forms.Application.ThreadContext.RunMessageLoopInner(Int32 reason, ApplicationContext context)
       at System.Windows.Forms.Application.ThreadContext.RunMessageLoop(Int32 reason, ApplicationContext context)
       at System.Windows.Forms.Application.Run(ApplicationContext context)
       at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.OnRun()
       at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.DoApplicationModel()
       at Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.Run(String[] commandLine)
       at Monopoly__aLy_Edition_.My.MyApplication.Main(String[] Args) in 17d14f5c-a337-4978-8281-53493378c1071.vb:line 81
       at System.AppDomain.nExecuteAssembly(Assembly assembly, String[] args)
       at System.Runtime.Hosting.ManifestRunner.Run(Boolean checkAptModel)
       at System.Runtime.Hosting.ManifestRunner.ExecuteAsAssembly()
       at System.Runtime.Hosting.ApplicationActivator.CreateInstance(ActivationContext activationContext, String[] activationCustomData)
       at System.Runtime.Hosting.ApplicationActivator.CreateInstance(ActivationContext activationContext)
       at Microsoft.VisualStudio.HostingProcess.HostProc.RunUsersAssemblyDebugInZone()
       at System.Threading.ThreadHelper.ThreadStart_Context(Object state)
       at System.Threading.ExecutionContext.Run(ExecutionContext executionContext, ContextCallback callback, Object state)
       at System.Threading.ThreadHelper.ThreadStart()

ON THIS LINE:

Dim ByteStrm(CType(FntStrm.Length, Integer)) As Byte

WHAT SHOULD I DO?

[extreme.aly]

hey it works when i create a new project but i don't know why it is not working on my old project....anybody know, why it is not working?

[extreme.aly]

I GOT IT!!! there is an error in the coding, here:

Dim NameSpc As String = _
            Reflection.Assembly.GetExecutingAssembly().GetName().Name.ToString()

this line does not return the namespace...it returns the assembly name... sometimes the assembly name and namespace are same, thats why, it works...

we have to set the namespace manually...or maybe by other way!

[dan01]

any one know how to do this in vb6?

[kleinma]

I don't think VB6 had the capabilities for embedded resources like VB.NET does. You would likely need to include it as a seperate file.

[dan01]

I don't think VB6 had the capabilities for embedded resources like VB.NET does. You would likely need to include it as a seperate file.

I know how to embedded a font or other file as a resources in vb6.
I can't allocate memory as byte. because it hasn't Intptr, but vb6 have Strptr......? what I do for Intptr.