RESPUESTA A LA PREGUNTA 10454 - FOXPRO/VISUAL FOXPRO


procedure instala_ttf(nombre)
	local err
	local windir
	local fontdir
	local fotfile
	local ttffile
	local resultado,idisplay
	
	#define WM_FONTCHANGE 29
	
	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
	declare long SendMessage in win32api long hWnd,integer Msg,long wParam, integer lParam
	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
	
	Windir=space(50)
	err=GetWindowsDirectory(@windir,50)
	windir=substr(windir,1,err)
	fontdir=windir+"\fonts\"
	fotfile=fontdir+left(nombre,len(nombre)-4)+".fot"
	ttffile=nombre
	if file (fontdir+ttffile)
		return
	endif
	set safety off
	copy file (ttffile) to (fontdir+ttffile)
	set safety on
	
	err=CreateScalableFontResource(0,fotfile,ttffile,fontdir)
	if err=0
		err=getlasterror()
		if err!=80
			messagebox("Error "+str(err),48)
		endif
		return
	endif
	
	err=AddFontResource(fotfile)
	if err=0
		err=GetLastError()
		if err=78
			messagebox("Parámetro incorrecto",48)
		else
			messagebox("Error "+str(err),48)
		endif
		return
	endif
	
	resultado=0
	idisplay=0
	
	err=RegCreateKeyEx(2147483650,"SOFTWARE\Microsoft\Windows\CurrentVersion\Fonts", 0, "REG_SZ",0,983103,0,@resultado,@idisplay)
	
	err=RegSetValueEx(resultado,nombre,0,1,ttffile,13)
	err=RegCloseKey(resultado)
	erase (fotfile)
return


Antonio Estrada
macofi_antonio@terra.es