在.NET中使用代码实现检索/安装字体

'检索已安装字样: 

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