EnumFontFamilies Function

Declare Function EnumFontFamilies Lib "gdi32.dll" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As Any, ByVal lpEnumFontFamProc As Long, ByVal lParam As Long) As Long

Platforms

Windows 95: Supported but Obsolete; use EnumFontFamiliesEx instead.
Windows 98: Supported but Obsolete; use EnumFontFamiliesEx instead.
Windows NT: Requires Windows NT 3.1 or later but Obsolete under Windows NT 4.0 or later; use EnumFontFamiliesEx instead.
Windows 2000: Supported but Obsolete; use EnumFontFamiliesEx instead.
Windows CE: Not Supported.

Description & Usage

EnumFontFamilies enumerates all of the fonts available for use on a device which use a certain typeface. The only trait that the function looks for in the enumerated fonts is that it uses the specified typeface. The enumerated fonts are individually passed to a callback function for processing.

Return Value

The function returns whatever the final call to the callback function returned.

Visual Basic-Specific Issues

When passing 0 as lpszFamily, the expression CLng(0) must be used.

Parameters

hdc: A handle to a device context to the device to enumerate the fonts of.
lpszFamily: The name of the font typeface which the enumerated fonts must use. To instead enumerate a single font from each possible typeface, pass 0 for this parameter (not an empty string!).
lpEnumFontFamProc: A pointer to the EnumFontFamProc callback function which processes the information about each font that is enumerated.
lParam: A value to pass to the function specified by lpEnumFontFamProc.

Example

' This code is licensed according to the terms and conditions listed here.

' Enumerate some of the fonts available for window Form1.
' These fonts must have the Times New Roman typeface.
' Display some information about each font as it is enumerated.

' *** Place the following code in a module. ***
' The following callback function processes the enumerated fonts.
Public Function EnumFontFamProc (ByVal lpelf As Long, ByVal lpntm As Long, ByVal FontType As Long, ByVal lParam As Long) As Long
  Dim elf As ENUMLOGFONT  ' receives information about the font
  Dim ntm As NEWTEXTMETRIC  ' receives text metrics for TrueType fonts
  Dim tm As TEXTMETRIC  ' receives text metrics for non-TrueType fonts
  
  ' Copy the font information into the appropriate structure.
  CopyMemory elf, ByVal lpelf, Len(elf)

  ' If the font is TrueType, use the following code.
  If (FontType And TRUETYPE_FONTTYPE) = TRUETYPE_FONTTYPE Then
    ' Copy the text metrics into the appropriate structure.
    CopyMemory ntm, ByVal lpntm, Len(ntm)
    ' Display the name of the font (removing empty space from it).
    Debug.Print "Font Name: "; Left(elf.elfFullName, InStr(elf.elfFullName, vbNullChar) - 1);
    Debug.Print "  (TrueType font)"
    ' Display the style of the font (again removing empty space).
    Debug.Print "Font Style: "; Left(elf.elfStyle, InStr(elf.elfStyle, vbNullChar) - 1)
    ' Display the average character width.
    Debug.Print "Average Character Width:"; ntm.tmAveCharWidth
    ' Display the maximum character width.
    Debug.Print "Maximum Character Width:"; ntm.tmMaxCharWidth

  ' If the font is not TrueType, use the following code.
  Else
    ' Copy the text metrics into the appropriate structure.
    CopyMemory tm, ByVal lpntm, Len(tm)
    ' Display the name of the font (removing empty space from it).
    Debug.Print "Font Name: ";
    Debug.Print Left(elf.elfLogFont.lfFaceName, InStr(elf.elfLogFont.lfFaceName, vbNullChar) - 1);
    ' Display whether the font is a device or a raster font.
    If FontType = DEVICE_FONTTYPE Then
      Debug.Print "  (Device font)"
    ElseIf FontType = RASTER_FONTTYPE Then
      Debug.Print "  (Raster font)"
    End If
    Debug.Print "Font Style does not apply for this font."
    ' Display the average character width.
    Debug.Print "Average Character Width:"; tm.tmAveCharWidth
    ' Display the maximum character width.
    Debug.Print "Maximum Character Width:"; tm.tmMaxCharWidth
  End If

  Debug.Print "***"  ' separator
  ' Tell EnumFontFamilies to continue enumeration.
  EnumFontFamProc = 1
End Function

' *** Place this code wherever you want the enumerate the fonts. ***
Dim retval As Long  ' return value

' Enumerate all the fonts with the Times New Roman
' typeface which are available on Form1.
retval = EnumFontFamilies(Form1.hDC, "Times New Roman", AddressOf EnumFontFamProc, 0)
Debug.Print "Enumeration complete."