字体没有在windows中安装，是exe附带的文件
一开始我用的是这种方法
Dim myfont as Font
Dim Collection As Drawing.Text.PrivateFontCollection = New Drawing.Text.PrivateFontCollection
Collection.AddFontFile(Application.StartupPath + "\zt.ttf")
myfont = New Font(Collection.Families(0).Name, 67, FontStyle.Regular, GraphicsUnit.Pixel)
可是不成功，加了断点调试一看，执行到最后，Collection.Families(0).Name是字体的名字，可是myfont.Name却是Microsoft Sans Serif
后来查了msdn，他说 If you attempt to use a font that is not supported, or the font is not installed on the machine that is running the application, the Microsoft Sans Serif font will be substituted.也就是说，如果你字体不被支持或没有安装，就会用Microsoft Sans Serif代替
后来我就在前面加了两句
AddFontResource(Application.StartupPath + "\zt.ttf")
SendMessage(New System.IntPtr(&HFFFF), &H1D, 0, 0)
可是问题如初（API已经声明了），System.Runtime.InteropServices.Marshal.GetLastWin32Error()返回也是0.
我把字体安装了之后又试，结果就正常了，卸载了，又不行了。
后来我把字体加到资源文件里，用这种方法
Dim Collection As Drawing.Text.PrivateFontCollection = New Drawing.Text.PrivateFontCollection
Dim fontMemPointer As IntPtr = _
Runtime.InteropServices.Marshal.AllocCoTaskMem( _
My.Resources.zt.Length)
Runtime.InteropServices.Marshal.Copy(My.Resources.zt, _
0, fontMemPointer, _
My.Resources.zt.Length)
Collection.AddMemoryFont(fontMemPointer, _
My.Resources.zt.Length)
Runtime.InteropServices.Marshal.FreeCoTaskMem(fontMemPointer)
myfont = New Font(Collection.Families(0).Name, 67, FontStyle.Regular, GraphicsUnit.Pixel)
结果一切的一切和原来一模一样
我实在是没辙了，查了一天的资料，百度，必应，中文，英文，除了将字体文件复制到系统字体文件夹（不想用这种方法，怕被报毒），所有的方法不出这三种，快崩溃了
写了比较多，请求大神耐心仔细看完，救救我这小白