标签：des style blog http color io os ar for
先来介绍三个个API函数
AddFontResource
这是一个添加字体资源到系统字体表中，原型如下：int AddFontResource(
LPCTSTR lpszFilename // pointer to font-resource filename );
lpszfilename 指向字体资源的文件名
返回值：如果函数调用成功，则返回值为增加的字体数；如果函数调用失败，返回值是0。
SendMessage
该函数将指定的消息发送到一个或多个窗口。此函数为指定的窗口调用窗口程序，直到窗口程序处理完消息再返回。而和函数PostMessage不同，PostMessage是将一个消息寄送到一个线程的消息队列后就立即返回。
LRESULT SendMessage(
HWND hWnd, // handle of destination window
UINT Msg, // message to send
WPARAM wParam, // first message parameter
LPARAM lParam // second message parameter
);
RemoveFontResourceBOOL RemoveFontResource(
LPCTSTR lpFileName // pointer to font-resource filename
);
Option Explicit
Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_FONTCHANGE = &H1D
Dim s As String
Private Sub Command1_Click()
Dim i, j As Long
s = InputBox("请输入字体文件的路径及名称：", "添加字体")
j = AddFontResource(s)
If j = 0 Then
MsgBox "添加字体失败，请检查路径及文件名是否正确"
Exit Sub
End If
Call SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Me.List1.Clear
For i = 0 To Screen.FontCount - 1
Me.List1.AddItem Screen.Fonts(i)
Next i
End Sub
Private Sub Command2_Click()
Dim i, K As Long
s = InputBox("请输入字体的路径及名称：", "删除字体")
K = RemoveFontResource(s)
If K = 0 Then
MsgBox "删除字体失败，请检查路径及文件名是否正确"
Exit Sub
End If
Call SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Me.List1.Clear
For i = 0 To Screen.FontCount - 1
Me.List1.AddItem Screen.Fonts(i)
Next i
End Sub
Private Sub List1_Click()
Me.Text1.FontName = Me.List1.List(List1.ListIndex)
End Sub
Private Sub Form_Load()
Dim i As Integer
Me.Text1.Text = ""
Me.Text1.Text = "因为爱着你的爱" + Chr(13) + Chr(10) _
+ "因为梦着你的梦" + Chr(13) + Chr(10) _
+ "所以着你的快乐" + Chr(13) + Chr(10) _
+ "幸福着你的幸福" + Chr(13) + Chr(10)
For i = 0 To Screen.FontCount - 1
Me.List1.AddItem Screen.Fonts(i)
Next i
End Sub
标签：des style blog http color io os ar for
原文地址：http://www.cnblogs.com/delphi2014/p/4008152.html
