Rubrik: Fonts | 22.03.05 |
EnumFonts-Funktion Diese Funktion ermittelt alle vorhandenen Fonts eines Gerätes. Diese Funktion ist nur für die 16-Bit Kompatibilität, ab Windows 95 sollte die EnumFontFamiliesEx-Funktion genutzt werden. | ||
Betriebssystem: Win95, Win98, WinNT 3.1, Win2000, WinME | Views: 6.959 |
Deklaration:
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
Beschreibung:
Diese Funktion ermittelt alle vorhandenen Fonts eines Gerätes. Diese Funktion ist nur für die 16-Bit Kompatibilität, ab Windows 95 sollte die EnumFontFamiliesEx-Funktion genutzt werden.
Parameter:
hdc | Erwartet ein Geräte-Handle(z.B. das Handle eines Bildfeldes oder Druckers), dessen Font ermittelt werden sollen. |
lpFaceName | Erwartet einen Font-Namen, dessen Fonttypen ermittelt werden sollen. Wirdstatt dessen ein "VBNullString"-Zeichen übergeben, so wird jeweils ein Typ aller verfügbaren Fonts des Gerätesenumeriert. |
lpFontFunc | Erwartet eine Adresse der Callback-Funktion, die fürjeden ermittelten Font aufgerufen wird. In der Callback-Funktion muss als erstes eine Long-Variabledeklariert werden, die den Pointer zu einer LOGFONT-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(unter Windows 2000/XP kann dies auch ein Pointer zu einer ENUMTEXTMETRIC-Struktur sein). Die dritte benötigteLong-Variablel 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. |
LParam | Wenn benötigt, kann man hier einen Parameter übergeben, der bei jedem gefunden Font der Callback-Funktion übergeben wird. |
lpFontFunc 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:
Es wird der Rückgabewert des letzten Callback-Funktions Aufrufszurückgegeben.
Beispiel:
' Schreiben Sie den folgenden Code in ein öffentliches Modul 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 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 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 As String * 32 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 tmCharSet-Konstanten Private Const ANSI_CHARSET = 0 ' Ansi Zeichensatz Private Const ARABIC_CHARSET = 178 ' Arabisch (NT/2000) Private Const BALTIC_CHARSET = 186 ' Baltisch (Win 9x) Private Const CHINESEBIG5_CHARSET = 136 ' Chinesisch Private Const DEFAULT_CHARSET = 1 ' Standard Private Const EASTEUROPE_CHARSET = 238 ' Osteuropäisch (Win 9x) Private Const GB2312_CHARSET = 134 ' Englisch Private Const GREEK_CHARSET = 161 ' Griechisch (Win 9x) Private Const HANGEUL_CHARSET = 129 ' Handgeul Private Const HEBREW_CHARSET = 177 ' Hebräisch (NT/2000) Private Const JOHAB_CHARSET = 130 ' Johab (Win 9x) Private Const MAC_CHARSET = 77 ' Mac (Win 9x) Private Const OEM_CHARSET = 255 ' OEM Private Const RUSSIAN_CHARSET = 204 ' Russisch (Win 9x) Private Const SHIFTJIS_CHARSET = 128 ' ShiftJis Private Const SYMBOL_CHARSET = 2 ' Symbolisch Private Const THAI_CHARSET = 222 ' Thailändisch (NT/2000) Private Const TURKISH_CHARSET = 162 ' Türkisch (Win 9x) ' TEXTMETRIC tmPitchAndFamily-Konstanten Private Const TMPF_DEVICE = &H8 ' Gerätespezifischer Font Private Const TMPF_FIXED_PITCH = &H1 ' Variabler Font Private Const TMPF_TRUETYPE = &H4 ' TureType-Font Private Const TMPF_VECTOR = &H2 ' Vector-Font ' 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 LOGFONT, TM As TEXTMETRIC ' Fontinformationen in die Struktur kopieren MoveMemory LFont, ByVal FontDesc, Len(LFont) ' Erweiterte Textinformationen in die Struktur kopieren MoveMemory TM, ByVal TMetric, Len(TM) ' Fontnamen separieren TmpFntName = Left$(LFont.lfFaceName, lstrlen(LFont.lfFaceName)) ' Andere Typen des Fonts enumerieren If LParam << 2 Then Call EnumFonts(Form1.Picture1.hDC, TmpFntName & vbNullChar, _ AddressOf Module1.FntEnumProc, 2) Else ' Gefundenen Font ausgeben Debug.Print "Font: " & TmpFntName 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ätespezifischer Font" Debug.Print "Maximale Buchstabenbreite: " & TM.tmMaxCharWidth Debug.Print "Durchschnittliche Buchstabenbreite: " & TM.tmAveCharWidth TmpStr = TmpStr & "- - - - - - - - - - - " & vbCrLf Debug.Print TmpStr End If ' 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 ' Alle Fonts enumerieren Retval = EnumFonts(Picture1.hDC, vbNullString, AddressOf FntEnumProc, 0&) End Sub