DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets Manager

Snippets has posted 5883 posts at DZone. View Full User Profile

Font In Resources

12.08.2008

| 3522 views |

        // Loads fonts from system resources into the new fonts colelction

Imports System

Public Class JaFonts
    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
        Try
            '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
        Catch ex As Exception
            ThrowError(ex)
            Return Nothing
        End Try
    End Function

    Public Sub Load()
        Try
            Dim FontNames(2) As String
            FontNames(0) = "JEP.ttf"
            FontNames(1) = "BLt.ttf"
            FontNames(2) = "BLtBd.ttf"
            JaCoFont = Me.GetFont(FontNames)
        Catch ex As Exception
            ThrowError(ex)
        End Try
    End Sub

End Class

Tags: