DOCUMENT:Q186722 17-JUL-1999 [foxpro] TITLE :HOWTO: Programmatically Install a True Type Font PRODUCT :Microsoft FoxPro PROD/VER:WINDOWS:3.0,3.0b,5.0,5.0a,6.0 OPER/SYS: KEYWORDS:kbvfp kbvfp300 kbvfp300b kbvfp500 kbvfp500a kbvfp600 kbGrpDSFox kbDSupport ====================================================================== ------------------------------------------------------------------------------- The information in this article applies to: - Microsoft Visual FoxPro for Windows, versions 3.0, 3.0b, 5.0, 5.0a, 6.0 ------------------------------------------------------------------------------- SUMMARY ======= When installing a Visual FoxPro application that uses custom fonts or other fonts that are not part of the default Windows installation, it is necessary to install the fonts to assure that the application displays and prints as designed. Using Windows API calls, this can be accomplished within Visual FoxPro. MORE INFORMATION ================ The following sample code demonstrates how to install a new font and make the font available after the computer reboots. When you use the program below, you must specify the location of the .ttf file, name of the .ttf file 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 (c) Microsoft Corporation 1999, All Rights Reserved. Contributions by Mike A. Stewart, Microsoft Corporation REFERENCES ========== MSDN Library: Tools and Technologies; SDK Documentation; Platform SDK; Setup and Systems Management Services; System Information; System Information Reference; System Information Functions Additional query words: ====================================================================== Keywords : kbvfp kbvfp300 kbvfp300b kbvfp500 kbvfp500a kbvfp600 kbGrpDSFox kbDSupport Technology : kbVFPsearch kbAudDeveloper kbVFP300 kbVFP300b kbVFP500 kbVFP600 kbVFP500a Version : WINDOWS:3.0,3.0b,5.0,5.0a,6.0 Issue type : kbhowto ============================================================================= THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY. Copyright Microsoft Corporation 1999.