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: Parameter:
Rückgabewert: 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 8.000 mal aufgerufen. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Buchempfehlung Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevAniGif (VB/VBA) Anzeigen von animierten GIF-Dateien Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. |
||||||||||||||||||
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. |