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