有没有办法设置字体对话框只显示一组个性化的字体？

Question

使用 iTextSharp 创建 PDF 我需要让用户选择字体，但对最小和最大大小以及一些字体列表有限制，也许是我将添加到程序的资源文件夹中的字体列表

有没有办法将字体对话框设置为仅显示一组个性化的字体？例如 myapppath/resources 文件夹中的字体？

Dim myFont, mySize As String

Using dlg As New frmFonts

    dlg.FontMustExist = True

    dlg.MinSize = 9
    dlg.MaxSize = 14

    dlg.ShowEffects = False

    If dlg.ShowDialog <> DialogResult.Cancel Then
        myFont = dlg.Font.Name
        mySize = dlb.Font.Size
    End If

End Using

---

@Tyler 建议的尝试解决方案

下面是从 C# 到 VB.NET 的自动转换代码

我在标有 ** 的行上遇到错误

错误 1) 'FontListBox' 类型的值无法转换为 'Control'

错误2) 转换运算符不能从一个类型转换为相同类型

Partial Public Class MyFontDialog
Inherits Form
Private _fontListBox As FontListBox
Private _fontSizeListBox As ListBox

Public Sub New()
    'InitializeComponent();

    _fontListBox = New FontListBox()
    AddHandler _fontListBox.SelectedIndexChanged, AddressOf OnfontListBoxSelectedIndexChanged
    _fontListBox.Size = New Size(200, Height)
    **Controls.Add(_fontListBox)**

    _fontSizeListBox = New ListBox()
    **_fontSizeListBox.Location = New Point(_fontListBox.Width, 0)**

    Controls.Add(_fontSizeListBox)
End Sub

Private Sub OnfontListBoxSelectedIndexChanged(sender As Object, e As EventArgs)
    _fontSizeListBox.Items.Clear()
    **Dim font As Font = TryCast(_fontListBox.SelectedItem, Font)**
    If font IsNot Nothing Then
        For Each style As FontStyle In [Enum].GetValues(GetType(FontStyle))
            If font.FontFamily.IsStyleAvailable(style) Then
                _fontSizeListBox.Items.Add(style)
            End If
        Next
    End If
End Sub
End Class

Friend Class FontListBox
    Friend Size As Size
    Public Event SelectedIndexChanged(sender As Object, e As EventArgs)

    **Public Shared Widening Operator CType(v As FontListBox) As FontListBox**
    Throw New NotImplementedException()
    End Operator
End Class

Answer 1

我看到您有一个自定义控件，所以是的，这是可能的。看看这里，一定对你有帮助Designing a Custom Font Dialog/Selector for C# that filters out non true type fonts

编辑：

如果链接被破坏，这里是您感兴趣的代码部分。只需使用过滤后的 FontName 更改此 IF If font.FontFamily.IsStyleAvailable(style) Then 即可。

Private Sub OnfontListBoxSelectedIndexChanged(sender As Object, e As EventArgs)
_fontSizeListBox.Items.Clear()
Dim font As Font = TryCast(_fontListBox.SelectedItem, Font)
If font IsNot Nothing Then
    For Each style As FontStyle In [Enum].GetValues(GetType(FontStyle))
        If font.FontFamily.IsStyleAvailable(style) Then
            _fontSizeListBox.Items.Add(style)
        End If
    Next
End If
End Sub

EDIT2： 考虑您的最新评论.. 尝试在 2 个 vb 文件中分割 2 个类。就是这样：

Partial Public Class MyFontDialog
Inherits Form
Private _fontListBox As FontListBox
Private _fontSizeListBox As ListBox

Public Sub New()
    'InitializeComponent();

    _fontListBox = New FontListBox()
    AddHandler _fontListBox.SelectedIndexChanged, AddressOf OnfontListBoxSelectedIndexChanged
    _fontListBox.Size = New Size(200, Height)
    Controls.Add(_fontListBox)

    _fontSizeListBox = New ListBox()
    _fontSizeListBox.Location = New Point(_fontListBox.Width, 0)

    Controls.Add(_fontSizeListBox)
End Sub

Private Sub OnfontListBoxSelectedIndexChanged(sender As Object, e As EventArgs)
    _fontSizeListBox.Items.Clear()
    Dim font As Font = TryCast(_fontListBox.SelectedItem, Font)
    If Font IsNot Nothing Then
        For Each style As FontStyle In [Enum].GetValues(GetType(FontStyle))
            If Font.FontFamily.IsStyleAvailable(style) Then
                _fontSizeListBox.Items.Add(style)
            End If
        Next
    End If
End Sub
End Class

二等：

Public Class FontListBox
Inherits ListBox
Private _fonts As New List(Of Font)()
Private _foreBrush As Brush

Public Sub New()
    DrawMode = DrawMode.OwnerDrawFixed
    ItemHeight = 20
    For Each ff As FontFamily In FontFamily.Families
        ' determine the first available style, as all fonts don't support all styles
        Dim availableStyle As System.Nullable(Of FontStyle) = Nothing
        For Each style As FontStyle In [Enum].GetValues(GetType(FontStyle))
            If ff.IsStyleAvailable(style) Then
                availableStyle = style
                Exit For
            End If
        Next

        If availableStyle.HasValue Then
            Dim font As Font = Nothing
            Try
                ' do your own Font initialization here
                ' discard the one you don't like :-)
                font = New Font(ff, 12, availableStyle.Value)
            Catch
            End Try
            If font IsNot Nothing Then
                _fonts.Add(font)
                Items.Add(font)
            End If
        End If
    Next
End Sub

Protected Overrides Sub Dispose(disposing As Boolean)
    MyBase.Dispose(disposing)
    If _fonts IsNot Nothing Then
        For Each font As Font In _fonts
            font.Dispose()
        Next
        _fonts = Nothing
    End If
    If _foreBrush IsNot Nothing Then
        _foreBrush.Dispose()
        _foreBrush = Nothing
    End If
End Sub

Public Overrides Property ForeColor() As Color
    Get
        Return MyBase.ForeColor
    End Get
    Set
        MyBase.ForeColor = Value
        If _foreBrush IsNot Nothing Then
            _foreBrush.Dispose()
        End If
        _foreBrush = Nothing
    End Set
End Property

Private ReadOnly Property ForeBrush() As Brush
    Get
        If _foreBrush Is Nothing Then
            _foreBrush = New SolidBrush(ForeColor)
        End If
        Return _foreBrush
    End Get
End Property

Protected Overrides Sub OnDrawItem(e As DrawItemEventArgs)
    MyBase.OnDrawItem(e)
    If e.Index < 0 Then
        Return
    End If

    e.DrawBackground()
    e.DrawFocusRectangle()
    Dim bounds As Rectangle = e.Bounds
    Dim font As Font = DirectCast(Items(e.Index), Font)
    e.Graphics.DrawString(font.Name, font, ForeBrush, bounds.Left, bounds.Top)
End Sub
End Class