Click here to Skip to main content
Click here to Skip to main content

Fancy Font Combo for Visual Basic .NET

, 22 Mar 2006 CPOL
Rate this:
Please Sign up or sign in to vote.
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, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

halsoft
Other v-research.at
Austria Austria
I program since 1991 (started with line based gw basic on DOS Smile | :) Nowadays I mainly code C# and VB.NET as well as some Java and other languages (if necessary)
I have studied bio-medicine informatics in Hall in Tyrol (Austria) and have my own company. At the moment I am working on three commercial products of which two are quite boring.
My main interest is AI and WingTsun (this is not a chinese coding language but a martial art).
 
update: i am now @ v-research.at and still working on AI topics.

Comments and Discussions

 
GeneralI'm not understanding... Pinmemberpravat_sagun30-Aug-06 23:51 
GeneralRe: I'm not understanding... Pinmemberhalsoft31-Aug-06 0:57 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

| Advertise | Privacy | Mobile
Web02 | 2.8.141015.1 | Last Updated 22 Mar 2006
Article Copyright 2006 by halsoft
Everything else Copyright © CodeProject, 1999-2014
Terms of Service
Layout: fixed | fluid