¿Cómo Instalar una Fuente en Fox 2.x y VFP con el API?

Por Joerg Arand
© Copyrights 1998 by FoxPress, All rights reserved
FoxPress, Enero 1998

No descubro nada nuevo si comento las dificultades que hay de instalar una Fuente desde las aplicaciones Fox... Por esa razón me decidí a escribir un código que lo hiciera y aquí lo adjunto. Espero que os sea útil. .



IF install_font("Custom Font",;
	installation_directory+;
	"\customft.ttf")
   WAIT WINDOW "It works!"
ELSE
   WAIT WINDOW "It already exists or;
 	it screwed up!"
ENDF

*******************************************
FUNCTION install_font
PARAMETERS fontname, fontfile
PRIVATE windir, winsysdir, winini, x,;
	 retlen, string, result, fonts
*library to let us call API's
SET LIBRARY TO FOXTOOLS.FLL
*- see if a font with this name is already 
*- installed. if it is, tell user and
return
=AFONT(fonts)
IF ASCAN(fonts, fontname) <> 0
WAIT WINDOW PROPER(fontname)+" Already Exists" NOWAIT
RETURN .F.
ENDIF
*default to truetype font
IF JUSTEXT(fontfile)=" "
fontfile=fontfile+".ttf"
ENDIF
*we don't know what kind of font this is.
IF !INLIST(UPPER(JUSTEXT(fontfile)),;
      "TTF", "FOT", "FON")
=MSGBOX("Unknown font type! ;
     "+JUSTEXT(fontfile),;
      c_setupname,16)
RETURN .F.
ENDIF

*this gets the windows directory
string= replicate(chr(0), 144)
x = RegFn("GetWindowsDirectory",;
 "@CI", "I")
retlen = CallFn(x, @string, 144)
windir=LEFT(string, retlen)
*this gets the windows system directory
string= replicate(chr(0), 144)
x = RegFn("GetSystemDirectory", "@CI", "I")

retlen = CallFn(x, @string, 144)
winsysdir=LEFT(string, retlen)
winini=windir+"\win.ini"
*copy font file to windows\system directory
SET SAFETY OFF
COPY FILE &fontfile TO ;
	winsysdir+"\"+JUSTFNAME(fontfile)
SET SAFETY ON
*- if it is truetype, we must create a 
*- scalable font first
IF UPPER(JUSTEXT(fontfile))="TTF"
IF FILE(winsysdir+"\";
  +JUSTSTEM(fontfile)+".FOT")
DELETE FILE winsysdir+"\"+JUSTSTEM(fontfile);
   +".FOT"
ENDIF
   x = RegFn("CreateScalableFontResource",;
	"ICCC", "L")
=CallFn(x, 0,;
	winsysdir+"\"+JUSTSTEM(fontfile)+;
	".FOT",;
   JUSTFNAME(fontfile), winsysdir)
   fontfile=JUSTSTEM(fontfile)+".fot"
ELSE
   fontfile=JUSTFNAME(fontfile)
ENDIF
*put entry in win.ini file of fontname=fontfile under [fonts]
=PutProf(winini,"fonts",fontname,fontfile)
*call addfontresource
x=RegFn("AddFontResource","C","I")
*if it works
IF CallFn(x, winsysdir+"\"+fontfile) <> 0
*send message to all windows that we added 
*a new font
   x=regfn("SendMessage", "IIIL", "I")
   =callfn(x, 65535, 29,0,0) 
*sendmessage after addfont
*notify user
   WAIT WINDOW PROPER(fontname)+;
	" Added Successfully" NOWAIT
   RETURN .T.
ELSE 
*it didn't work
  WAIT WINDOW "Error Adding Font:;
 	"+PROPER(fontname) TIMEOUT 5
  RETURN .F.
ENDIF