[VB.net] 程式中使用外掛字形檔的方法（二）經由資源檔載入外掛的字形

2012-02-14

4382
0
VB.net
2012-02-17

前文實作了外掛自訂字形的基本方法，藉由編譯時把要加掛的字形檔屬性［複製到輸出目錄］設為 True，使在建立封裝包時把字形檔加入組建資料夾。之後 User 在安裝程式後字形檔就會帶進去供使用了。
但是有時我們不想字形檔直接外露在用戶的資料夾，或是一些小型的 demo 程式不需經過封裝的過程，只想建立一個單獨的 exe 執行檔的情況下就可以用 PrivateFontCollection 類別的 AddMemoryFont() 方法了。
接下來再實作一個直接從資源包帶入字形的 demo 程式：

前文實作了外掛自訂字形的基本方法，藉由編譯時把要加掛的字形檔屬性［複製到輸出目錄］設為 True，使在建立封裝包時把字形檔加入組建資料夾。之後 User 在安裝程式後字形檔就會帶進去供使用了。

但是有時我們不想字形檔直接外露在用戶的資料夾，或是一些小型的 demo 程式不需經過封裝的過程，只想建立一個單獨的 exe 執行檔的情況下就可以用 PrivateFontCollection 類別的 AddMemoryFont() 方法了。

接下來再實作一個直接從資源包帶入字形的 demo 程式：

先把要用到的字形檔放進資源。
從專案屬性［資源］選擇資源類型為［檔案］，把字形檔拖拉進去。
然後，再寫一段程式建立一個函式來測試。
這個函式的動作是先從資源包裡找到要用的字形名稱，再將之存入 Binary() 陣列，然後再把陣列的記憶體指標（IntPtr）做為參數去呼叫 AddMemoryFont() 方法。

程式碼如下：


    '------------------------------------
    ' 從內部資源載入字形（資源名稱） 
    '------------------------------------
    Function 從資源掛入字形(字形檔名 As String) As FontFamily
        Dim 自訂字形集合 As New PrivateFontCollection
        Dim 系統字形集合 As New InstalledFontCollection
        Dim 字形檔陣列() As Byte     ' 從資源中取出字形資料先存到陣列
        Dim 輸出字形 As FontFamily
        Try
            Dim 資源名稱 = New System.IO.FileInfo(Split(字形檔名, ".")(0)).Name           ' 從資源中找到字形檔
            字形檔陣列 = CType(My.Resources.ResourceManager.GetObject(資源名稱), Byte())  ' 讀入 Binary 陣列
            Dim 記憶體指標 As IntPtr = Marshal.UnsafeAddrOfPinnedArrayElement(字形檔陣列, 0)
            自訂字形集合.AddMemoryFont(記憶體指標, 字形檔陣列.Length)
            輸出字形 = 自訂字形集合.Families(0)
        Catch ex As Exception
            輸出字形 = 系統字形集合.Families(0)
        End Try
        Return 輸出字形
    End Function

哈哈，執行起來居然無效（見圖）。
偵錯之後看到確實已經把字形加到自訂字形集合.Families 了，這就有點怪了。
查資料之後注意到了這一段文字（查 MSDN）：

若要使用記憶體字型，控制項上的文字必須以 GDI+ 呈現。
使用 SetCompatibleTextRenderingDefault 方法，傳遞 true，即可設定應用程式上的 GDI+ 呈現，或是將控制項的 UseCompatibleTextRendering 屬性設為 true，即可在個別控制項上呈現。
有些控制項無法使用 GDI+ 呈現。

原來如此，再改寫函式直接把 Label 控制項做參數傳入，程式碼如下，：


    '------------------------------------
    ' 從內部資源載入字形（資源名稱） 
    '------------------------------------
    Function 從資源掛入字形(字形物件 As Label, 字形檔名 As String) As FontFamily
        Dim 自訂字形集合 As New PrivateFontCollection
        Dim 系統字形集合 As New InstalledFontCollection
        Dim 字形檔陣列() As Byte     ' 從資源中取出字形資料先存到陣列
        Dim 輸出字形 As FontFamily
        Try
            Dim 資源名稱 = New System.IO.FileInfo(Split(字形檔名, ".")(0)).Name           ' 從資源中找到字形檔
            字形檔陣列 = CType(My.Resources.ResourceManager.GetObject(資源名稱), Byte())  ' 讀入 Binary 陣列
            Dim 記憶體指標 As IntPtr = Marshal.UnsafeAddrOfPinnedArrayElement(字形檔陣列, 0)
            自訂字形集合.AddMemoryFont(記憶體指標, 字形檔陣列.Length)
            字形物件.UseCompatibleTextRendering = True    ' 從記憶體直接掛入時要加上這一列
            輸出字形 = 自訂字形集合.Families(0)
        Catch ex As Exception
            輸出字形 = 系統字形集合.Families(0)
        End Try
        字形物件.Font = New System.Drawing.Font(輸出字形, 字形物件.Font.Size, 字形物件.Font.Style)
        Return 輸出字形
    End Function

再跑一次看看（貼圖為執行前後的對照）：
再寫得更完整一點
因為 MSDN 說有些控制項使用從記憶體入字形時（有些控制項無法使用 GDI+ 呈現）所以又改了一下函式，讓設計人員可以選擇是否要從記憶體載入。

若不從記憶體載入時（字形仍採由資源包帶進場），就把包含字形檔的二進位陣列還原為 xxx.ttf 檔案回存到 User 的 AppData\Temp 資料夾後，再用讀外部字形檔的手法處理。


Imports System.Drawing.Text
Imports System.Runtime.InteropServices
Public Class Form1


    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Me.Text = "從資源檔掛上自訂字形 demo "
        Button1.Text = "暫停"
        外掛字形(lbl_數位1, "digifaw.TTF", True) ' Label_數位1 使用 "digifaw.TTF"，從 Binary() 陣列載入
        外掛字形(lbl_數位2, "Ventouse.ttf")      ' Label_數位1 使用 "digifaw.TTF"，從檔案載入
        外掛字形(LBL_數位3, "QuartzMS.TTF")      ' Label_數位2 使用 "QuartzMS.TTF"，從檔案載入
        外掛字形(lbl_B39, "code39.TTF")          ' Label_B39 使用 "code39.TTF"，從檔案載入
    End Sub
    '--- S=目標字串， V=捲動次數（ +v 右捲, -v 左捲）---
    Function 文字旋轉(ByVal s As String, ByVal v As Integer) As String
        文字旋轉 = Mid(s & s & s, Len(s) - (v Mod Len(s)) + 1, Len(s))
    End Function
    Private Sub Timer1_Tick_1(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        lbl_數位1.Text = 文字旋轉(lbl_數位1.Text, -1)
        lbl_數位2.Text = 文字旋轉(lbl_數位2.Text, +1)
        LBL_數位3.Text = 文字旋轉(LBL_數位3.Text, +1)
        lbl_B39.Text = 文字旋轉(lbl_B39.Text, -1)
    End Sub
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Timer1.Enabled = Not Timer1.Enabled
        sender.text = If(Timer1.Enabled, "暫停", "繼續")
    End Sub


    '---------------------------------------------------------------------------------------------
    ' 先把字形放在資源中，本函數會從資源檔外掛字形到 Label 控制項（若外掛失敗時用系統第一個字形）
    ' 傳入參數：
    '   1. 字形物件     - 要使用加掛字形的 Label 控制項。
    '   2. 字形資源名稱 - 就是原字檔的檔案名稱。
    '   3. 從記憶體掛入 - True=從記憶體直接掛入，False=先存至本地硬碟再從檔案掛入。
    '---------------------------------------------------------------------------------------------
    Function 外掛字形(字形物件 As Label, 字形資源名稱 As String, Optional 從記憶體掛入 As Boolean = False) As FontFamily
        Dim 自訂字形集合 As New PrivateFontCollection
        Dim 系統字形集合 As New InstalledFontCollection
        Dim 字形檔陣列() As Byte                                         ' 從資源中取出字形資料先存到陣列
        Dim 暫存資料夾 = My.Computer.FileSystem.SpecialDirectories.Temp  ' 若不想從記憶體直接掛入時暫存於此處
        Dim 輸出字形 As FontFamily
        Try
            Dim 資源名稱 = New System.IO.FileInfo(Split(字形資源名稱, ".")(0)).Name       ' 從資源中找到字形檔
            字形檔陣列 = CType(My.Resources.ResourceManager.GetObject(資源名稱), Byte())  ' 讀入 Binary 陣列
            If 從記憶體掛入 Then
                '---從記憶體直接掛入---
                Dim 記憶體指標 As IntPtr = Marshal.UnsafeAddrOfPinnedArrayElement(字形檔陣列, 0)
                自訂字形集合.AddMemoryFont(記憶體指標, 字形檔陣列.Length)
                字形物件.UseCompatibleTextRendering = True    ' 從記憶體直接掛入時要加上這一列
            Else
                '---轉存到 Temp 資料夾再掛入---
                Dim bf = New System.IO.FileStream(暫存資料夾 & "\" & 字形資源名稱, IO.FileMode.Create, IO.FileAccess.ReadWrite)
                bf.Write(字形檔陣列, 0, 字形檔陣列.Length)
                bf.Close()
                自訂字形集合.AddFontFile(暫存資料夾 & "\" & 字形資源名稱)
            End If
            輸出字形 = 自訂字形集合.Families(0)
        Catch ex As Exception
            輸出字形 = 系統字形集合.Families(0)
        End Try
        字形物件.Font = New System.Drawing.Font(輸出字形, 字形物件.Font.Size, 字形物件.Font.Style)
        Return 輸出字形
    End Function
    '------------------------------------
    ' 從外部載入字形檔（xxx.ttf）
    '------------------------------------
    Function 從外部檔案掛入字形(字形檔徑名 As String) As FontFamily
        Dim 自訂字形集合 As New PrivateFontCollection
        Dim 系統字形集合 As New InstalledFontCollection
        Dim 輸出字形 As FontFamily
        Try
            自訂字形集合.AddFontFile(字形檔徑名)
            輸出字形 = 自訂字形集合.Families(0)
        Catch ex As Exception
            輸出字形 = 系統字形集合.Families(0)
        End Try
        Return 輸出字形
    End Function
    '------------------------------------
    ' 從內部資源載入字形（資源名稱） 
    '------------------------------------
    Function 從資源掛入字形(字形物件 As Label, 字形檔名 As String) As FontFamily
        Dim 自訂字形集合 As New PrivateFontCollection
        Dim 系統字形集合 As New InstalledFontCollection
        Dim 字形檔陣列() As Byte     ' 從資源中取出字形資料先存到陣列
        Dim 輸出字形 As FontFamily
        Try
            Dim 資源名稱 = New System.IO.FileInfo(Split(字形檔名, ".")(0)).Name           ' 從資源中找到字形檔
            字形檔陣列 = CType(My.Resources.ResourceManager.GetObject(資源名稱), Byte())  ' 讀入 Binary 陣列
            Dim 記憶體指標 As IntPtr = Marshal.UnsafeAddrOfPinnedArrayElement(字形檔陣列, 0)
            自訂字形集合.AddMemoryFont(記憶體指標, 字形檔陣列.Length)
            字形物件.UseCompatibleTextRendering = True    ' 從記憶體直接掛入時要加上這一列
            輸出字形 = 自訂字形集合.Families(0)
        Catch ex As Exception
            輸出字形 = 系統字形集合.Families(0)
        End Try
        字形物件.Font = New System.Drawing.Font(輸出字形, 字形物件.Font.Size, 字形物件.Font.Style)
        Return 輸出字形
    End Function
End Class

結果擷圖：

用跑馬燈呈現
下載［外掛字形檔_demo.rar］
下載［外掛字形檔_專案原始碼.rar］

ku3

回首頁