Imports System.Runtime.InteropServices
Public Class Form1
[INDENT] 'Name of the font to look for, in my case, it is CODE39X, a custom made font
'Replace this with the name of the font you are looking for.
Public Const BarcodeFontName As String = "CODE39X"
Public Class FontEnumerator
[INDENT] Protected _fontCollection As ArrayList
Public Const DEFAULT_CHARSET As Long = 1
Public Const RASTER_FONTTYPE As Short = 1
Public Const DEVICE_FONTTYPE As Short = 2
Public Const TRUETYPE_FONTTYPE As Short = 4
Const LF_FACESIZE As Short = 32
Const LF_FULLFACESIZE As Short = 64
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Public Structure LOGFONT
[INDENT] Public lfHeight As Integer
Public lfWidth As Integer
Public lfEscapement As Integer
Public lfOrientation As Integer
Public lfWeight As Integer
Public lfItalic As Byte
Public lfUnderline As Byte
Public lfStrikeOut As Byte
Public lfCharSet As Byte
Public lfOutPrecision As Byte
Public lfClipPrecision As Byte
Public lfQuality As Byte
Public lfPitchAndFamily As Byte
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=LF_FACESIZE)> _
Public lfFaceName As String[/INDENT]
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Public Structure ENUMLOGFONTEX
[INDENT] Public elfLogFont As LOGFONT
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=LF_FULLFACESIZE)> _
Public elfFullName As String
<MarshalAs(UnmanagedType.ByValTStr, sizeconst:=LF_FACESIZE)> _
Public elfStyle As String
<MarshalAs(UnmanagedType.ByValTStr, sizeconst:=LF_FACESIZE)> _
Public elfScript As String[/INDENT]
End Structure
Public Structure NEWTEXTMETRIC
[INDENT] Public tmHeight As Integer
Public tmAscent As Integer
Public tmDescent As Integer
Public tmInternalLeading As Integer
Public tmExternalLeading As Integer
Public tmAveCharWidth As Integer
Public tmMaxCharWidth As Integer
Public tmWeight As Integer
Public tmOverhang As Integer
Public tmDigitizedAspectX As Integer
Public tmDigitizedAspectY As Integer
Public tmFirstChar As Byte
Public tmLastChar As Byte
Public tmDefaultChar As Byte
Public tmBreakChar As Byte
Public tmItalic As Byte
Public tmUnderlined As Byte
Public tmStruckOut As Byte
Public tmPitchAndFamily As Byte
Public tmCharSet As Byte
Public ntmFlags As Integer
Public ntmSizeEM As Integer
Public ntmCellHeight As Integer
Public ntmAvgWidth As Integer[/INDENT]
End Structure
<DllImport("gdi32.dll")> _
Public Shared Function DeleteDC( _
ByRef hdc As IntPtr) As Boolean
End Function
<DllImport("gdi32.dll", _
EntryPoint:="CreateDCA")> _
Public Shared Function CreateDC( _
ByVal lpszDriver As String, _
ByVal lpszDevice As String, _
ByVal lpszOutput As String, _
ByRef lpInitData As String) As IntPtr
End Function
<DllImport("gdi32.dll", _
EntryPoint:="EnumFontFamiliesExA")> _
Public Shared Function EnumFontFamiliesEx( _
[INDENT] ByVal hDC As IntPtr, _
<[In]()> ByRef lpLogFont As IntPtr, _
ByVal lpEnumFontProc As EnumFontFamExProcDelegate, _
ByVal lParam As IntPtr, _
ByVal dwFlags As UInteger) As Integer[/INDENT]
End Function
Public Delegate Function EnumFontFamExProcDelegate( _
[INDENT] ByRef lpELFE As ENUMLOGFONTEX, _
ByRef lpNTME As NEWTEXTMETRIC, _
ByVal lFontType As Integer, _
ByVal lParam As Integer) As Integer[/INDENT]
Public ReadOnly Property HasFontName(ByVal fontName As String) As Boolean
[INDENT] Get
Dim aryIdx As Integer = -1
If Not _fontCollection Is Nothing Then
aryIdx = _fontCollection.IndexOf(UCase(fontName))
End If
Return (aryIdx <> -1)
End Get[/INDENT]
End Property
Public Sub New(ByRef ownerForm As System.Windows.Forms.Form)
[INDENT] If _fontCollection Is Nothing Then
_fontCollection = New ArrayList()
End If
Dim gfxObj As System.Drawing.Graphics = Graphics.FromHwnd(ownerForm.Handle)
Dim gfxHDC As IntPtr = gfxObj.GetHdc()
If Not gfxHDC.Equals(IntPtr.Zero) Then
EnumerateFonts(gfxHDC)
DeleteDC(gfxHDC)
Else
MsgBox("Cannot obtain a device context handle from graphic device.")
End If
'
' Use the following to enumerate fonts with a printer device context.
'
'Dim dp As String
'dp = Space(255)
'Dim dpSize As Integer = 255
'If Not GetDefaultPrinter(dp, dpSize) Then
' MsgBox("Unable to retrieve default printer; no font found.", MsgBoxStyle.Critical)
'Else
' Dim hPrinterDC As IntPtr = CreateDC("WINSPOOL", dp.ToString(), Nothing, IntPtr.Zero)
' If hPrinterDC.Equals(IntPtr.Zero) Then
' MsgBox("Cannot obtain a device context handle for the specified printer.")
' Else
' EnumerateFonts(hPrinterDC)
' DeleteDC(hPrinterDC)
' 'Dim clsGraphics As System.Drawing.Graphics = Graphics.FromHdc(hPrinterDC)
' End If
'End If[/INDENT]
End Sub
Private Sub EnumerateFonts(ByVal hDC As IntPtr)
[INDENT] Dim structLogFont As New FontEnumerator.LOGFONT
structLogFont.lfFaceName = ""
structLogFont.lfPitchAndFamily = 0
structLogFont.lfCharSet = FontEnumerator.DEFAULT_CHARSET
Try
Dim plogFont As IntPtr = System.Runtime.InteropServices.Marshal.AllocHGlobal(System.Runtime.InteropServices.Marshal.SizeOf(structLogFont))
System.Runtime.InteropServices.Marshal.StructureToPtr(structLogFont, plogFont, True)
Dim delegateFunc As New FontEnumerator.EnumFontFamExProcDelegate(AddressOf EnumFontFamExProc)
Dim iRet As Integer = FontEnumerator.EnumFontFamiliesEx(hDC, plogFont, delegateFunc, IntPtr.Zero, 0)
If iRet <> 1 Then
MsgBox(Me, "The specified printer does not have any fonts.")
End If
Catch ex As Exception
MsgBox(Me, ex.Message)
End Try[/INDENT]
End Sub
Private Function EnumFontFamExProc( _
[INDENT] ByRef lpELFE As FontEnumerator.ENUMLOGFONTEX, _
ByRef lpNTME As FontEnumerator.NEWTEXTMETRIC, _
ByVal lFontType As Integer, _
ByVal lParam As Integer) As Integer
If Not _fontCollection Is Nothing Then
Dim fontName As String = UCase(lpELFE.elfFullName)
_fontCollection.Add(fontName)
End If
Return 1[/INDENT]
End Function[/INDENT]
End Class
Public Shared Function CheckFont( _
[INDENT] ByRef ownerForm As System.Windows.Forms.Form) As Boolean
Dim fontEnumerator As New FontEnumerator(ownerForm)
Return fontEnumerator.HasFontName(BarcodeFontName)[/INDENT]
End Function
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
[INDENT] If Not CheckFont(Me) Then
MessageBox.Show(String.Format("{0} font not found, will exit now.", BarcodeFontName), "Font not found", MessageBoxButtons.OK, MessageBoxIcon.Error)
Application.Exit()
End If[/INDENT]
End Sub[/INDENT]
End Class
