适用于 Visual Basic .NET 的炫酷字体组合

引言

这是从以下网址移植的 VB.NET 版 FontCombo：https://codeproject.org.cn/KB/combobox/nishfontcombo.aspx（原作者 Nishant Sivakumar）。有关字体组合的更多详细信息，请参阅原始文章。

我还使用了原始文章评论中发布的修改版本。此外，您需要知道这段代码仍然有些混乱，需要更清晰的命名。我会在有时间的时候更新一个更好的版本，但目前我作为主要开发者正在编写三个商业产品，所以您可以想象我的日程安排……我只是因为无论如何都需要这样做才做的。但我认为一些 VB 程序员现在可以很高兴地拥有这个，而不是在我找到时间使这段代码更完美时的一年后。

这是完整的源代码

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

注意：您需要将此代码包装到控件类中，才能在 Visual Studio 表单设计器中使用。