Osadzona czcionka powoduje awarię
Mam aplikację WinForm. Używam niestandardowej czcionki, która znajduje się w moich osadzonych zasobach.
Działa na początku, ale powoduje, że program po jakimś czasie ulega awarii.
Używając następującego kodu jako przykładu, jeśli będę zmieniał rozmiar formularza, zmuszając go do ciągłego przerysowywania, to ulegnie on awarii w ciągu kilku sekund. Wiadomość, którą otrzymuję, brzmi:Error in 'Form1_Paint()'. Object is currently in use elsewhere.
”
Co ja robię źle? Jak mogę tego uniknąć?
Mam czcionkętutaj.
Dzięki.
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