Embedded font doesnt display properly in printdocument

            Dim FontNames(3) As String
            FontNames(0) = "LTYPE.TTF"
            FontNames(1) = "LTYPEB.TTF"
            FontNames(2) = "LTYPEBO.TTF"
            FontNames(3) = "LTYPEO.TTF"
            prvFC = Me.GetFont(FontNames)
            Cur.LucidaFonts = prvFC

 Public Function GetFont(ByVal FontResource() As String) As Drawing.Text.PrivateFontCollection
        Try
            'Get the namespace of the application  '  
            Dim NameSpc As String = Reflection.Assembly.GetExecutingAssembly().GetName().Name.ToString()
            Dim FntStrm As System.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)
                Dim pcFonts As Int32
                pcFonts = 1
                AddFontMemResourceEx(FntPtr, ByteStrm.Length, 0, pcFonts)
                'Free the memory '
                Runtime.InteropServices.Marshal.FreeHGlobal(FntPtr)
            Next
            Return FntFC
        Catch ex As Exception
            Dim xx As String = ex.Message
            Return Nothing
        End Try
    End Function


 Private Sub PD1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PD1.PrintPage
        Dim Hfnt As New Font(Cur.LucidaFonts.Families(0), 10, FontStyle.Bold)
        e.Graphics.DrawString("Test Font Print", Hfnt, Brushes.Black, x, y)
End Sub

Select all Open in new window