How TO:应用特定字体文件字体

Author:水如烟

题外话:
微软应用软件界面上的控件图标做得真是令人羡慕，就说这三个吧，我就很喜欢。
可是找来找去，就是找不到这三个图标。自觉得很是没道理，肯定放在一个不知道的角落里头的。今天忽打激灵，急急的回:\Program Files\Microsoft Visual Studio 8\Common7\IDE里头看，一个TrueType字体文件Visualui.TTF映入眼帘，打开一看，果是在此！原来不是图标，是字体！

检索已安装字样:

    Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim mFontCollection As New Drawing.Text.InstalledFontCollection
        Dim mInstance As New Action(Of Drawing.FontFamily)(AddressOf GetFontFamilyName)
        Array.ForEach(mFontCollection.Families, mInstance)

    End Sub

    Private Sub GetFontFamilyName()Sub GetFontFamilyName(ByVal sender As Drawing.FontFamily)
        Console.WriteLine(sender.Name)
    End Sub

以上代码是Net2.0的。当然，也可以这般实现：

    Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim mFontCollection As New Drawing.Text.InstalledFontCollection
        For Each mFontFamily As FontFamily In mFontCollection.Families
            Console.WriteLine(mFontFamily.Name)
        Next

    End Sub

项目中添加文件Visualui.TTF
安装

    Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim mPrivateFontCollection As New Drawing.Text.PrivateFontCollection
        mPrivateFontCollection.AddFontFile("..\..\Visualui.TTF")

    End Sub

以下是全过程:

    Private gPrivateFontCollection As Drawing.Text.PrivateFontCollection
    Private gInstance As New Action(Of Drawing.FontFamily)(AddressOf GetFontFamilyName)

    Private gStrings As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    Private Sub GetFontFamilyName()Sub GetFontFamilyName(ByVal sender As Drawing.FontFamily)
        Console.WriteLine(sender.Name)
    End Sub

    Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Console.WriteLine("默认字体显示ABCDEFGHIJKLMNOPQRSTUVWXYZ")
        Me.Label1.Text = gStrings
        '停顿两秒
        Me.Label1.Refresh()
        System.Threading.Thread.Sleep(2000)

        Console.WriteLine()
        Console.WriteLine("查看系统已安装的字样")
        Array.ForEach(FontFamily.Families, gInstance)

        '安装字体文件
        gPrivateFontCollection = New Drawing.Text.PrivateFontCollection
        gPrivateFontCollection.AddFontFile("..\..\Visualui.TTF")
        Console.WriteLine()
        Console.WriteLine("查看可安装的字样")
        Array.ForEach(gPrivateFontCollection.Families, gInstance)

        '安装字样
        Dim mFontFamily As FontFamily = New FontFamily("Visualui", gPrivateFontCollection)

        Console.WriteLine()
        Console.WriteLine("查看系统已安装的字样")
        Array.ForEach(FontFamily.Families, gInstance)

        '应用字体
        Dim mFont As New Font(mFontFamily, Me.Label1.Font.Size)
        Me.Label1.Font = mFont
    End Sub