Fancy Font Combo for Visual Basic .NET

Introduction

This is the VB.NET port of the FontCombo from: https://www.codeproject.com/KB/combobox/nishfontcombo.aspx (original by Nishant Sivakumar). More details on the font combo are available in the original article.

I also used the mod posted as comment on the original article. Furthermore, you need to know that the code is still quite messy and needs clearer names. I will update a better version when I have the time, but at the moment, I am coding on three commercial products as the main developer, so you can imagine my schedule... I just did this because I had to do it anyways. Still I thought some VB coders could be happy to have this now and not in one year when I have found the time to make this piece of code more perfect.

Here is the complete source code:

Imports System, System.Collections, System.ComponentModel, _
        System.Drawing, System.Data, System.Windows.Forms

namespace FontCombo

Public Class FontComboBox_
       Inherits ComboBox

    Private nFont As Font
    Private both As Boolean = False
    Private maxWid As Integer = 0
    Private sampleStr As String = " - Hello World"
    Dim defSize As Integer = 10
    Private arial As Font = New Font("Arial", defSize)

    Public Property FontSize() As Integer
        Get
            Return defSize
        End Get
        Set(ByVal Value As Integer)
            defSize = Value
        End Set
    End Property

    Public Sub New()
        MaxDropDownItems = 20
        IntegralHeight = False
        Sorted = False
        DropDownStyle = ComboBoxStyle.DropDownList
        DrawMode = DrawMode.OwnerDrawVariable
    End Sub

    Public Sub Populate(ByVal b As Boolean)
        both = b
        For Each ff As FontFamily In FontFamily.Families
            If ff.IsStyleAvailable(FontStyle.Regular) Then
                Items.Add(ff.Name)
        Next
        If Items.Count > 0 Then SelectedIndex = 0
    End Sub

    Protected Overrides Sub OnMeasureItem(ByVal e As _
              System.Windows.Forms.MeasureItemEventArgs)
        If e.Index > -1 Then
            Dim w As Integer = 0
            Dim fontName As String = Items(e.Index).ToString()
            Dim tmpFont As Font = New Font(fontName, fontSize)
            Dim g As Graphics = CreateGraphics()
            If both Then
                Dim fontSize As SizeF = g.MeasureString(sampleStr, tmpFont)
                Dim captionSize As SizeF = g.MeasureString(fontName, arial)
                e.ItemHeight = Math.Max(fontSize.Height, captionSize.Width)
                w = (fontSize.Width + captionSize.Width)
            Else
                Dim s As SizeF = g.MeasureString(fontName, tmpFont)
                e.ItemHeight = s.Height
                w = s.Width
            End If
            maxWid = Math.Max(maxWid, w)
            e.ItemHeight = Math.Min(e.ItemHeight, 20)
        End If
        MyBase.OnMeasureItem(e)
    End Sub

    Protected Overrides Sub OnDrawItem(ByVal e As _
              System.Windows.Forms.DrawItemEventArgs)
        If e.Index > -1 Then
            Dim fontName As String = Items(e.Index).ToString()
            Dim tmpFont As Font = New Font(fontName, defSize)
            If both Then
                Dim g As Graphics = CreateGraphics()
                Dim w As Integer = g.MeasureString(fontName, arial).Width
                If (e.State And DrawItemState.Focus) = 0 Then
                    e.Graphics.FillRectangle(New SolidBrush(SystemColors.Window), _
                                             e.Bounds)
                    e.Graphics.DrawString(fontName, arial, _
                      New SolidBrush(SystemColors.WindowText), _
                      e.Bounds.X * 2, e.Bounds.Y)
                    e.Graphics.DrawString(sampleStr, tmpFont, _
                      New SolidBrush(SystemColors.WindowText), _
                      e.Bounds.X * 2 + w, e.Bounds.Y)
                Else
                    e.Graphics.FillRectangle(New SolidBrush(SystemColors.Highlight), _
                                             e.Bounds)
                    e.Graphics.DrawString(fontName, arial, _
                      New SolidBrush(SystemColors.HighlightText), _
                      e.Bounds.X * 2, e.Bounds.Y)
                    e.Graphics.DrawString(sampleStr, tmpFont, _
                      New SolidBrush(SystemColors.HighlightText), _
                      e.Bounds.X * 2 + w, e.Bounds.Y)
                End If
            Else
                If (e.State And DrawItemState.Focus) = 0 Then
                    e.Graphics.FillRectangle(New SolidBrush(SystemColors.Window), _
                                             e.Bounds)
                    e.Graphics.DrawString(fontName, tmpFont, _
                      New SolidBrush(SystemColors.WindowText), _
                      e.Bounds.X * 2, e.Bounds.Y)
                Else
                    e.Graphics.FillRectangle(New SolidBrush(SystemColors.Highlight), _
                                             e.Bounds)
                    e.Graphics.DrawString(fontName, tmpFont, _
                      New SolidBrush(SystemColors.HighlightText), _
                      e.Bounds.X * 2, e.Bounds.Y)
                End If
            End If
        End If
        MyBase.OnDrawItem(e)
    End Sub

    Protected Overrides Sub OnDropDown(ByVal e As System.EventArgs)
        Me.DropDownWidth = maxWid + 30
    End Sub
End Class
End Namespace

PS: You will have to wrap this into a control class to make it accessible in the Visual Studio Form Designer.