Click here to Skip to main content
65,938 articles
CodeProject is changing. Read more.
Articles
(untagged)

Fancy Font Combo for Visual Basic .NET

0.00/5 (No votes)
22 Mar 2006 1  
A fancy font combo for VB showing the actual fonts.

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.

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here