Install fonts on the fly

[ddonnahoe]

I want to write a macro for creating numbers for jerseys. the question is, if I create a drop down of the fonts that I want to make available, (not actual installed fonts), and the font the user chooses is not installed, is there a way to install it on the fly? It has been suggested that I check my list against installed fonts and truncate the list to only available installed fonts., but I want to have the same fonts available every time the macro runs.

[shelbym]

You can use the Windows API to install the fonts....

Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long

Private Sub cmb_Load_Click()
    AddFontResource "C:\Temp\Berling.ttf"
End Sub

Private Sub cmb_Unload_Click()
    RemoveFontResource "C:\Temp\Berling.ttf"
End Sub

Unfortunately CorelDRAW still can't see the newly installed font, because it registers fonts on startup. I have no idea how to force a refresh of the font list. If you close DRAW and reopen it, it will see the font.

-Shelby

If you use Bistream Font Navigator (that comes with Corel) to add fonts you won't need to restart coreldraw. Also once you perform the "find fonts" in Font Navigator it just finds fonts but does not install it all at a time, but when you try to open a file with some missing fonts it will install the missing fonts of its own and open the file. Generally what I do is, I make a folder somewhere on the disk that contains all the thousands of fonts, and Font Navigator installs it whenever needed.

Hope it helps

[ddonnahoe]

Vindaa, thank you for your reply, but I am well aware of Font Navigator and it's capabilities (and lack thereof). What I am looking for is what Shelby posted about using the API to install a font via VBA code during the running of a macro. Unless I can find a way to refresh the application, (haven't looked to see if there is an Application.Refresh for Draw) then my idea won't work.

[SteveDude]

Originally Posted by shelbym

Unfortunately CorelDRAW still can't see the newly installed font, because it registers fonts on startup. I have no idea how to force a refresh of the font list. If you close DRAW and reopen it, it will see the font.
-Shelby

Thankfully in X4 there is a way...

.ForceUpdateFontTable

You should also use this API, so other apps that actually listen for the message will know you installed a new font...

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_FONTCHANGE As Long = &H1D
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 Sub MySub()
'Font Install/Uninstall Stuff
.ForceUpdateFontTable
Call SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, ByVal 0&)
End Sub

[ddonnahoe]

Thanks Steve Dude. Pre-shade-it

[SteveDude]

Not a problem...It working fine for me in one my dockers.