\\ Home Page : Articolo : Stampa
Ottenere la lista dei font di sistema su Windows
Di Marco Tenuti (del 24/03/2009 @ 16:37:27, in Windows, linkato 3622 volte)

Per ottenere la lista dei font installati in Windows, questo il poco di codice da invocare sulla Win32. L'esempio vi mostra come fare ad ottenere tale lista di nomi con Visual Basic 6, ma con poche modifiche potete farlo in Visual C++. Nel caso in cui abbiate bisogno di fare la stessa cosa in ambiente .NET Framework, le cose sono decisamente semplificate, per il fatto che il framework ha praticamente tutto già pronto.

Create il vostro progettino VB6 con due file, un modulo ed una form:

Nel modulo:

Public Const NTM_REGULAR = &H40&
Public Const NTM_BOLD = &H20&
Public Const NTM_ITALIC = &H1&
Public Const TMPF_FIXED_PITCH = &H1
Public Const TMPF_VECTOR = &H2
Public Const TMPF_DEVICE = &H8
Public Const TMPF_TRUETYPE = &H4
Public Const ELF_VERSION = 0
Public Const ELF_CULTURE_LATIN = 0
Public Const RASTER_FONTTYPE = &H1
Public Const DEVICE_FONTTYPE = &H2
Public Const TRUETYPE_FONTTYPE = &H4
Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64

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
'converte la stringa ritornata in formato Unicode
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
'stampiglia da qualche parte la stringa in questione
Form1.Print Left(FaceName, InStr(FaceName, vbNullChar) - 1)
'prosegui con l'enumerazione, visto che quella corrente e' una callback
EnumFontFamProc = 1
End Function

Nella form invece mettete questo codice:

'In a form
Private Sub Form_Load()
Dim LF As LOGFONT
'impostiamo il metodo di disegno della form come persistente
Me.AutoRedraw = True
'invochiamo l'enumerazione sulla API della Win32
EnumFontFamiliesEx Me.hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
End Sub