vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Sch?tzen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2014
 
zurück
Rubrik: Fonts22.03.05
EnumFontFamilies-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, WinMEViews:  2.555 

Deklaration:

Declare Function EnumFontFamilies Lib "gdi32" _
  Alias "EnumFontFamiliesA"  ( _
  ByVal hdc As Long, _
  ByVal lpszFamily As String, _
  ByVal lpEnumFontFamProc 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:
hdcErwartet ein Handle eines Devices wiez.B. einen Drucker oder ein Bildfeld.
lpszFamilyErwartet den Namen eines Fonts, dessen Familienmitglieder(andere Arten des selben Fonts) enumeriert werden sollen. Wird hier ein "VBNullString"-Zeichen übergeben, so wird von jedem vorhanden Font ein "Familienmitglied"enumeriert.
lpEnumFontFamProcErwartet 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 ENUMLOGFONT-Struktur enthält (Unter Windows 2000/XP kann dies auch ein Pointer zu einer ENUMLOGFONTEXDV-Struktur sein. Anschließend wird wieder eine Long-Variable erwartet, die den Pointer zu einer TEXTEMETRIC-Struktur enthält, wennder Font ein TrueType-Font ist. Ist der 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.

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 EnumFontFamilies Lib "gdi32" _
  Alias "EnumFontFamiliesA" ( _
  ByVal hdc As Long, _
  ByVal lpszFamily As String, _
  ByVal lpEnumFontFamProc 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 ENUMLOGFONT
  elfLogFont As LOGFONT
  elfFullName As String * 64
  elfStyle As String * 64
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
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/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 Devicef-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 ENUMLOGFONT, TM As TEXTMETRIC, NTM As NEWTEXTMETRIC
  Dim TmpFntName As String
 
  ' Fontinformationen in die Struktur kopieren
  MoveMemory LFont, ByVal FontDesc, Len(LFont)
 
  ' Erweiterte Textinformationen in die Struktur kopieren
  If CBool(FontType And TRUETYPE_FONTTYPE) = True Then
    MoveMemory TM, ByVal TMetric, Len(TM)
  Else
    MoveMemory NTM, ByVal TMetric, Len(NTM)
  End If
 
  ' Fontnamen separieren
  TmpFntName = Left$(LFont.elfLogFont.lfFaceName, lstrlen(LFont.elfLogFont.lfFaceName)) 
 
  ' Andere Typen des Fonts enumerieren
  If lParam << 2 Then
    Call EnumFontFamilies(Form1.Picture1.hdc, TmpFntName &  _
    vbNullChar, AddressOf Module1.FntEnumProc, 2)
  Else
    ' Gefundenen Font ausgeben
    Debug.Print "Font: " & TmpFntName
    Debug.Print "Stil: " & Left$(LFont.elfStyle, lstrlen(LFont.elfStyle)) 
    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) = True 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
  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
 
  ' Alle Fonts enumerieren
  Retval = EnumFontFamilies(Picture1.hdc, vbNullString, AddressOf  _
  FntEnumProc, 0&)
End Sub

Diese Seite wurde bereits 2.555 mal aufgerufen.

nach obenzurück
 
   

Druckansicht Druckansicht Copyright ©2000-2014 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel