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
Dim LF As LOGFONT
EnumFontFamiliesEx Me.hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
