Resumen Distribuir Font

Estimado Emilio,

Esto lo he hecho con las APIs de Windows, te envio un ejemplo para 16 bits, solamente deberás hacer
los ajustes para 32 bits en la declaración de la API.

Esta son las declaraciones que debes poner en un módulo de tu aplicación:

Declare Function CreateScalableFontResource% Lib "GDI" (ByVal fHidden%, ByVal lpszResourceFile$,
ByVal lpszFontFile$, ByVal lpszCurrentPath$)

Declare Function AddFontResource Lib "GDI" (ByVal lpFileName As Any) As Integer

Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName
As String, ByVal lpString As String) As Integer

Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam
As Integer, lParam As Any) As Long


Esta es la función para añadir el Font:

-----------------
Sub AddFont (KeyName As String, TTF_Font As String, ResPath As String)

'Descripción de las variables paramétricas:
'Ejemplos:
'
'KeyName="Bookman Old Style Bold (TrueType)"
'Font ="C:\WINDOWS\SYSTEM\BOOKOSB.FOT"
'TTF_Font="bookosb.ttf"
'ResPath="C:\WINDOWS\SYSTEM"

Font$ = TTF_Font$
Mid(Font$, Len(Font$) - 2, 3) = "FOT"
Font$ = ResPath$ & "\" & Font$

HWND_BROADCAST = &HFFFF
WM_FONTCHANGE = &H1D
Result& = CreateScalableFontResource%(0, Font$, TTF_Font$, ResPath$)
If Result& Then
    'Adicionar el Recurso a la Tabla de Letras de Windows
    Result& = AddFontResource(Font$)
    If Result& Then
        'Hacer cambios al WIN.INI para reflejar la nueva letra:
        Result& = WriteProfileString("Fonts", KeyName$, Font$)
        If Result& Then
            'Que el cambio sea del conocimiento de otras aplicaciones
            Result& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0&)
        Else
            'Reporte de Error:
            MsgBox "Ocurrió un error añadiendo la nueva letra en el WIN.INI", 48, "Nuevas Letras"
        End If
    Else
        'Reporte de Error:
        MsgBox "Ocurrió un error añadiendo la nueva letra", 48, "Nuevas Letras"
    End If
Else
    If Result& <> 0 Then MsgBox "Error creando la nueva letra", 48, "Nuevas Letras"
End If


End Sub
-----------------

Espero te sea útil.

Saludos.

Manuel


Emilio Gustavo Ormeño wrote:

> Hola a todo el mundo hispano:
>
> Alguien sabe como puedo distribuir un font que reside en mi maquina junto con mi aplicacion VB ?
>
> Gracias.





Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com