1

我试图让 privatefontcollection 工作。但到目前为止它不起作用，不是错误的意思，只是屏幕上看到的字体是 MS Sans Serif 而不是我试图加载的字体。到目前为止，我已经尝试了两种不同的方法，但似乎都不适合我。

首先我试过：

 Public Function GetFontInstance(ByVal data() As Byte, ByVal Size As Single, ByVal Style As FontStyle) As Font
        Dim result As Font
        Try
            Dim pfc = New PrivateFontCollection
            'LOAD MEMORY POINTER FOR FONT RESOURCE
            Dim FontPtr As System.IntPtr = Marshal.AllocCoTaskMem(data.Length)
            'COPY THE DATA TO THE MEMORY LOCATION
            Marshal.Copy(data, 0, FontPtr, data.Length)
            'LOAD THE MEMORY FONT INTO THE PRIVATE FONT COLLECTION
            pfc.AddMemoryFont(FontPtr, data.Length)
            'FREE UNSAFE MEMORY
            'Marshal.FreeCoTaskMem(FontPtr)

            result = New Font(pfc.Families(0), Size, Style)
            pfc.Families(0).Dispose()
            pfc.Dispose()
        Catch ex As Exception
            'ERROR LOADING FONT. HANDLE EXCEPTION HERE
            MsgBox("Error in [GetFontInstance()]" & vbCrLf & ex.Message)
            result = New Font(FontFamily.GenericMonospace, 8)
        End Try
        Return result
    End Function

我从打印子程序中调用了这个函数：

 Dim newFont As Font = GetFontInstance(My.Resources.OpenSans_Bold, 22, FontStyle.Bold)
  
e.Graphics.DrawString("Hello World", newFont, Brushes.Black, 50, 2)

但我在 printdocument 打印预览中看到的只是 MS 无衬线字体。不是我加载到资源中的字体。

然后我尝试了这种方法：

 Dim sAppPath As String
        sAppPath = System.Windows.Forms.Application.StartupPath
        Dim fcollect As New PrivateFontCollection()
        fcollect.AddFontFile(sAppPath & "\OpenSans-Bold.ttf")
        Dim OpenSansFont As New Font(fcollect.Families(0), 50, FontStyle.Bold)

        e.Graphics.DrawString("Hello World", OpenSansFont, Brushes.Black, 50, 2)

我又得到了同样的结果

有什么我想念的东西才能让它工作吗？对此提出的其他问题似乎表明这应该可行。

我应该提一下，最终用户将在系统管理员锁定的 PC 上运行应用程序，因此无法选择“安装”字体。只有在应用程序运行时/调用子例程时，我才需要使用字体。

4

0 回答 0