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

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

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

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

 

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

  1. 先把要用到的字形檔放進資源。
  2. 從專案屬性[資源]選擇資源類型為[檔案],把字形檔拖拉進去。

    imageimage
  3. 然後,再寫一段程式建立一個函式來測試。
  4. 這個函式的動作是先從資源包裡找到要用的字形名稱,再將之存入 Binary() 陣列,然後再把陣列的記憶體指標(IntPtr)做為參數去呼叫 AddMemoryFont() 方法。
  5. 程式碼如下:

    
        '------------------------------------
        ' 從內部資源載入字形(資源名稱) 
        '------------------------------------
        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
    
  6. 哈哈,執行起來居然無效(見圖)。

    image
     
  7. 偵錯之後看到確實已經把字形加到自訂字形集合.Families 了,這就有點怪了。

    image
     
  8. 查資料之後注意到了這一段文字(查 MSDN):

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

     
  9. 原來如此,再改寫函式直接把 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
    
  10. 再跑一次看看(貼圖為執行前後的對照):

    image
     
  11. 再寫得更完整一點
  12. 因為 MSDN 說有些控制項使用從記憶體入字形時(有些控制項無法使用 GDI+ 呈現)所以又改了一下函式,讓設計人員可以選擇是否要從記憶體載入。
  13. 若不從記憶體載入時(字形仍採由資源包帶進場),就把包含字形檔的二進位陣列還原為 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
    
  14. 結果擷圖:

    image
    用跑馬燈呈現

     
  15. 下載[外掛字形檔_demo.rar
  16. 下載[外掛字形檔_專案原始碼.rar

 

 

 


ku3