ABU 19-Jan-2009
I like to give a distinctive look to my applications using uncommon fonts.
The (old) problem with fonts is that they should be installed before you can use them and, if you want to distribute your application, you should distribute and install your special fonts, too !
On Windows, installing a new font "by program" is not a trivial task, but I don't like to fill the system font-table with all the special fonts used by some useless apps ...
Here is a way to deploy an application with new fonts. The new fonts will be "installed" just by running your (tcl) application. Only your current app can see and use this font. When the application terminates, the new fonts disappear from the font-table.
We need to link the win32-api. We will use Ffidl for this purpose.
Also, we need a new font-file. Here's an uncommon free font named Scriptina [L1 ] downloaded from http://www.dafont.com/ .
Just for a quick test, save the font-file in "c:/tmp" folder. You can preview it but DO NOT install it !
Here is the code with some comments:
# win32 api from gdi32.dll #int AddFontResourceEx( # LPCTSTR lpszFilename, // font file name # DWORD fl, // font characteristics # PVOID pdv // reserved #); # # fl can be: # FR_PRIVATE (0x10) # Specifies that only the process that called the AddFontResourceEx function can use this font. # When the font name matches a public font, the private font will be chosen. # When the process terminates, the system will remove all the 'temporary' fonts. # FR_NOT_ENUM (0x20) # Specifies that no process, including the process that called the AddFontResourceEx function. # can enumerate this font. # # pd is reserved. Must be zero. # create a tcl proc named 'dll_AddFontResourceEx' package require Ffidl ffidl::callout dll_AddFontResourceEx { pointer-utf16 int pointer} int \ [ffidl::symbol gdi32.dll AddFontResourceExW ] # load a new font-file just for the current session. # Of course you can change the pathname ... set fontFile c:/tmp/SCRIPTIN.TTF ; # "c:\\tmp\\SCRIPTIN.TTF" is valid, too # Here is the core ! Load the new font and check for errors .. set res [dll_AddFontResourceEx $fontFile 0x10 0] if { $res == 0 } { puts "ERROR loading $fontFile" } # Finally, show something with the new font ! # The new font-name is "Scriptina" (Note: font-names are case-insensitive) label .lab1 -text "Abu works!" -font {Scriptina 20} pack .lab1
Note that the new font is now visible in your font-table, e.g. font families now includes "Scriptina" but this font is not visible to other apps (try to open notepad.exe and open the font panel ... ).
ABU 1-Apr-2009
Sure I'd like to solve this problem for Linux/Mac, too. For Windows we'got a solution. For Linux/Mac I suspect the solution could be even easier ...
Once we got solutions for all the platforms, I'd like to join them within the font command:
# something like this : font add _filename_
Of course the Windows solution has to be enforced (and the next Linux/Mac solutions, too):
Pat pointed out many interesting links for overcoming these limits. Unfortunatelly for me, they require a deep knowledge of the win32 API ... any volunteer ?
Pat Thoyts posted this on the core list, regarding using critcl instead of fidl:
critcl::cproc AddFontResource {Tcl_Interp* interp Tcl_Obj* pathObj} ok { Tcl_DString ds; Tcl_Encoding unicode; int len, r = TCL_OK; const char *path = Tcl_GetStringFromObj(pathObj, &len); Tcl_DStringInit(&ds); unicode = Tcl_GetEncoding(interp, "unicode"); Tcl_UtfToExternalDString(unicode, path, len, &ds); if (AddFontResourceExW(Tcl_DStringValue(&ds), FR_PRIVATE, NULL) == 0) { r = TCL_ERROR; } Tcl_DStringFree(&ds); Tcl_FreeEncoding(unicode); return r; }
Given this function in an extension, it will add a font from a .ttf file to the set available shown in font families. The FR_PRIVATE means the font is only made available to this process and is not installed into the system permanently.
SRIV On Ubuntu Linux, just placing the .ttf fonts into ~/.fonts/ makes them instantly available to all apps, even Tk.
ABU Something is growing up ... Try googling "tcltk private fonts"
ABU 17-jul-2017
Eight years later .. a cross-platform solution was born. See extrafont