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

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）类型＆＃39; FontListBox＆＃39;的值无法转换为＆＃39;控制＆＃39;

错误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