【VB.NET】【WPF】システムフォントの一覧を表示する

下図のようなシステムフォントの一覧を表示します。（左ペインで選択したフォントを右ペインのテキストに適用しているところ）

XAML（特に注意して欲しいところをハイライトした）

<Window x:Class="MainWindow"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:local="clr-namespace:WpfApp1"
mc:Ignorable="d"
Title="MainWindow" Height="450" Width="800">

<Window.Resources>
    <local:FontFamilyTitleConverter x:Key="FontFamilyTitleConverter_Key" />
    <local:FontFamilyNameConverter x:Key="FontFamilyNameConverter_Key" />
</Window.Resources>

<Grid>
    <Grid.ColumnDefinitions>
        <ColumnDefinition Width="5*" />
        <ColumnDefinition Width="5*" />
    </Grid.ColumnDefinitions>

    <UniformGrid Grid.Column="0">
        <ListBox Name="fontsList" Margin="0,0,0,0">
            <ListBox.ItemTemplate>
            <DataTemplate>
                <TextBlock FontFamily="{Binding Converter={StaticResource FontFamilyNameConverter_Key}, Mode=OneWay}" FontSize="16"
                    Text="{Binding Converter={StaticResource FontFamilyTitleConverter_Key}, Mode=OneWay}" />
            </DataTemplate>
            </ListBox.ItemTemplate>
        </ListBox>
    </UniformGrid>

    <UniformGrid Grid.Column="1">
        <TextBox Name="textbox1" Margin="0,0,0,0" Text="" FontSize="29" TextWrapping="Wrap" />
    </UniformGrid>
</Grid>

</Window>

コード

Class MainWindow

Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded

Me.Language = System.Windows.Markup.XmlLanguage.GetLanguage(system.Threading.Thread.CurrentThread.CurrentCulture.Name) '言語を設定

Me.fontsList.ItemsSource = Fonts.SystemFontFamilies.OrderBy(Function(n) n.Source) 'システムフォントをソートして設定

Me.textbox1.Text = "エレン・イーストのブログを今後ともよろしくお願いいたします。" & vbCrLf & vbCrLf & _
    "Thank you very much! See you!" & vbCrLf & vbCrLf & "https://elleneast.com"

End Sub



Private Sub fontsList_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles fontsList.SelectionChanged

Dim l As ListBox = CType(sender, ListBox)

Me.textbox1.FontFamily = l.SelectedItem

End Sub

End Class



'現在の言語のフォント名を返す（リストボックスのタイトルのテキスト）
Friend Class FontFamilyTitleConverter
    Implements IValueConverter

Private Function Convert(value As Object, targetType As Type, parameter As Object, culture As System.Globalization.CultureInfo) As Object _
    Implements IValueConverter.Convert

Dim oFontFamily As FontFamily = value
Dim oLanguage = System.Windows.Markup.XmlLanguage.GetLanguage(culture.IetfLanguageTag) ' _Loaded で設定した言語のフォント名を返す場合

For Each oFamilyNameKeyValue In oFontFamily.FamilyNames
    If oFamilyNameKeyValue.Key is oLanguage Then '.Key.ToString --> en-us, ja-jp など。
        Return oFamilyNameKeyValue.Value '.Value --> ＭＳ 明朝、Arial など。フォントの名前。
    End If
Next

Return oFontFamily.Source

End Function



Private Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As System.Globalization.CultureInfo) As Object _
    Implements IValueConverter.ConvertBack

Throw New NotImplementedException()

End Function

End Class



'リストボックスのフォントタイトルに適用するフォント名。シンボル用のフォントの場合は Courier を返す（リストボックスのフォントタイトルが化けるので）。それ以外はそのままフォントファミリー名を返す。
Friend Class FontFamilyNameConverter
    Implements IValueConverter

Private Function Convert(value As Object, targetType As Type, parameter As Object, culture As System.Globalization.CultureInfo) As Object _
    Implements IValueConverter.Convert

Dim oFontFamily As FontFamily = value

If IsSymbolFont(oFontFamily) = True Then
    Return "Courier"
Else
    Return oFontFamily.Source
End If

End Function



Private Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As System.Globalization.CultureInfo) As Object _
    Implements IValueConverter.ConvertBack

Throw New NotImplementedException()

End Function



'シンボル用のフォントか？
Private Function IsSymbolFont(fontFamily As FontFamily) As Boolean

Dim oGlyphTypeface As GlyphTypeface = GetFirstTypeface(fontFamily)

If oGlyphTypeface Is Nothing Then
    Return False
Else
    Return oGlyphTypeface.Symbol
End If

End Function



'フォントファミリーの最初のグリフタイプフェイスを返す
Private Function GetFirstTypeface(fontFamily As FontFamily) As GlyphTypeface

Dim oFirstTypeface As Typeface = FontFamily.GetTypefaces().First()

Dim oGlyphTypeface As GlyphTypeface = Nothing

oFirstTypeface.TryGetGlyphTypeface(oGlyphTypeface)

Return oGlyphTypeface

End Function

End Class

システムフォントリストの一覧を最も簡単に実現したければ

Me.fontsList.ItemsSource = Fonts.SystemFontFamilies

みたいにすれば良い思うが、それだとフォントのタイトルが英語名で表示されてしまう。各フォントのタイトルも全部同じフォントで表示されてしまう。表示順もなんかバラバラ。

なので、