Alaska Software Inc. - Adding System Fonts with AddFontResource()
Username: Password:
AuthorTopic: Adding System Fonts with AddFontResource()
Nick Ramoundos Adding System Fonts with AddFontResource()
on Mon, 09 Sep 2013 00:42:21 +0200
Doe anyone have a snippet to programatically add a font to Windows 
permanently?

I have seen reference to AddFontResource but am not sure how to employ the 
call.

Thanking you in advance,

Nick
_____________________________
 Nick Ramoundos
 Ramoundos Systems
 6 Peter Cooper Road, Suite 7-H
 New York, NY  10010
 Tel: (212) 709-8300
Thomas BraunRe: Adding System Fonts with AddFontResource()
on Mon, 09 Sep 2013 10:04:34 +0200
Nick Ramoundos wrote:

> Doe anyone have a snippet to programatically add a font to Windows 
> permanently?

This can be quite problematic in a corporate environment - because you need
administrative rights to permanently install fonts.

The optimal solution would be to add all neccesary fonts as part of the
installation because this needs administrative rights anyway.

I have been using "Advanced Installer" to install a bunch of fonts via
group policy software deployment here where I'm working.

regards
thomas
Edgar Borger Re: Adding System Fonts with AddFontResource()
on Mon, 09 Sep 2013 12:18:09 -0300
Hi Nick,

I used once a bat file like this ;

copy "FREE3OF9.TTF" "%WINDIR%\Fonts"
reg add "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" /v "Free 3 of 9 Regular (TrueType)" /t REG_SZ /d FREE3OF9.TTF /f

with regclass you can do the same !!!

Regards,
Edgar




Em 08/09/2013 19:42, Nick Ramoundos escreveu:
> Doe anyone have a snippet to programatically add a font to Windows
> permanently?
>
> I have seen reference to AddFontResource but am not sure how to employ the
> call.
>
> Thanking you in advance,
>
> Nick
> _____________________________
>   Nick Ramoundos
>   Ramoundos Systems
>   6 Peter Cooper Road, Suite 7-H
>   New York, NY  10010
>   Tel: (212) 709-8300
>


Edgar Borger
Softsupply Informatica Ltda.
Rua Alagoas, 48
Sao Paulo, SP
01242-000
Tel : (5511) 3159-1997
Fax : (5511) 3255-5224
Nick Ramoundos Re: Adding System Fonts with AddFontResource()
on Mon, 09 Sep 2013 20:10:02 +0200
Edgar Borger <eborger@terra.com.br> wrote in
news:50d7168d$268ef920$1f483@news.alaska-software.com: 

Edgar, 

I've updated my installer to installe the fonts I want to use but 
wanted to retrofit older versions wit the new fonts.

I used RegClass and added the key successfully but the font did not show 
up immediately on Word or other apps nor did it respond to 
SetFontCompoundName().  

Does the system need to be restarted?
Or it it something to do with the parameters?

Do you have a regclass snippet to demonstrate?

Regards, 
Nick

> Hi Nick,
> 
> I used once a bat file like this ;
> 
> copy "FREE3OF9.TTF" "%WINDIR%\Fonts"
> reg add "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" /v
> "Free 3 of 9 Regular (TrueType)" /t REG_SZ /d FREE3OF9.TTF /f 
> 
> with regclass you can do the same !!!
> 
> Regards,
> Edgar
> 
> 
> 
> 
> Em 08/09/2013 19:42, Nick Ramoundos escreveu:
>> Doe anyone have a snippet to programatically add a font to Windows
>> permanently?
>>
>> I have seen reference to AddFontResource but am not sure how to
>> employ the call.
>>
>> Thanking you in advance,
>>
>> Nick
>> _____________________________
>>   Nick Ramoundos
>>   Ramoundos Systems
>>   6 Peter Cooper Road, Suite 7-H
>>   New York, NY  10010
>>   Tel: (212) 709-8300
>>
> 
> 



_____________________________
 Nick Ramoundos
 Ramoundos Systems
 6 Peter Cooper Road, Suite 7-H
 New York, NY  10010
 Tel: (212) 709-8300
Edgar Borger Re: Adding System Fonts with AddFontResource()
on Tue, 10 Sep 2013 12:06:38 -0300
Hi Nick,

I got this from the internet (google install fonts) and it worked for me on an old Win XP machine, I only used it once in a client that needed barcode 
font in one of the printouts.
maybe it has to do with windows version ?
did you copy to ttf file to the fonts folder ?

Regards,
Edgar


Em 09/09/2013 15:10, Nick Ramoundos escreveu:
> Edgar Borger <eborger@terra.com.br> wrote in
> news:50d7168d$268ef920$1f483@news.alaska-software.com:
>
> Edgar,
>
> I've updated my installer to installe the fonts I want to use but
> wanted to retrofit older versions wit the new fonts.
>
> I used RegClass and added the key successfully but the font did not show
> up immediately on Word or other apps nor did it respond to
> SetFontCompoundName().
>
> Does the system need to be restarted?
> Or it it something to do with the parameters?
>
> Do you have a regclass snippet to demonstrate?
>
> Regards,
> Nick
>
>> Hi Nick,
>>
>> I used once a bat file like this ;
>>
>> copy "FREE3OF9.TTF" "%WINDIR%\Fonts"
>> reg add "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" /v
>> "Free 3 of 9 Regular (TrueType)" /t REG_SZ /d FREE3OF9.TTF /f
>>
>> with regclass you can do the same !!!
>>
>> Regards,
>> Edgar
>>
>>
>>
>>
>> Em 08/09/2013 19:42, Nick Ramoundos escreveu:
>>> Doe anyone have a snippet to programatically add a font to Windows
>>> permanently?
>>>
>>> I have seen reference to AddFontResource but am not sure how to
>>> employ the call.
>>>
>>> Thanking you in advance,
>>>
>>> Nick
>>> _____________________________
>>>    Nick Ramoundos
>>>    Ramoundos Systems
>>>    6 Peter Cooper Road, Suite 7-H
>>>    New York, NY  10010
>>>    Tel: (212) 709-8300
>>>
>>
>>
>
>
>


Edgar Borger
Softsupply Informatica Ltda.
Rua Alagoas, 48
Sao Paulo, SP
01242-000
Tel : (5511) 3159-1997
Fax : (5511) 3255-5224
Andreas Gehrs-Pahl
Re: Adding System Fonts with AddFontResource()
on Mon, 09 Sep 2013 17:54:28 -0400
Nick,

>Doe anyone have a snippet to programatically add a font to Windows 
>permanently?

This requires several steps. 
Step 1) is copying the font into the (correct) Windows Font directory.
Step 2) is registering the font with Windows.
Step 3) is announcing to all running application that the font exists.

The following are snippets from my installation program, so it won't compile 
or run, but I think it should guide you through the process. My code uses (a
modified version of) Thomas Braun's Registry Class as well XbZLib, but you 
actually don't need that part for your purposes.

Hope this helps!

#include 'DLL.ch'
#include 'OS.ch'

#define HWND_BROADCAST               0xFFFF    Send Message to all top-level dialogs
#define WM_FONTCHANGE                0x001D    Fonts have been changed

#define SMTO_NORMAL                  0x0000
#define SMTO_ABORTIFHUNG             0x0002
#define SMTO_NOTIMEOUTIFNOTHUNG      0x0008

#define CSIDL_FONTS                  0x0014    Windows\Fonts
#define CSIDL_APPDATA                0x001a    <user name>\Application Data
#define CSIDL_COMMON_APPDATA         0x0023    All Users\Application Data
#define CSIDL_WINDOWS                0x0024    GetWindowsDirectory()
#define CSIDL_SYSTEM                 0x0025    GetSystemDirectory()
#define CSIDL_PROGRAM_FILES          0x0026    C:\Program Files
#define CSIDL_PROGRAM_FILES_COMMON   0x002b    C:\Program Files\Common

#define WINDOWS_MAX_PATH             260       Size for File and Directory Name Buffers

#define WIN9X_FONTS_REGKEY           "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Fonts"
#define WINNT_FONTS_REGKEY           "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\Fonts"

Procedure AddBarCodeFonts(lInteractive)
LOCAL cModule   := BARCODE_FONTS
LOCAL cTitle    := InstallLogTitle(cModule, 'I')
LOCAL cResult   := cTitle + ' completed.'
LOCAL cFontDir  := GetWindowsDir(CSIDL_FONTS) + '\'
LOCAL cFontFile := ''
LOCAL cRegValue := ''
LOCAL cZipFile  := 'DDP_Font.zip'
LOCAL aFiles    := ListZipFile(UP_InstalPath + cZipFile)
LOCAL cRegKey   := iif(OS(OS_FAMILY) == 'WIN9X', WIN9X_FONTS_REGKEY, WINNT_FONTS_REGKEY)
LOCAL aFonts    := GetRegKeyValues(cRegKey, 'C')
LOCAL nFonts    := len(aFiles)
LOCAL nFont     := 0
LOCAL nAdded    := 0
   UpdateInstallLog('*', 1, .t., .f., cTitle + '.')
   for nFont := 1 to nFonts
      cFontFile := aFiles[nFont, F_NAME]
      cRegValue := StrTran(cFontFile, 'AbriB', 'Abri Barcode39')
      cRegValue := StrTran(cRegValue, '.ttf',  ' (True Type)')
      if .not. FExists(cFontDir + cFontFile)
         InstallFromZipFile(cModule, cFontDir, cZipFile, cFontFile, .f.)
      endif
      if FExists(cFontDir + cFontFile)
         if SetRegKeyValue(cRegKey, cRegValue, cFontFile)
            if AddFontResource(cFontFile)
               ++nAdded
            elseif lInteractive
               WarningMessage('Could not Add Font Resource: "' + cFontFile + '"!', cModule)
            endif
         elseif lInteractive
            WarningMessage('Could not Set Registry Key Value: "' + cRegValue + '" of Registry Key: "' + cRegKey + '" to: "' + cFontFile + '"!', cModule)
         endif
      elseif lInteractive
         WarningMessage('File: "' + cFontDir + cFontFile + '" could not be found!', cModule)
      endif
   next nFont
   if nAdded == nFonts
      if lInteractive
*        DisplayMessage(cResult, cModule)
      endif
   else
      cResult := 'The ' + cModule + ' could not be (completely) installed!'
      if lInteractive
         WarningMessage(cResult, cModule)
      endif
   endif
   UpdateInstallLog('*', 0, .f., .f., cResult)
return

Function GetWindowsDir(nFolder, lCreate)
LOCAL cWinDir := Space(WINDOWS_MAX_PATH)
LOCAL nCSIDL  := iif(empty(nFolder), CSIDL_WINDOWS, nFolder)
LOCAL nCreate := iif(lCreate  == NIL, 0, iif(lCreate, 1, 0))
   if DllCall("Shell32.dll", DLL_STDCALL, "SHGetSpecialFolderPathA", AppDesktop():GetHWnd(), @cWinDir, nCSIDL, nCreate) == 0 .or. empty(cWinDir)
      do case
         case nCSIDL == CSIDL_WINDOWS
            cWinDir := GetEnv('SystemRoot')
            if empty(cWinDir)
               cWinDir := GetEnv('WinDir')
            endif
            if empty(cWinDir)
               cWinDir := 'C:\Windows'
            endif

         case nCSIDL == CSIDL_SYSTEM
            cWinDir := GetWindowsDir(CSIDL_WINDOWS) + iif(OS(OS_FAMILY) == 'WIN9X', '\System', '\System32')

         case nCSIDL == CSIDL_FONTS
            cWinDir := GetWindowsDir(CSIDL_WINDOWS) + '\Fonts'

         case nCSIDL == CSIDL_PROGRAM_FILES
            cWinDir := GetEnv('ProgramFiles')
            if empty(cWinDir)
               cWinDir := 'C:\Program Files'
            endif

         case nCSIDL == CSIDL_PROGRAM_FILES_COMMON
            cWinDir := GetEnv('CommonProgramFiles')
            if empty(cWinDir)
               cWinDir := GetWindowsDir(CSIDL_PROGRAM_FILES) + '\Common Files'
            endif

         case nCSIDL == CSIDL_APPDATA .or. nCSIDL == CSIDL_COMMON_APPDATA
            cWinDir := GetEnv('AppData')
            if empty(cWinDir)
               cWinDir := GetWindowsDir(CSIDL_WINDOWS) + '\Application Data'
            endif

         otherwise
            cWinDir := ''
      endcase
   elseif chr(0) $ cWinDir
      cWinDir := left(cWinDir, At(chr(0), cWinDir) - 1)
   endif
return (alltrim(cWinDir))

Function AddFontResource(cFontName)
LOCAL nFonts := DllCall("GDI32.DLL", DLL_STDCALL, "AddFontResourceA", @cFontName)
   if nFonts > 0
      SendWinMessageTimeout(HWND_BROADCAST, WM_FONTCHANGE)
   endif
return (nFonts > 0)

Function SendWinMessageTimeOut(nHandle, nMessage, nParameter1, xParameter2, nWaitFlags, nTimeout, nRetVal)
LOCAL nParm1 := iif(nParameter1 == NIL, 0, nParameter1)
LOCAL xParm2 := iif(xParameter2 == NIL, 0, xParameter2)
LOCAL nFlag  := iif(nWaitFlags  == NIL, iif(val(OS(OS_VERSION)) < 5, SMTO_NORMAL, SMTO_NOTIMEOUTIFNOTHUNG) + SMTO_ABORTIFHUNG, nWaitFlags)
LOCAL nWait  := iif(nTimeout    == NIL, 500, nTimeout)
   nRetVal   := 0
return (DllCall("User32.DLL", DLL_STDCALL, "SendMessageTimeoutA", nHandle, nMessage, nParm1, xParm2, nFlag, nWait, @nRetVal) # 0)

Andreas

Andreas Gehrs-Pahl
Absolute Software, LLC

phone: (989) 723-9927
email: Andreas.GP@Charter.net
       Andreas.Gehrs-Pahl@InterAct911.com
       Andreas.Gehrs-Pahl@EJusticeSolutions.com
       Andreas@DDPSoftware.com
web:   http://www.Aerospace-History.net
Nick Ramoundos Re: Adding System Fonts with AddFontResource()
on Tue, 10 Sep 2013 19:54:06 +0200
Thomas, Edgar, Andreas

Thanks for the input.  With your guidance, here is my working solution:

*************************************************************************

* The font "AurulentSansMono-Regular.otf" is a nice
 fixed font alternative that I want to use for date
 and number editing.  It closely matches the Ariel font
* and is available for free from DAFont.com.
* If not found in the Windows Font folder, I attempt to add it.

Local cFont:="AurulentSansMono-Regular.otf"
If .not. File(FontsFolder(cFont))
   AddSystemFont(cFont)
EndIf

*************************************************************************
Function FontsFolder(cFileName)
Local cWinDir

Do Case
   Case .not. Empty(cWinDir:=GetEnv("SystemRoot"))
   Case Empty(cWinDir:=GetEnv("WinDir"))
        cWinDir:="C:\Windows"
EndCase

* Optionally add file name to return string.
Default cFileName to ""

Return cWinDir+"\Fonts\"+cFileName

*************************************************************************
Function AddSystemFont(cFontName)
Local nFonts:=0

 I assume the font file exists in the application folder
 and verify the copy to the Windows font folder by 
* comparing the file size to the FileCopy() return value.

If FileCopy(cFontName,FontsFolder(cFontName))==FileSize(cFontName)
   nFonts:=DllCall("GDI32.DLL", DLL_STDCALL, ;
                   "AddFontResourceA", cFontName)
EndIf

Return (nFonts>0)

*************************************************************************

Regards and thanks again to all!

Nick

_____________________________
 Nick Ramoundos
 Ramoundos Systems
 6 Peter Cooper Road, Suite 7-H
 New York, NY  10010
 Tel: (212) 709-8300