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

题外话:

微软应用软件界面上的控件图标做得真是令人羡慕，就说这三个吧，我就很喜欢。

可是找来找去，就是找不到这三个图标。自觉得很是没道理，肯定放在一个不知道的角落里头的。今天忽打激灵，急急的回:\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)

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