1

嘿，我正试图将我的嵌入式字体AbrahamLincoln调用到我的标签中，尽管当我运行程序时它永远不会改变字体......

Private Sub slackerR_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
    Dim sMyFonts As String() = {"AbrahamLincoln.ttf"}
    Dim fEmbedded As New Font(GetFont(sMyFonts).Families(0), 10)
    Label1.Font = fEmbedded
End Sub

Public Function GetFont(ByVal FontResource() As String) As Drawing.Text.PrivateFontCollection
    'Get the namespace of the application    
    Dim NameSpc As String = Reflection.Assembly.GetExecutingAssembly().GetName().Name.ToString()
    Dim FntStrm As IO.Stream
    Dim FntFC As New Drawing.Text.PrivateFontCollection()
    Dim i As Integer
    For i = 0 To FontResource.GetUpperBound(0)
        'Get the resource stream area where the font is located
        FntStrm = Reflection.Assembly.GetExecutingAssembly().GetManifestResourceStream(NameSpc + "." + FontResource(i))
        'Load the font off the stream into a byte array 
        Dim ByteStrm(CType(FntStrm.Length, Integer)) As Byte
        FntStrm.Read(ByteStrm, 0, Int(CType(FntStrm.Length, Integer)))
        'Allocate some memory on the global heap
        Dim FntPtr As IntPtr = Runtime.InteropServices.Marshal.AllocHGlobal(Runtime.InteropServices.Marshal.SizeOf(GetType(Byte)) * ByteStrm.Length)
        'Copy the byte array holding the font into the allocated memory.
        Runtime.InteropServices.Marshal.Copy(ByteStrm, 0, FntPtr, ByteStrm.Length)
        'Add the font to the PrivateFontCollection
        FntFC.AddMemoryFont(FntPtr, ByteStrm.Length)
        'Free the memory
        Runtime.InteropServices.Marshal.FreeHGlobal(FntPtr)
    Next
    Return FntFC
End Function

我已经尝试过{"AbrahamLincoln.ttf"}和{"AbrahamLincoln"}并且都不起作用。

使用 VB.net 2010。

4

1 回答 1

1

这对你来说可能是一种更简单的方法......

将字体放入您的资源中。

添加这样的模块：（更改“My.Resources.[your resource name]”下方的资源名称）

Module agencyFontNormal
Private _pfc As PrivateFontCollection = Nothing
Public ReadOnly Property GetInstance(ByVal Size As Single, ByVal style As FontStyle) As Font
    Get
        If _pfc Is Nothing Then LoadFont()
        Return New Font(_pfc.Families(0), Size, style)
    End Get
End Property
Private Sub LoadFont()
    Try
        _pfc = New PrivateFontCollection
        Dim fontMemPointer As IntPtr = Marshal.AllocCoTaskMem(My.Resources.AGENCYNORMAL.Length)
        Marshal.Copy(My.Resources.AGENCYNORMAL, 0, fontMemPointer, My.Resources.AGENCYNORMAL.Length)
        _pfc.AddMemoryFont(fontMemPointer, My.Resources.AGENCYNORMAL.Length)
        Marshal.FreeCoTaskMem(fontMemPointer)
    Catch ex As Exception
    End Try
End Sub
End Module

通过以下方式致电：

Dim ff As Font = agencyFontNormal.GetInstance(12, FontStyle.Regular)
于 2014-02-03T06:30:12.270 回答