vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Fonts22.03.05
EnumFontFamiliesEx-Funktion

Diese Funktion ermittelt alle vorhandenen Fonts eines Gerätes, wobei noch angegeben werden kann, dass nur nach einem bestimmten Fontstil gesucht werden soll.

Betriebssystem:  Win95, Win98, WinNT 4.0, Win2000, WinMEViews:  8.686 

Deklaration:

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

Beschreibung:
Diese Funktion ermittelt alle vorhandenen Fonts eines Gerätes, wobei noch angegeben werden kann, dass nur nach einem bestimmten Fontstil gesucht werden soll.

Parameter:
hdcErwartet ein Handle eines Devices wiez.B. einen Drucker oder ein Bildfeld.
lpLogfontErwartet eine LOGFONT-Struktur dessen "lfFaceName" Variable mit dem Namen des Fonts gefüllt werden kann, dessen Fonttypenenumeriert werden sollen. Wird hier kein String eingetragen so werden alle Fontsenumeriert. Zusätzlich kann die Variable "lfCharSet" mit einer der "lfCharSet"-Konstenten der "LOGFONT"-Struktur gefüllt werden, wenn nur ein bestimmter Fontstilenumeriert werden soll. Übergeben sie dieser Variable die Konstante "DEFAULT_CHARSET", um alle Stile des angegeben Fonts zuenumerieren. Wird bei "lfFaceName" kein String und bei "lfCharSet" die Konstante "DEFAULT_CHARSET" übergeben, so werden alle Fonts und sämtliche Stileenumeriert.
lpEnumFontFamExProcErwartet die Adresse einer Callback-Funktion, die bei jedem gefundenen Fontaufgerufen wird. In der Callback-Funktion muss als erstes eine Long-Variabledeklariert werden, die den Pointer zu einer ENUMLOGFONTEX-Struktur enthält(unter Windows 2000/XP kann dies auch ein Pointer zu einer ENUMLOGFONTEXDV-Struktursein). Anschließend wird wieder eine Long-Variable erwartet, die den Pointer zu einer TEXTEMETRIC-Struktur enthält. Istder Font ein TrueType-Font, so ist der Pointer ein Zeiger auf eine NEWTEXTMETRIC-Struktur(unter Windows 2000/XP kann dies auch ein Pointer zu einer ENUMTEXTMETRIC-Struktur sein). Die dritte benötigteLong-Variable enthält beim Funktionsaufruf eine der Callback Fonttype-Konstanten, die die Art des Fonts beschreibt. Die letzte Long-Variable, die deklariert werden muss, empfängt nur einen zusätzlichen Parameter derz.B. beim Funktionsaufruf der EnumFonts-Funktion übergeben wurde. Der Callback-Funktion muss derWert "1" zurückgegeben werden, wenn der Enumerationsvorgang fortgesetzt werden soll.
lParamWenn benötigt, kann man hier einen Parameter übergeben, der bei jedem gefundenen Font der Callback-Funktion übergeben wird.
dwFlagsDieser Parameter wird noch nicht genutzt, übergebenSie hier den Wert "0".

lpEnumFontFamExProc Konstanten:

Const DEVICE_FONTTYPE = &H2
' Der Font ist ein Device-Font
 
Const RASTER_FONTTYPE = &H1
' Der Font ist ein Raster-Font
 
Const TRUETYPE_FONTTYPE = &H4
' Der Font ist ein TrueType-Font

Rückgabewert:
Die Rückgabe ist der Rückgabewert des letzten Callback-Funktions-Aufrufs.

Beispiel:

' Schreiben Sie den folgenden Code in ein öffentliches Modul
Public 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
Private Declare Sub MoveMemory Lib "kernel32.dll" _
  Alias "RtlMoveMemory"  ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)
Private Declare Function lstrlen Lib "kernel32" _
  Alias "lstrlenA" ( _
  ByVal lpString As String) As Long
 
Public 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 As String * 32
End Type
 
Private Type ENUMLOGFONTEX
  elfLogFont As LOGFONT
  elfFullName As String * 64
  elfStyle As String * 32
  elfScript As String * 32
End Type
 
Private 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
 
Private Type TEXTMETRIC
  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
End Type
 
' TEXTMETRIC/NEWTEXTMETRIC tmCharSet-Konstanten
Public Const ANSI_CHARSET = 0  ' Ansi Zeichensatz
Public Const ARABIC_CHARSET = 178  ' Arabisch (NT/2000)
Public Const BALTIC_CHARSET = 186  ' Baltisch (Win 9x)
Public Const CHINESEBIG5_CHARSET = 136  ' Chinesisch
Public Const DEFAULT_CHARSET = 1  ' Standard
Public Const EASTEUROPE_CHARSET = 238  ' Osteuropäisch (Win 9x)
Public Const GB2312_CHARSET = 134  ' Englisch
Public Const GREEK_CHARSET = 161  ' Griechisch (Win 9x)
Public Const HANGEUL_CHARSET = 129  ' Handgeul
Public Const HEBREW_CHARSET = 177  ' Hebräisch (NT/2000)
Public Const JOHAB_CHARSET = 130  ' Johab (Win 9x)
Public Const MAC_CHARSET = 77  ' Mac (Win 9x)
Public Const OEM_CHARSET = 255  ' OEM
Public Const RUSSIAN_CHARSET = 204  ' Russisch (Win 9x)
Public Const SHIFTJIS_CHARSET = 128  ' ShiftJis
Public Const SYMBOL_CHARSET = 2  ' Symbolisch
Public Const THAI_CHARSET = 222  ' Thailändisch (NT/2000)
Public Const TURKISH_CHARSET = 162  ' Türkisch (Win 9x)
 
' TEXTMETRIC/NEWTEXTMETRIC tmPitchAndFamily-Konstanten
Private Const TMPF_DEVICE = &H8 ' Gerätespezifischer Font
Private Const TMPF_FIXED_PITCH = &H1 ' Variabler Font
Private Const TMPF_TRUETYPE = &H4 ' TrueType Font
Private Const TMPF_VECTOR = &H2 ' Vector Font
 
' NEWTEXTMETRIC ntmFlags-Konstanten
Private Const NTM_ITALIC = &H1& ' Der Font ist kursiv
Private Const NTM_BOLD = &H20& ' Der Font ist fett
Private Const NTM_REGULAR = &H40& ' Der Font ist regulär
Private Const NTM_NONNEGATIVE_AC = &H10000 ' (Win XP/2000) Kein Glyph in dem  
' Font hat einen negativen A- oder C-Wert
Private Const NTM_PS_OPENTYPE = &H20000 ' (Win XP/2000) Der Font ist ein  
' PostScript OpenType Font
Private Const NTM_TT_OPENTYPE = &H40000 ' (Win XP/2000) Der Font ist ein  
' TrueType OpenType Font
Private Const NTM_MULTIPLEMASTER = &H80000 ' (Win XP/2000) Der Font ist ein  
' Multiple Master-Font
Private Const NTM_TYPE1 = &H100000 ' (Win XP/2000) Der Font ist ein Type1 Font 
Private Const NTM_DSIG = &H200000 ' (Win XP/2000) Der Font hat eine digitale  
' Signatur, die den Font zertifiziert
 
' FntEnumProc FontType-Konstanten
Private Const DEVICE_FONTTYPE = &H2 ' Der Font ist ein Device-Font
Private Const RASTER_FONTTYPE = &H1 ' Der Font ist ein Raster-Font
Private Const TRUETYPE_FONTTYPE = &H4 ' Der Font ist ein TrueType-Font
' Wird bei jedem gefundenen Font von EnumFonts aufgerufen
Public Function FntEnumProc(ByVal FontDesc As Long, ByVal TMetric As Long,  _
ByVal FontType As Long, ByVal lParam As Long) As Long
  Dim LFont As ENUMLOGFONTEX, TM As TEXTMETRIC, NTM As NEWTEXTMETRIC
 
  ' Fontinformationen in die Struktur kopieren
  MoveMemory LFont, ByVal FontDesc, Len(LFont)
 
  ' Erweiterte Textinformationen in die Struktur kopieren
  If CBool(FontType And TRUETYPE_FONTTYPE) = False Then
    MoveMemory TM, ByVal TMetric, Len(TM)
  Else
    MoveMemory NTM, ByVal TMetric, Len(NTM)
  End If
 
  ' Font-Informationen ausgeben
  Debug.Print "Font: "; Left$(LFont.elfLogFont.lfFaceName, lstrlen(LFont.elfLogFont.lfFaceName)) 
  Debug.Print "Stil: " & Left$(LFont.elfStyle, lstrlen(LFont.elfStyle))
  Debug.Print "Script: " & Left$(LFont.elfScript, lstrlen(LFont.elfScript)) 
  If CBool(lParam And TRUETYPE_FONTTYPE) = True Then Debug.Print "Typ: TrueType-Font" 
  If CBool(lParam And RASTER_FONTTYPE) = True Then Debug.Print "Typ: Raster-Font" 
  If CBool(lParam And DEVICE_FONTTYPE) = True Then Debug.Print "Typ:  _
  Gerätespezifisches Font"
  If CBool(FontType And TRUETYPE_FONTTYPE) = False Then
    Debug.Print "Maximale Buchstabenbreite: " & TM.tmMaxCharWidth
    Debug.Print "Durchschnittliche Buchstabenbreite: " & TM.tmAveCharWidth 
  Else
    Debug.Print "Maximale Buchstabenbreite: " & NTM.tmMaxCharWidth
    Debug.Print "Durchschnittliche Buchstabenbreite: " & NTM.tmAveCharWidth 
  End If
  Debug.Print "- - - - - - - - - - - -"
 
  ' einen Wert ungleich 0 zurückgeben, um das Enumerieren fortzusetzen
  FntEnumProc = 1
End Function
' Schreiben Sie den folgenden Code in eine Form
' Enumeriert alle Fonts
Private Sub Form_Load()
  Dim Retval As Long, XP2000 As Long, LF As LOGFONT
 
  ' Alle Fonts enumerieren
  LF.lfCharSet = DEFAULT_CHARSET
  Retval = EnumFontFamiliesEx(Picture1.hdc, LF, AddressOf FntEnumProc,  _
  0&, 0&)
End Sub

 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.