载入私有字体、私有字符集.md

直接从文件载入字体
方便，直接，不需要系统安装过该字体
可直接应用到GDI+或者控件当中


Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim fontpath As String = "G:\fonts\田氏圆笔刷体繁.ttf"

    Dim g As Graphics = Me.CreateGraphics

    Dim PFC As New Drawing.Text.PrivateFontCollection() '私有字符集和
    PFC.AddFontFile(fontpath) '载入一个字符文件
    '…………

    Dim FFS() As FontFamily = PFC.Families

    Dim FName As String = FFS(0).Name

    Dim F As New Font(FFS(0), 16) '创建字符实例
    Dim B As New SolidBrush(Color.Blue) '字体颜色
    Dim P As New PointF(10, 10) '字符位置

    g.DrawString("This is MyText!!! " & vbCrLf & "我的私有字体！！！", F, B, P)

    Button1.Font = New Font(F, FontStyle.Regular)
End Sub

载入内存字体
内存字体的载入方法，就复杂一点，要用 Marshal.Copy 将数据写入一个内存指针
==并且如果控件要使用内存字体==，还需要设置它的 ==UseCompatibleTextRendering== 属性

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    ' 用数据加载字体，这里可以用各种方法来加载数据，比如从文件、程序集、或者其他方式
    Dim fontpath As String = "G:\fonts\田氏圆笔刷体繁.ttf"
    Dim fontbytes As Byte() = IO.File.ReadAllBytes(fontpath)

    ' 将数据拷入内存指针
    Dim fontPtr As IntPtr = Runtime.InteropServices.Marshal.AllocCoTaskMem(fontbytes.Length)
    Runtime.InteropServices.Marshal.Copy(fontbytes, 0, fontPtr, fontbytes.Length)

    Dim g As Graphics = Me.CreateGraphics

    Dim PFC As New Drawing.Text.PrivateFontCollection() '私有字符集和
    ' 载入一个内存字符数据
    PFC.AddMemoryFont(fontPtr, fontbytes.Length)
    Runtime.InteropServices.Marshal.FreeCoTaskMem(fontPtr) '记得释放内存
    '…………

    Dim FFS() As FontFamily = PFC.Families

    Dim FName As String = FFS(0).Name

    Dim F As New Font(FFS(0), 16) '创建字符实例
    Dim B As New SolidBrush(Color.Blue) '字体颜色
    Dim P As New PointF(10, 10) '字符位置

    g.DrawString("This is MyText!!! " & vbCrLf & "我的私有字体！！！", F, B, P)

    ' 注意！！！！！要想控件使用内存字符
    ' 一定要将控件的 UseCompatibleTextRendering 属性设为True
    Button2.UseCompatibleTextRendering = True
    Button2.Font = New Font(F, FontStyle.Regular)
End Sub

载入内嵌程序集资源
将字体文件复制到工程内，设置文件属性【生成操作】为【嵌入的资源】
其中 ==WindowsApplication1== 为程序的根命名空间，请自己修改

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
    Dim fontAName As String = "WindowsApplication1.田氏圆笔刷体繁.ttf"
    Dim fontStream As IO.Stream = Reflection.Assembly.GetEntryAssembly.GetManifestResourceStream(fontAName)
    'Dim fontStream As IO.Stream = Me.GetType.Assembly.GetManifestResourceStream(fontAName)

    Dim fontbytes(fontStream.Length - 1) As Byte
    fontStream.Read(fontbytes, 0, fontStream.Length)
    fontStream.Close()

    Dim fontPtr As IntPtr = Runtime.InteropServices.Marshal.AllocCoTaskMem(fontbytes.Length)
    Runtime.InteropServices.Marshal.Copy(fontbytes, 0, fontPtr, fontbytes.Length)

    Dim g As Graphics = Me.CreateGraphics

    Dim PFC As New Drawing.Text.PrivateFontCollection() '私有字符集和
    ' 载入一个内存字符数据
    PFC.AddMemoryFont(fontPtr, fontbytes.Length)
    Runtime.InteropServices.Marshal.FreeCoTaskMem(fontPtr) '记得释放内存
    '…………

    Dim FFS() As FontFamily = PFC.Families

    Dim F As New Font(FFS(0), 16) '创建字符实例
    Dim B As New SolidBrush(Color.Blue) '字体颜色
    Dim P As New PointF(10, 10) '字符位置

    g.DrawString("This is MyText!!! " & vbCrLf & "我的私有字体！！！", F, B, P)

    Button3.UseCompatibleTextRendering = True
    Button3.Font = F
End Sub

另外，如果采用Sub Main方式执行程序的话，可以在运行窗体之前，使用 ==Application.SetCompatibleTextRenderingDefault(True)== 这个方法，来默认程序内控件的绘制行为，就不用为每个控件指定 ==UseCompatibleTextRendering== 属性了。

Sub Main()
    Application.EnableVisualStyles()
    Application.SetCompatibleTextRenderingDefault(True)
    Application.Run(Form1)
End Sub