You are currently offline, waiting for your internet to reconnect

How to programmatically install a True Type font in Visual FoxPro

This article was previously published under Q186722
This article has been archived. It is offered "as is" and will no longer be updated.
When installing a Visual FoxPro application that uses custom fonts or otherfonts that are not part of the default Windows installation, it isnecessary to install the fonts to assure that the application displays andprints as designed. Using Windows API calls, this can be accomplishedwithin Visual FoxPro.
The following sample code demonstrates how to install a new font and makethe font available after the computer reboots. When you use the programbelow, you must specify the location of the .ttf file, name of the .ttffile and the description for the font you want to install.

Sample code

*-- Code begins here   CLEAR DLLS   PRIVATE iRetVal, iLastError   PRIVATE sFontDir, sSourceDir, sFontFileName, sFOTFile   PRIVATE sWinDir, iBufLen   iRetVal = 0   ***** Code to customize with actual file names and locations.   *-- .TTF file path.   sSourceDir = "C:\TEMP\"   *-- .TTF file name.   sFontFileName = "TestFont.TTF"   *-- Font description (as it will appear in Control Panel).   sFontName = "My Test Font" + " (TrueType)"   ******************** End of code to customize *****   DECLARE INTEGER CreateScalableFontResource IN win32api ;     LONG fdwHidden, ;     STRING lpszFontRes, ;     STRING lpszFontFile, ;     STRING lpszCurrentPath   DECLARE INTEGER AddFontResource IN win32api ;       STRING lpszFilename   DECLARE INTEGER RemoveFontResource IN win32api ;       STRING lpszFilename   DECLARE LONG GetLastError IN win32api   DECLARE INTEGER GetWindowsDirectory IN win32api STRING @lpszSysDir,;     INTEGER iBufLen   #DEFINE WM_FONTCHANGE   29 && 0x001D   #DEFINE HWND_BROADCAST  65535 && 0xffff   DECLARE LONG SendMessage IN win32api ;       LONG hWnd, INTEGER Msg, LONG wParam, INTEGER lParam   #DEFINE HKEY_LOCAL_MACHINE 2147483650   && (HKEY) 0x80000002   #DEFINE SECURITY_ACCESS_MASK 983103     && SAM value KEY_ALL_ACCESS   DECLARE RegCreateKeyEx IN ADVAPI32.DLL ;      INTEGER, STRING, INTEGER, STRING, INTEGER, INTEGER, ;           INTEGER, INTEGER @, INTEGER @   DECLARE RegSetValueEx IN ADVAPI32.DLL;           INTEGER, STRING, INTEGER, INTEGER, STRING, INTEGER   DECLARE RegCloseKey IN ADVAPI32.DLL INTEGER   *-- Fonts folder path.   *-- Use the GetWindowsDirectory API function to determine   *-- where the Fonts directory is located.   sWinDir = SPACE(50)  && Allocate the buffer to hold the directory name.   iBufLen = 50         && Pass the size of the buffer.   iRetVal = GetWindowsDirectory(@sWinDir, iBufLen)   *-- iRetVal holds the length of the returned string.   *-- Since the string is null-terminated, we need to   *-- snip the null off.   sWinDir = SUBSTR(sWinDir, 1, iRetVal)   sFontDir = sWinDir + "\FONTS\"   *-- Get .FOT file name.   sFOTFile  = sFontDir + LEFT(sFontFileName, ;     LEN(sFontFileName) - 4) + ".FOT"   *-- Copy to Fonts folder.   COPY FILE (sSourceDir + sFontFileName) TO ;     (sFontDir + sFontFileName)   *-- Create the font.   iRetVal = ;     CreateScalableFontResource(0, sFOTFile, sFontFileName, sFontDir)   IF iRetVal = 0 THEN       iLastError = GetLastError ()       IF iLastError = 80          MESSAGEBOX("Font file " + sFontDir + sFontFileName + ;          "already exists.")       ELSE           MESSAGEBOX("Error " + STR (iLastError))       ENDIF      RETURN   ENDIF   *-- Add the font to the system font table.   iRetVal = AddFontResource (sFOTFile)   IF iRetVal = 0 THEN       iLastError = GetLastError ()       IF iLastError = 87 THEN           MESSAGEBOX("Incorrect Parameter")       ELSE           MESSAGEBOX("Error " + STR (iLastError))       ENDIF      RETURN   ENDIF   *-- Make the font persistent across reboots.   STORE 0 TO iResult, iDisplay   iRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, ;     "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", 0, "REG_SZ", ;     0, SECURITY_ACCESS_MASK, 0, @iResult, ;     @iDisplay) && Returns .T. if successful   *-- Uncomment the following lines to display information   *!*   *-- about the results of the function call.   *!*      WAIT WINDOW STR(iResult)   && Returns the key handle   *!*      WAIT WINDOW STR(iDisplay)  && Returns one of 2 values:   *!*                                 && REG_CREATE_NEW_KEY = 1   *!*                                 && REG_OPENED_EXISTING_KEY = 2   iRetVal = RegSetValueEx(iResult, sFontName, 0, 1, sFontFileName, 13)   *-- Close the key.  Don't keep it open longer than necessary.   iRetVal = RegCloseKey(iResult)   *-- Notify all the other application a new font has been added.   iRetVal = SendMessage (HWND_BROADCAST, WM_FONTCHANGE, 0, 0)   IF iRetVal = 0 THEN       iLastError = GetLastError ()           MESSAGEBOX("Error " + STR (iLastError))      RETURN   ENDIF   ERASE (sFOTFile)   *-- Code ends here				
MSDN Library: Tools and Technologies; SDK Documentation; Platform SDK;Setup and Systems Management Services; System Information; SystemInformation Reference; System Information Functions

Article ID: 186722 - Last Review: 12/05/2015 08:44:23 - Revision: 3.1

Microsoft Visual FoxPro 3.0 Standard Edition, Microsoft Visual FoxPro 3.0b Standard Edition, Microsoft Visual FoxPro 5.0 Standard Edition, Microsoft Visual FoxPro 5.0a, Microsoft Visual FoxPro 6.0 Professional Edition

  • kbnosurvey kbarchive kbhowto KB186722