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

2009-03-26 08:09:31 670 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

docker 离线安装字体库云服务docker部署环境时离线安装字体库。阅读详情

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

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

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

...全文