先来介绍三个个API函数
AddFontResource，SendMessage，RemoveFontResource。
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
);参数
hWnd：其窗口程序将接收消息的窗口的句柄。如果此参数为HWND_BROADCAST，则消息将被发送到系统中所有顶层窗口，包括无效或不可见的非自身拥有的窗口、被覆盖的窗口和弹出式窗口，但消息不被发送到子窗口。
Msg：指定被发送的消息。
wParam：指定附加的消息特定信息。
IParam：指定附加的消息特定信息。
返回值：返回值指定消息处理的结果，依赖于所发送的消息。
RemoveFontResource功能：该函数从系统字体表中除去在指定文件里的字体。
BOOL RemoveFontResource(
LPCTSTR lpFileName // pointer to font-resource filename
);
参数：
lpFileName：指向以\0结束的字符串的指针，该字符串表示字体资源文件的名字。
返回值：如果函数调用成功，返回值非零，如果函数调用失败，返回值是０。
接下来我们在VB6.0中用到2个Command控件，1个Text控件和一个List控件如图：
介绍完之后直接上代码：
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