如何使用 VB.Net 新增 (安裝) 字型
如何使用 VB.Net 新增 (安裝) 字型
' Imports 陳述式
' 匯入在所參考的專案和組件中定義的命名空間(Namespace) 或程式設計項目。
Imports System.IO
Imports System.Environment
Imports System.Drawing.Text
Public Class Form1
' API 宣告新增字型/ 移除字型, 發送訊息
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" _
(ByVal lpFileName As String) As Integer
Declare Function RemoveFontResource Lib "gdi32" Alias "AddFontResourceA" _
(ByVal lpFileName As String) As Integer
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Integer, ByVal Msg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
' API 常數宣告
Private Const HWND_Broadcast As Long = &HFFFF& ' 廣播
Private Const WM_FontChange As Long = &H1D& ' 字型異動
Private strFile As String = "D:\DynaFont\Dyna\SLEEPM1.TTF" ' 字型路徑+檔名
' 列舉電腦上所安裝的字型
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim IFC As New InstalledFontCollection ' 初始化InstalledFontCollection 類別的新執行個體。
' FontCollection.Families 屬性: 取得與這個FontCollection 相關聯的FontFamily 物件陣列。
' FontFamily 類別: 定義具有相似基本設計和特定樣式變化的字體群組。這個類別無法被繼承。
For Each fm As FontFamily In IFC.Families
ListBox1.Items.Add(fm.Name) ' Name : 取得這個FontFamily 的名稱。
Next
End Sub
' 方法1 : 新增字型
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' GetEnvironmentVariable 方法: 取得環境變數
' WinDir : Windows 所在目錄, Windows\Fonts 為: 字型所在目錄
' Path.GetFileName 方法: 要從其中取得檔案名稱和副檔名的路徑字串。
Dim strDstFile As String = GetEnvironmentVariable("WinDir") & "\Fonts\" & Path.GetFileName(strFile)
File.Copy(strFile, strDstFile) ' 複製字型檔案到Windows 字型目錄
' PrivateFontCollection 類別
' 提供從字型檔案建立的字型系列集合，這些字型檔案是由用戶端應用程式所提供。
' 命名空間：System.Drawing.Text
' 組件：System.Drawing (在system.drawing.dll 中)
' 初始化PrivateFontCollection 類別的新執行個體
Dim PFC As New PrivateFontCollection
' PrivateFontCollection.AddFontFile 方法: 從指定的檔案將字型加入這個PrivateFontCollection。
PFC.AddFontFile(strFile)
SendMessage(HWND_Broadcast, WM_FontChange, 0, 0) ' 廣播訊息字型異動
MessageBox.Show("OK!") ' 顯示完成訊息
End Sub
' 方法2 : 新增字型
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
' GetEnvironmentVariable 方法: 取得環境變數
' WinDir : Windows 所在目錄, Windows\Fonts 為: 字型所在目錄
' Path.GetFileName 方法: 要從其中取得檔案名稱和副檔名的路徑字串。
Dim strDstFile As String = GetEnvironmentVariable("WinDir") & "\Fonts\" & Path.GetFileName(strFile)
File.Copy(strFile, strDstFile) ' 複製字型檔案到Windows 字型目錄
If AddFontResource(strFile) Then ' Call API AddFontResource 增加字型
SendMessage(HWND_Broadcast, WM_FontChange, 0, 0) ' 廣播訊息字型異動
MessageBox.Show("OK!") ' 顯示完成訊息
End If
End Sub
' 移除字型
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
' GetEnvironmentVariable 方法: 取得環境變數
' WinDir : Windows 所在目錄, Windows\Fonts 為: 字型所在目錄
' Path.GetFileName 方法: 要從其中取得檔案名稱和副檔名的路徑字串。
Dim strFontFile As String = GetEnvironmentVariable("WinDir") & "\Fonts\" & Path.GetFileName(strFile)
If RemoveFontResource(strFontFile) Then ' Call API RemoveFontResource 移除字型
File.Delete(strFontFile) ' 刪除字型檔
SendMessage(HWND_Broadcast, WM_FontChange, 0, 0) ' 廣播訊息字型異動
MessageBox.Show("OK!") ' 顯示完成訊息
End If
End Sub
End Class