Функция EnumFontFamiliesEx

Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hdc As Long, _
    lpLogfont As LOGFONT, _
	ByVal lpEnumFontFamExProc As Long, _
	ByVal lParam As Long, _
	ByVal dwFlags As Long) As Long

EnumFontFamiliesEx перечисляет все доступные шрифты в системе по задаваемым характеристикам структуры LOGFONT

Возвращаемое значение

Функция возвращает последнее значение, возвращенное функцией обратного вызова

Параметры

hdc

Дескриптор контекста устройства

lpLogfont

Структура LOGFONT, содержащая информацию о перечисляемых шрифтах. Функция использует следующие поля структуры

lfCharset	Если установлено DEFAULT_CHARSET, то функция перечисляет все шрифты со всеми символьными установками. If set to a valid character set value, the function enumerates only fonts in the specified character set
lfFaceName	If set to an empty string, the function enumerates one font in each available typeface name. If set to a valid typeface name, the function enumerates all fonts with the specified name
lfPitchAndFamily	Must be set to zero for all language versions of the operating system

Остальные поля структуры игнорируются

lpEnumFontFamExProc

Указатель на функцию обратного вызова EnumFontFamExProc

lParam

Пользовательский параметр, передаваемый функции обратного вызова

dwFlags

Зарезервировано - установите в 0

Пример

' Перечислим шрифты, доступные для Form1.
' Эти шрифты должны иметь  ANSI-символы
' и тип Times New Roman

' *** Код для модуля***
'  Функция обратного вызова для перечисления шрифтов
Public Function EnumFontFamExProc (ByVal lpelfe As Long, ByVal lpntme As Long, ByVal FontType As Long, ByVal lParam As Long) As Long

  Dim elfx As ENUMLOGFONTEX  ' информация о шрифте
  Dim ntmx As NEWTEXTMETRICEX  ' метрики текста для шрифта TrueType
  Dim tm As TEXTMETRIC  ' метрики текста для не TrueType-шрифтов
  
  ' Копируем информацию о шрифте в структуру
  CopyMemory elfx, ByVal lpelfe, Len(elfx)

  ' Если шрифт TrueType, то используем код
  If (FontType And TRUETYPE_FONTTYPE) = TRUETYPE_FONTTYPE Then
    ' Копируем метрики текста в структуру
    CopyMemory ntmx, ByVal lpntme, Len(ntmx)
    ' Показываем имя шрифта
    Debug.Print "Font Name: "; Left(elfx.elfFullName, InStr(elfx.elfFullName, vbNullChar) - 1);
    Debug.Print "  (TrueType font)"
    ' Показываем стиль шрифта
    Debug.Print "Font Style: "; Left(elfx.elfStyle, InStr(elfx.elfStyle, vbNullChar) - 1)

    Debug.Print "Average Character Width:"; ntmx.ntmTm.tmAveCharWidth

    Debug.Print "Maximum Character Width:"; ntmx.ntmTm.tmMaxCharWidth

  ' Если шрифт не TrueType, то...
  Else

    CopyMemory tm, ByVal lpntme, Len(tm)

    Debug.Print "Font Name: ";
    Debug.Print Left(elfx.elfLogFont.lfFaceName, InStr(elfx.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."

    Debug.Print "Average Character Width:"; tm.tmAveCharWidth

    Debug.Print "Maximum Character Width:"; tm.tmMaxCharWidth
  End If

  Debug.Print "***"
  ' Сообщаем функции продолжать перечисление
  EnumFontFamExProc = 1
End Function

' *** Код для перечисления ***
Dim lf As LOGFONT  
Dim retval As Long


lf.lfCharset = ANSI_CHARSET
lf.lfFaceName = "Times New Roman" & vbNullChar
lf.lfPitchAndFamily = 0

' Перечисляем шрифты, доступные для Form1
retval = EnumFontFamiliesEx(Form1.hDC, lf, AddressOf EnumFontFamExProc, 0, 0)
Debug.Print "Enumeration complete."

Смотри также

EnumFontFamilies

Категория

Шрифты и тексты

Реклама