Let's introduce three API functions.
Addfontresource,sendmessage,removefontresource.
AddFontResource
This is an add font resource to the System font table, the prototype is as follows:
int AddFontResource(
LPCTSTR lpszFilename // pointer to font-resource filename);
lpszFileName a file name pointing to a font resource
return value : If the function call succeeds, the return value is the number of increased fonts, or if the function call fails, the return value is 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);
ParametersHWnd: The handle of the window whose window program will receive the message. If this parameter is Hwnd_broadcast, the message is sent to all top-level windows in the system, including invalid or invisible non-owned windows, overwritten windows, and pop-up windows, but messages are not sent to child windows. MSG: Specifies the message being sent. WParam: Specifies additional message-specific information. Iparam: Specifies additional message-specific information.
return value : The return value specifies the result of the message processing, depending on the message being sent.
RemoveFontResource
function: This function removes the font from the System font table in the specified file.
BOOL RemoveFontResource( LPCTSTR lpFileName // pointer to font-resource filename);
Parameters: lpFileName: A pointer to a string that ends with a. String that represents the name of the font resource file.
return value: If the function call succeeds, the return value is nonzero, and if the function call fails, the return value is 0. Next we use 2 command controls in the VB6.0, 1 text controls and a list control to complete the code immediately after the introduction:
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 WPar Am 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 ("Please enter the path and name of the font file:", "Add Font")
j = AddFontResource (s)
If j = 0 Then
MsgBox "Failed to add font, please check the path and file name are correct"
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 ("Please enter the path and name of the font:", "Delete Font")
K = RemoveFontResource (s)
If K = 0 Then
MsgBox "Failed to delete font, please check the path and file name are correct"
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 = "Because Love your Love" + CHR + chr (10) _
+ "Dream of your Dream" + chr (10) _
+ "So your happiness" + CHR + chr (10) _
+ "Happy your Happiness" + CHR + chr (10)
For i = 0 to Screen.fontcount-1
Me.List1.AddItem screen.fonts (i)
Next I
End Sub
Lesson three application of VB API font function