无法安装字体，哪里不对？

[dongyisheng]

小弟本人通过程序加载一个“微软雅黑”字体，但是总是不成功（系统中原先没有安装过该字体），
以下是程序代码，望达人指点一下，哪里不对，需要在那里改一下。

Imports System.IO
Public Class Form1
Private Declare Function CreateScalableFontResource Lib "gdi32" Alias "CreateScalableFontResourceA" (ByVal fHidden As Integer, ByVal lpszResourceFile As String, ByVal lpszFontFile As String, ByVal lpszCurrentPath As String) As Integer
Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Integer
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
'Private Declare Auto Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_FONTCHANGE As Long = &H1D

Dim strFontFile As String
Dim FontName As String = Environment.CurrentDirectory & "\MSYH.TTF" '这是微软雅黑字体
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
AddAppFont()
End Sub

Public Sub AddAppFont()
Dim lResult As Long
strFontFile = Environment.CurrentDirectory & "\TEMP.FOT"
If CreateScalableFontResource(0, strFontFile, FontName, vbNullString) <> 0 Then
lResult = AddFontResource(FontName)
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) '通知程序字体已经更改
Else
End
End If
End Sub
Public Sub RemoveAppFont()
Dim lResult As Long
lResult = RemoveFontResource(FontName)
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
File.Delete(strFontFile)
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
With Label1
.Font = New Font("微软雅黑", 20, FontStyle.Regular, GraphicsUnit.Pixel, CType(134, Byte))
.Text = "这个字体是不是微软雅黑"
End With
Debug.Print(Label1.Font.ToString)
End Sub
Private Sub Form1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.DoubleClick
RemoveAppFont()
End
End Sub
End Class


程序的字体就是不能显示出来，是那里不对呀？

[wuyq11]

http://www.cnblogs.com/james.wong/articles/93942.html

[dongyisheng]

[Quote=引用 1 楼 wuyq11 的回复:]
http://www.cnblogs.com/james.wong/articles/93942.html
[/Quote]

我和楼主给的链接的代码完全一样呀！但是就是不行呀！

[dongyisheng]

是不是代码太长了没有人愿意看呀！

[GHOSTSEA]

帮顶~~~~~

[清晨曦月]

这个。。。。你是要安装然后给别的程序用，还是……
去看看FONT类吧。提供了很多方法，不安装也可以使用。