OrthoDocSoft
Programmer
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
"you cain't fix 'stupid'...
Thanks,
Ortho
"you cain't fix 'stupid'...
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
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