无法安装字体,哪里不对?

dongyisheng 2009-03-26 08:09:31
小弟本人通过程序加载一个“微软雅黑”字体,但是总是不成功(系统中原先没有安装过该字体),
以下是程序代码,望达人指点一下,哪里不对,需要在那里改一下。

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


程序的字体就是不能显示出来,是那里不对呀?
...全文
608 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
清晨曦月 元老 2009-04-12
  • 打赏
  • 举报
回复
这个。。。。你是要安装然后给别的程序用,还是……
去看看FONT类吧。提供了很多方法,不安装也可以使用。
GHOSTSEA 2009-03-30
  • 打赏
  • 举报
回复
帮顶~~~~~
dongyisheng 2009-03-27
  • 打赏
  • 举报
回复
是不是代码太长了没有人愿意看呀!
dongyisheng 2009-03-26
  • 打赏
  • 举报
回复
[Quote=引用 1 楼 wuyq11 的回复:]
http://www.cnblogs.com/james.wong/articles/93942.html
[/Quote]

我和楼主给的链接的代码完全一样呀!但是就是不行呀!
wuyq11 2009-03-26
  • 打赏
  • 举报
回复
http://www.cnblogs.com/james.wong/articles/93942.html

16,549

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧