Font Enumerator

Imports System.Runtime.InteropServices
Imports System.Drawing.Text

Public Class Form1

    
    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

        
        Public lfFaceName As String
    End Structure

    
    Public Structure ENUMLOGFONTEX
        Public elfLogFont As LOGFONT

        
        Public elfFullName As String

        
        Public elfStyle As String

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

    Public Delegate Function EnumFontFamExProc(ByRef lpelfe As ENUMLOGFONTEX,
                                               ByRef lpntme As NEWTEXTMETRIC,
                                               fontType As UInteger,
                                               lParam As IntPtr) As Integer

    
    Public Shared Function EnumFontFamiliesEx(hdc As IntPtr,
                                              ByRef lpLogFont As LOGFONT,
                                              lpEnumFontFamExProc As EnumFontFamExProc,
                                              lParam As IntPtr,
                                              dwFlags As UInteger) As Integer
    End Function

    
    Public Shared Function GetDC(hWnd As IntPtr) As IntPtr
    End Function

    
    Public Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Integer
    End Function

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ' Populate combo box with installed fonts
        Dim firstFont As String = ""
        Dim fonts As New InstalledFontCollection()
        For Each Font2 In fonts.Families
            cmbFontFamily.Items.Add(Font2.Name)
            If firstFont = "" Then
                firstFont = Font2.Name
            End If
        Next
        cmbFontFamily.AutoCompleteMode = AutoCompleteMode.SuggestAppend
        cmbFontFamily.AutoCompleteSource = AutoCompleteSource.ListItems
        cmbFontFamily.Text = firstFont
    End Sub

    Private Sub btnEnumerate_Click(sender As Object, e As EventArgs) Handles btnEnumerate.Click
        lstStyles.Items.Clear()

        Dim selectedFont As String = cmbFontFamily.Text
        If String.IsNullOrWhiteSpace(selectedFont) Then
            MessageBox.Show("Please select or enter a font family.")
            Return
        End If

        Dim styles = EnumerateFontStyles(selectedFont)
        If styles.Count = 0 Then
            lstStyles.Items.Add("(No styles found)")
        Else
            For Each style In styles
                lstStyles.Items.Add(style)
            Next
        End If
    End Sub

    Private Function EnumerateFontStyles(familyName As String) As List(Of String)
        Dim result As New List(Of String)
        Dim logFont As New LOGFONT()
        logFont.lfCharSet = 1 ' DEFAULT_CHARSET
        logFont.lfFaceName = familyName

        Dim hdc As IntPtr = GetDC(IntPtr.Zero)

        Dim callback As EnumFontFamExProc =
            Function(ByRef lpelfe As ENUMLOGFONTEX, ByRef lpntme As NEWTEXTMETRIC, fontType As UInteger, lParam As IntPtr) As Integer
                If Not result.Contains(lpelfe.elfStyle) Then
                    result.Add(lpelfe.elfStyle)
                End If
                Return 1 ' Continue enumeration
            End Function

        EnumFontFamiliesEx(hdc, logFont, callback, IntPtr.Zero, 0)
        ReleaseDC(IntPtr.Zero, hdc)

        Return result
    End Function

End Class