How do I support all fonts? (Not just truetype fonts?)

[Jake6177]

Hey, I am working on a notepad in VB.net.

I have a font dialog set up, but my when I choose a font that is not truetype, then it shuts down on me. Any ideas how I can support other types of fonts and how I can put this into my code? All I have is the font dialogue, and nothing else..

Code:

If TabControl1.TabCount = 0 Then
        End If
        Dim FS As New FontDialog
        If FS.ShowDialog = Windows.Forms.DialogResult.OK Then
            CType(TabControl1.SelectedTab.Controls.Item(0), RichTextBox).Font = FS.Font
        Else
            Exit Sub
        End If

Thanks in advance,
Jake

[G3Hawkeye]

from searching around google for awhile i found that vb.net has limited support for OpenType and Type1 wont work at all but some dude found that this code works

Code:

Imports System.Runtime.InteropServices

Public Class Form1

    '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
        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
            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
        End Structure

        <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
        Public Structure ENUMLOGFONTEX
            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
        End Structure

        Public Structure NEWTEXTMETRIC
            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
        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( _
            ByVal hDC As IntPtr, _

            <[In]()> ByRef lpLogFont As IntPtr, _


            ByVal lpEnumFontProc As EnumFontFamExProcDelegate, _
            ByVal lParam As IntPtr, _
            ByVal dwFlags As UInteger) As Integer
        End Function

        Public Delegate Function EnumFontFamExProcDelegate( _
            ByRef lpELFE As ENUMLOGFONTEX, _
            ByRef lpNTME As NEWTEXTMETRIC, _
            ByVal lFontType As Integer, _
            ByVal lParam As Integer) As Integer


        Public ReadOnly Property HasFontName(ByVal fontName As String) As Boolean
            Get
                Dim aryIdx As Integer = -1
                If Not _fontCollection Is Nothing Then
                    aryIdx = _fontCollection.IndexOf(UCase(fontName))
                End If
                Return (aryIdx <> -1)
            End Get
        End Property

        Public Sub New(ByRef ownerForm As System.Windows.Forms.Form)

           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
        End Sub


        Private Sub EnumerateFonts(ByVal hDC As IntPtr)
            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
        End Sub

        Private Function EnumFontFamExProc( _
            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
        End Function
    End Class

    Public Shared Function CheckFont( _

       ByRef ownerForm As System.Windows.Forms.Form) As Boolean

        Dim fontEnumerator As New FontEnumerator(ownerForm)
        Return fontEnumerator.HasFontName(BarcodeFontName)
    End Function


    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        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
    End Sub
End Class

[Jake6177]

Hey thanks,
Do you know if its possible to store the value the user chose in a variable (dim) and relay that dim to the Public Const so that it searches for what the user entered? Otherwise it's of no use to me unfortunately :/

[AceInfinity]

Hey thanks,
Do you know if its possible to store the value the user chose in a variable (dim) and relay that dim to the Public Const so that it searches for what the user entered? Otherwise it's of no use to me unfortunately :/

Now wouldn't that defeat the purpose of Const? Just remove Const.

[Jake6177]

Oh...true. :| So something along the lines of:

Code:

Public BarcodeFontName As String = "DimName"

I believe that would be correct, no?

[AceInfinity]

Yeah, there's no Const there. That's what I was trying to get at

[Jake6177]

Alright, thank you! Really appreciate it.
If I could figure out how to rep, I'd +Rep you both

[G3Hawkeye]

click the number next to reputation

---

click rate user gyazo.com/788907650b595e6de561b67c4932df57.png?1342894510 < couldnt put the image as i dont have ten posts yet