在Visual Basic 2010中嵌入用于文本框的自定义字体

时间:2013-02-23 15:33:58

标签: vb.net visual-studio-2010 fonts textbox gdi

好的我正在解决问题,在文本框中嵌入LCD类型的真实字体。至于某些背景,如果我将字体安装到我的系统上,然后将其加载为文本框的字体类型,我可以显示lcd字体,它可以很好地工作。但是,它不能作为应用程序中的嵌入字体。我在Visual Basic中使用Windows窗体应用程序,来自Windows 7盒子上的Microsoft Visual Studio 2010。

在将字体存储为资源文件并将属性设置为embed resource之后,我使用内存中的私有字体集合尝试了以下代码。

Imports System.Drawing.Text

Imports System.Runtime.InteropServices

Module CustomFont

'PRIVATE FONT COLLECTION TO HOLD THE DYNAMIC FONT

Private _pfc As PrivateFontCollection = Nothing

Public ReadOnly Property GetInstance(ByVal Size As Single, _

                                     ByVal style As FontStyle) As Font

    Get

        'IF THIS IS THE FIRST TIME GETTING AN INSTANCE

        'LOAD THE FONT FROM RESOURCES

        If _pfc Is Nothing Then LoadFont()

        'RETURN A NEW FONT OBJECT BASED ON THE SIZE AND STYLE PASSED IN

        Return New Font(_pfc.Families(0), Size, style)


    End Get

End Property



Private Sub LoadFont()

    Try

        'INIT THE FONT COLLECTION

        _pfc = New PrivateFontCollection



        'LOAD MEMORY POINTER FOR FONT RESOURCE

        Dim fontMemPointer As IntPtr = _

            Marshal.AllocCoTaskMem( _

            My.Resources.DIGITALDREAMNARROW.Length)



        'COPY THE DATA TO THE MEMORY LOCATION

        Marshal.Copy(My.Resources.DIGITALDREAMNARROW, _

                     0, fontMemPointer, _

                     My.Resources.DIGITALDREAMNARROW.Length)



        'LOAD THE MEMORY FONT INTO THE PRIVATE FONT COLLECTION

        _pfc.AddMemoryFont(fontMemPointer, _

                           My.Resources.DIGITALDREAMNARROW.Length)


        'FREE UNSAFE MEMORY

        Marshal.FreeCoTaskMem(fontMemPointer)

    Catch ex As Exception

        'ERROR LOADING FONT. HANDLE EXCEPTION HERE

    End Try


End Sub

End Module

此代码的问题在于您应该将控件的UseCompatibleTextRendering属性设置为true。如果在标签或按钮文本上使用此模块,它可以很好地工作。但是,对于文本框,没有UseCompatibleTextRendering属性。

我已经明白文本框使用GDI渲染,而其他文本控件使用GDI +(我可能会有那些切换,所以不要引用我,我记得他们是不同的)。

我发现一些较旧的代码片段尝试使用Windows中gdi32.dll文件中的AddFontMemResourceEX函数,有些人声称它适用于文本框。所以我创建了以下类。

Imports System
Imports System.Drawing.Text
Imports System.IO
Imports System.Reflection

Public Class GetLCDFont
Private Declare Auto Function AddFontMemResourceEX Lib "gdi32.dll" _
    (ByVal pbFont As Integer, ByVal cbFont As Integer, _
     ByVal pdv As Integer, ByRef pcFonts As Integer) As IntPtr

Public Shared Function GetFont(ByVal fontName As String) As FontFamily

    Dim exeCurrent As [Assembly] = [Assembly].GetExecutingAssembly()
    Dim nameSpc As String = exeCurrent.GetName().Name.ToString()
    Dim fontCollection As New PrivateFontCollection
    Dim loadStream As Stream = exeCurrent.GetManifestResourceStream( _
        nameSpc + "." + fontName)
    Dim byteBuffer(CType(loadStream.Length, Integer)) As Byte

    loadStream.Read(byteBuffer, 0, Int(CType(loadStream.Length, Integer)))

    Dim fontPtr As IntPtr = Runtime.InteropServices.Marshal.AllocHGlobal( _
        Runtime.InteropServices.Marshal.SizeOf(GetType(Byte)) * _
        byteBuffer.Length)

    Runtime.InteropServices.Marshal.Copy(byteBuffer, 0, fontPtr, byteBuffer.Length)

    fontCollection.AddMemoryFont(fontPtr, byteBuffer.Length)

    Dim pcFonts As Int32 = 1

    AddFontMemResourceEX(fontPtr, byteBuffer.Length, 0, pcFonts)

    Runtime.InteropServices.Marshal.FreeHGlobal(fontPtr)
    Return fontCollection.Families(0)

End Function

Public Sub New()

End Sub

Protected Overrides Sub Finalize()
    MyBase.Finalize()
End Sub
End Class

然而,在调用此类时,我得到一个InvalidOperatioException未处理。错误是无法在DLL'gdi32.dll'中找到名为'AddFontMemResourceEX'的条目。

希望有人可以帮助我告诉我我的错误,或者指出我的方向可以帮助我嵌入字体用于文本框以用于Windows窗体应用程序。

MSDN上引用的大多数示例都指向在使用WPF应用程序时如何打包字体。

谢谢。

2 个答案:

答案 0 :(得分:0)

我一直在使用上面的标签代码,但从未尝试使用文本框。

您可以创建一个继承自Textbox的自定义文本框类,然后覆盖WndProc方法,因为OnPaint不会呈现文本。

Public Class CustomTextBox
  Inherits TextBox

  Public Const WM_NCPAINT As Integer = &H85

  <DllImport("User32.dll")> _
  Public Shared Function GetWindowDC(ByVal hWnd As IntPtr) As IntPtr
  End Function

  <DllImport("user32.dll")> _
  Private Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Boolean
  End Function

  Protected Overrides Sub WndProc(ByRef m As Message)
    MyBase.WndProc(m)

    If m.Msg = WM_NCPAINT Then
      Dim hDC As IntPtr = GetWindowDC(m.HWnd)
      Using g As Graphics = Graphics.FromHdc(hDC)
        g.DrawString(Me.Text, GetInstance(10, FontStyle.Bold), New SolidBrush(Me.ForeColor), Me.ClientRectangle)
      End Using
      ReleaseDC(m.HWnd, hDC)
    End If

  End Sub
End Class

答案 1 :(得分:0)

虽然它不是很干净,但您可以使用安装程序将字体放在应用程序目录中,并使用以下命令将它们加载到PrivateFontCollection中:

    For Each fontfile As String In System.IO.Directory.GetFiles(filepath & "\Fonts", "*.ttf")
        _pfc.AddFontFile(fontfile)
    Next fontfile

我不确定Microsoft为什么会这样对待,但我的TextBoxes和ComboBoxes现在使用我的自定义字体,即使它们没有UseCompatibleTextRendering属性。