Want more features on Pastebin? Sign Up, it's FREE!
Guest

Untitled

By: a guest on Nov 30th, 2012  |  syntax: VB.NET  |  size: 1.52 KB  |  views: 11  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Imports System.Drawing.Text
  2. Imports System.Runtime.InteropServices
  3.  
  4. Module Custom_font
  5.  
  6.     'PRIVATE FONT COLLECTION TO HOLD THE DYNAMIC FONT
  7.     Private _pfc As PrivateFontCollection = Nothing
  8.  
  9.     Public ReadOnly Property GetInstance(ByVal Size As Single, _
  10.                                          ByVal style As FontStyle) As Font
  11.         Get
  12.             'IF THIS IS THE FIRST TIME GETTING AN INSTANCE
  13.             'LOAD THE FONT FROM RESOURCES
  14.             If _pfc Is Nothing Then LoadFont()
  15.  
  16.             'RETURN A NEW FONT OBJECT BASED ON THE SIZE AND STYLE PASSED IN
  17.             Return New Font(_pfc.Families(0), Size, style)
  18.  
  19.         End Get
  20.     End Property
  21.  
  22.     Public Sub AddFont(ByVal font As Byte())
  23.         If font Is Nothing Then Throw New ArgumentNullException("The font cannot be null.", "font")
  24.         If font.Length = 0 Then Throw New ArgumentException("The length of the font array cannot be 0.", "font")
  25.         Try
  26.             _pfc.AddMemoryFont(Marshal.UnsafeAddrOfPinnedArrayElement(font, 0), font.Length)
  27.         Catch ex As Exception
  28.             MessageBox.Show(Err.Number & ": " & Err.Description)
  29.             Environment.Exit(0)
  30.         End Try
  31.     End Sub
  32.  
  33.     Private Sub LoadFont()
  34.         Try
  35.             'INIT THE FONT COLLECTION
  36.             _pfc = New PrivateFontCollection
  37.             AddFont(My.Resources.MyFont)
  38.         Catch ex As Exception
  39.             MessageBox.Show(Err.Number & ": " & Err.Description)
  40.             Environment.Exit(0)
  41.         End Try
  42.  
  43.     End Sub
  44.  
  45. End Module
clone this paste RAW Paste Data