Lister la Police d'ecriture

Commenter

Contenu du snippet 

'   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

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (mortalino)