Imports System.Drawing.Text Imports System.Runtime.InteropServices Module Custom_font 'PRIVATE FONT COLLECTION TO HOLD THE DYNAMIC FONT Private _pfc As PrivateFontCollection = Nothing Public ReadOnly Property GetInstance(ByVal Size As Single, _ ByVal style As FontStyle) As Font Get 'IF THIS IS THE FIRST TIME GETTING AN INSTANCE 'LOAD THE FONT FROM RESOURCES If _pfc Is Nothing Then LoadFont() 'RETURN A NEW FONT OBJECT BASED ON THE SIZE AND STYLE PASSED IN Return New Font(_pfc.Families(0), Size, style) End Get End Property Public Sub AddFont(ByVal font As Byte()) If font Is Nothing Then Throw New ArgumentNullException("The font cannot be null.", "font") If font.Length = 0 Then Throw New ArgumentException("The length of the font array cannot be 0.", "font") Try _pfc.AddMemoryFont(Marshal.UnsafeAddrOfPinnedArrayElement(font, 0), font.Length) Catch ex As Exception MessageBox.Show(Err.Number & ": " & Err.Description) Environment.Exit(0) End Try End Sub Private Sub LoadFont() Try 'INIT THE FONT COLLECTION _pfc = New PrivateFontCollection AddFont(My.Resources.MyFont) Catch ex As Exception MessageBox.Show(Err.Number & ": " & Err.Description) Environment.Exit(0) End Try End Sub End Module