Tengo que comprobar si un fuente TTF de codigo de barras esta instalado en un PC y si no lo encuentro instalarlo desde mi executable.
Alquien tieen codigo para eso?
*-- 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
FUNCTION INSTFONTS()
Local lDescarga:=.F.
IF FILE("fontinst.inf")
ERASE fontinst.inf
ENDIF
IF !MSGYESNO("Instalar Codigos de barras")
RETURN NIL
ENDIF
IF !FILE("fontinst.exe")
lDescarga:=.T.
ENDIF
IF !FILE("Bar128ct.ttf")
lDescarga:=.T.
ENDIF
IF lDescarga
UPLOADFONTS()
ENDIF
XMENSCEN("[fonts]")
LZCOPYFILE( Curdrive()+ ":\" + Curdir() + "\Bar128ct.ttf", GetWindir()+"\fonts\Bar128ct.ttf" )
xmenscen("Bar128ct.ttf")
WINEXEC("fontinst.exe /f fontinst.inf")
MSGWAIT("Fuentes Instalados")
RETURN NIL
************************************************************
FUNCTION XMENSCEN(cText)
Local cFile:="fontinst.inf"
Local oText
oText := TTxtFile():New(cFile)
if oText:Open()
oText :Add( cText )
oText :Close()
endif
RETURN NIL
****************************************************
FUNCTION UPLOADFONTS()
Local oText,i
Local n:=0
IF FILE("UPLOADB.TXT")
ERASE UPLOADB.TXT
ENDIF
oText:= TTxtFile():New("UPLOADB.TXT" )
if oText:Open()
oText :Add("OPEN 999.999.999.999") //ftp de los fuentes
oText :Add("software")
oText :Add("1234567890" )
oText :Add("PROMPT OFF" )
oText :Add("BIN" )
oText :Add("HASH" )
oText :Add("MGET Bar128ct.ttf")
oText :Add("MGET fontinst.exe" )
oText :Add("QUIT" )
oText:Close()
endif
IF FILE("UPLOADB.TXT")
WAITRUN("FTP -s:UPLOADB.TXT")
ENDIF
ERASE UPLOADB.TXT
MSGWAIT("Fuentes descargados","Descarga OK")
Return .T.
**********************************************************************************
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 100 guests