嵌入字体导致崩溃

Question

我有一个 WinForm 应用程序。我正在使用嵌入资源中的自定义字体。
它起初可以工作，但一段时间后会导致程序崩溃。
以下面的代码为例，如果我不断调整表单的大小，强制它不断地重绘自己，它会在几秒钟内崩溃。我收到的消息是“Error in 'Form1_Paint()'. Object is currently in use elsewhere.”。
我究竟做错了什么？我怎样才能避免这种情况？
我从here.获得字体
谢谢。

Imports System.Drawing.Text
Imports System.Runtime.InteropServices

Public Class Form1
    Friend Harabara As Font

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        LoadFonts()
    End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        Try
            e.Graphics.DrawString("This was drawn using the custom font 'Harabara'", Harabara, Brushes.Lime, 10.0F, 10.0F)
        Catch ex As Exception
            MsgBox("Error in Form1_Paint()'" & vbCrLf & ex.Message)
        End Try
    End Sub

    Public Sub LoadFonts()
        Try
            Harabara = GetFontInstance(My.Resources.HarabaraHand, 24.0F, FontStyle.Italic)
        Catch ex As Exception
            MsgBox("Error in 'LoadFonts()'" & vbCrLf & ex.Message)
        End Try
    End Sub

    Private 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
End Class

Answer 1

        Marshal.FreeCoTaskMem(FontPtr)

PrivateFontCollection 的 MSDN 文档对此过于迟钝。但是您需要保持添加字体的内存有效，直到您不能再使用该字体。或者换一种说法，AddMemoryFont() 确实不复制字体。因此，当您的程序尝试访问字体数据并被另一个非托管内存分配覆盖时，它会因神秘的 GDI+ 错误而崩溃。

将 FreeCoTaskMem() 调用移至 FormClosed 事件处理程序。或者，如果关闭表单也会终止您的程序，请不要担心。