como verificar que una fuente ttf esta o no instalada

[marcelo lopez]

Buen dia :

Hay alguna manera por codigo  de verificar si una fuente ttf esta instalada ?

Y si no lo esta tambien  por codigo poder instalarla ?  desde ya gracias 

[Victor Espina]

Para validar si un font esta instalado, busca el archivo correspondiente al font (extesion TTF) en la carpeta c:\windows\system32\fonts.   Para instalar el font, simplemente copia el archivo TTF a esa misma carpeta (se necesitara nivel de Administrador para esto).   Para determinar si la app esta corriendo con nivel de Administrador, uso esta funcion:

PROCEDURE IsAdmin

  DECLARE INTEGER IsUserAnAdmin IN Shell32
  RETURN (IsUserAnAdmin() <> 0)

Saludos

Victor Espina

[Edgar Acevedo]

De repente esto te sirva:

* Función para saber si está instalado un FONT
* PARAMETERS:                                                                        
* - tcFont  Nombre del FONT a confirmar si existe                                    
FUNCTION Hay_Font
   PARAMETERS tcFont
   LOCAL laArray(1), lnI, llRet
   llRet = .F.
   IF AFONT(laArray)
      tcFont = UPPER(tcFont)
      FOR lnI = 1 TO ALEN(laArray)
         IF UPPER(laArray(lnI)) == tcFont
            llRet = .T.
            EXIT
         ENDIF
      ENDFOR
   ENDIF
RETURN llRet

* Función para instalar un archivo tipo FONT (ttf)                                    
* PARAMETERS:                                                                        
* - tcFont  Nombre del archivo TTF del FONT a instalar                                
FUNCTION Ins_Font
   PARAMETER M.FileFont
   DECLARE LONG AddFontResource IN "gdi32";
           STRING lpFileName
   M.Result = .F.
   oCarpet = NEWOBJECT("_CommonFolder", ADDBS(XPATPR) + "_System")
   IF FILE(M.FileFont)
      M.PathFont = ALLTRIM(oCarpet.GetFolder(20))
      TRY
         COPY FILE (M.FileFont) TO (ADDBS(M.PathFont) + JUSTFNAME(M.FileFont))
      CATCH
         EXIT
      ENDTRY
      M.Result = AddFontResource(ADDBS(M.PathFont) + JUSTFNAME(M.FileFont)) # 0
   ENDIF
   RELEASE oCarpet
RETURN M.Result

* Función para quitar un font instalado                 
* PARAMETERS:                                           
* - tcFont  Nombre del archivo TTF del FONT a eliminar  
FUNCTION Del_Font
   PARAMETER M.FileFont
   DECLARE LONG RemoveFontResource IN "gdi32";
           STRING lpFileName
   M.Result = .F.
   IF FILE(M.FileFont)
      M.Result = RemoveFontResource(M.FileFont) # 0
   ENDIF
RETURN M.Result

Eso sí, debes tener privilegios de administrador para poder instalar un archivo TTF.  De esta manera puedes chequear si tiene el usuario de Windows de la sesión actual, tiene nivel de "Administrador".

FUNCTION Is_Admin
   #DEFINE NO_ERROR 0
   DECLARE INTEGER IsUserAnAdmin IN shell32
   DECLARE INTEGER WNetGetUser IN mpr;
           INTEGER lpName, STRING @lpUserName, INTEGER @lpnLength
   LOCAL lcUser, lnBufsize
   lnBufsize = 250
   lcUser = Repli(Chr(0), lnBufsize)
   M.ValRet = 'NO'
   IF WNetGetUser(0, @lcUser, @lnBufsize) = NO_ERROR
      M.ValRet = IIf(IsUserAnAdmin()=0, "NO", "SI")
   ENDIF
RETURN M.ValRet

Todo el código que te copié arriba, no es de mi autoría. Lo encontré en este mismo foro.

Saludos,  Edgar

--
Blog de la Comunidad Visual FoxPro en Español: http://comunidadvfp.blogspot.com
---
Has recibido este mensaje porque estás suscrito al grupo "Comunidad de Visual Foxpro en Español" de Grupos de Google.
Para cancelar la suscripción a este grupo y dejar de recibir sus mensajes, envía un correo electrónico a publicesvfoxp...@googlegroups.com.
Para ver esta conversación en el sitio web, visita https://groups.google.com/d/msgid/publicesvfoxpro/CAKGbfCZNbQ7R1CrX%2B5N1Xp%3DNNVDvYgK03MNeJ5FrUKTGq1B3kQ%40mail.gmail.com.