vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v2.0 - Das Eingabecontrol der Superlative!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
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.957 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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.957 mal aufgerufen.

    nach obenzurück
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 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