Article ID: 112672
Article Last Modified on 6/29/2004
' Enter each of the following Declare statements on one, single line:
Declare Function CreateScalableFontResource% Lib "GDI"
(ByVal fHidden%, ByVal lpszResourceFile$,
ByVal lpszFontFile$, ByVal lpszCurrentPath$)
Declare Function AddFontResource Lib "GDI"
(ByVal lpFilename As Any) As Integer
Declare Function WriteProfileString Lib "Kernel"
(ByVal lpApplicationName As String, ByVal lpKeyName As String,
ByVal lpString As String) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer,
ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any)
As Long
Sub Command1_Click()
' Initialize variables for calls to APIs.
' Set name of font to show up in font list:
keyname$ = "Bookman Old Style Bold (TrueType)"
' Set name of font resource file:
font$ = "C:\WINDOWS\SYSTEM\BOOKOSB.FOT"
TTF_Font$ = "bookosb.ttf"
ResPath$ = "c:\WINDOWS\SYSTEM"
' Initialize variables for SendMessage call:
HWND_BROADCAST = &HFFFF
WM_FONTCHANGE = &H1D
' Create the font resource file:
result& = CreateScalableFontResource%(0, font$, TTF_Font$, ResPath$)
If result& Then
' Add resource to Windows font table:
result& = AddFontResource(font$)
If result& Then
' Make changes to WIN.INI to reflect new font:
result& = WriteProfileString("Fonts", keyname$, font$)
If result& Then
' Let other applications know of the change:
result& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0&)
Else
' Report error:
MsgBox "Error Adding Entry to Win.Ini: " + Format$(result&)
End If
Else
' Report error:
MsgBox "Error Adding Font: " + Format$(result&)
End If
Else
' Report error:
MsgBox "Error Creating Scalable font: " + Format$(result&)
End If
End Sub
Keywords: kbhowto KB112672