Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

can VB6 "add" a font to C:\Windows\fonts ?

Status
Not open for further replies.

OrthoDocSoft

Programmer
May 7, 2004
291
US
Does anyone know how to "add" a font that is in my resource folder to the C:\Windows\fonts folder using VB6 code?

Thanks,

Ortho

[lookaround] "you cain't fix 'stupid'...
 
Found this code on VB helper site,
** Before calling this sub, your code must copy the font file to the user's Fonts folder. **

Code:
Declare Function WriteProfileString Lib "Kernel" (ByVal _
    lpApplicationName As String, ByVal lpKeyName As String, _
    ByVal lpString As String) As Integer

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 SendMessage Lib "User" (ByVal hWnd As _
    Integer, ByVal wMsg As Integer, ByVal wParam As _
    Integer, lParam As Any) As Long
'  This sub installs a TrueType font and makes it available
' to
'  all Windows apps. It takes these arguments:
'
'  FontName$ is the font's name (e.g. "Goudy Old Style")
' 
'  FontFileName$ is the font's filename (e.g. "GOUDOS.TTF")
'
'  WinSysDir$ is the user's System folder (e.g.
' "C:\WINDOWS\SYSTEM"
'  or "C:\WINDOWS\SYSTEM32")
'
'  ** Before calling this sub, your code must copy the font
' file
'  to the user's Fonts folder. **
'
Sub Install_TTF (FontName$, FontFileName$, WinSysDir$)
Dim Ret%, Res&, FontPath$, FontRes$
Const WM_FONTCHANGE = &H1D
Const HWND_BROADCAST = &HFFFF

    FontPath$ = WinSysDir$ + "\" + FontFileName$
    FontRes$ = Left$(FontPath$, Len(FontPath$) - 3) + "FOT"

    Ret% = CreateScalableFontResource(0, FontRes$, _
        FontFileName$, WinSysDir$)
    Ret% = AddFontResource(FontRes$)
    Res& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
    Ret% = WriteProfileString("fonts", FontName + " " & _
        "(TrueType)", FontRes$)
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top