Trucos Mostrar las fuentes del sistema en un combo

Si necesitamos rellenar un combo con los nombres de los tipos de letra presentes en el sistema podemos hacer :

Suponiendo que el combo que quieres llenar se llama combo1 y está en el form1 :

En un módulo :

Public Const LF_FACESIZE = 32
Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type
Type NEWTEXTMETRIC
    tmHeight As Long
    tmAscent As Long
    tmDescent As Long
    tmInternalLeading As Long
    tmExternalLeading As Long
    tmAveCharWidth As Long
    tmMaxCharWidth As Long
    tmWeight As Long
    tmOverhang As Long
    tmDigitizedAspectX As Long
    tmDigitizedAspectY As Long
    tmFirstChar As Byte
    tmLastChar As Byte
    tmDefaultChar As Byte
    tmBreakChar As Byte
    tmItalic As Byte
    tmUnderlined As Byte
    tmStruckOut As Byte
    tmPitchAndFamily As Byte
    tmCharSet As Byte
    ntmFlags As Long
    ntmSizeEM As Long
    ntmCellHeight As Long
    ntmAveWidth As Long
End Type
Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA"
(ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long,
ByVal LParam As Long, ByVal dw As Long) As Long

Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal
FontType As Long, LParam As Long) As Long
Dim FaceName As String

'convertir a Unicode
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
'añadir al combo
Form1.Combo1.AddItem FaceName
'continuar la enumeracion
EnumFontFamProc = 1
End Function

Y para llenar el combo :

Dim LF As LOGFONT
EnumFontFamiliesEx Me.hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com