' A METTRE IMPéRATIVEMENT DANS UN MODULE
Option Explicit
Private Const LF_FACESIZE As Long = 32&
'
Private 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
'
Public Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hdc As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
'
Public Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
Dim LF As LOGFONT
Dim ZeroPos As Long
Dim FontName As String
Call CopyMemory(LF, ByVal lplf, LenB(LF))
FontName = StrConv(LF.lfFaceName, vbUnicode)
ZeroPos = InStr(1, FontName, Chr$(0))
If ZeroPos > 0 Then Debug.Print Left$(FontName, ZeroPos - 1)
EnumFontProc = True
End Function
' EXEMPLE D'UTILISATION
Private Sub Form_Load()
Call EnumFonts(Me.hdc, vbNullString, AddressOf EnumFontProc, 0&)
End Sub