CreateFontIndirect-Funktion Diese Funktion erstellt einen Font und gibt dessen Handle zurück.
Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinME	Views:  10.337

Deklaration:

Declare Function CreateFontIndirect Lib "gdi32.dll" _
  Alias "CreateFontIndirectA" ( _
  lplf As LOGFONT) As Long

Beschreibung:
Diese Funktion erstellt einen Font und gibt dessen Handle zurück.

Parameter:

lplf	Erwartet eine LOGFONT-Struktur die mit dem zu erstellendem Font gefüllt ist.

Rückgabewert:
Ist die Funktion erfolgreich, so liefert sie das Handle des neu erstellten Font, andernfalls wird derWert "0" zurückgegeben. Unter Windows NT, 2000 und XP können Sie die GetLastError-Funktion für erweiterte Fehlerinformationen aufrufen.

Beispiel:

Private Declare Function GetTextAlign Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SetTextAlign Lib "gdi32.dll" ( _
  ByVal hdc As Long, _
   ByVal wFlags As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32.dll" _
  Alias "CreateFontIndirectA" ( _
  lplf As LOGFONT) As Long
Private Declare Function ExtTextOut Lib "gdi32" _
  Alias "ExtTextOutA" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal wOptions As Long, _
   lpRect As Any, _
  ByVal lpString As String, _
  ByVal nCount As Long, _
  lpDx As Long) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) 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 RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
' LOGFONT lfnWeight-Konstanten
Const FW_DONTCARE = 0  ' Standard
Const FW_THIN = 100  ' Super Dünn
Const FW_EXTRALIGHT = 200  ' Extra Dünn
Const FW_LIGHT = 300  ' Dünn
Const FW_NORMAL = 400  ' Normal
Const FW_MEDIUM = 500 ' Mittel
Const FW_SEMIBOLD = 600  ' Etwas Dicker
Const FW_BOLD = 700  ' Fett
Const FW_EXTRABOLD = 800  ' Extra Fett
Const FW_HEAVY = 900  ' Super Fett
 
' LOGFONT lfCharSet-Konstanten
Const ANSI_CHARSET = 0  ' Ansi Zeichensatz
Const ARABIC_CHARSET = 178  ' Arabisch (NT/2000)
Const BALTIC_CHARSET = 186  ' Baltisch (Win 9x)
Const CHINESEBIG5_CHARSET = 136  ' Chinesisch
Const DEFAULT_CHARSET = 1  ' Standard
Const EASTEUROPE_CHARSET = 238  ' Osteuropäisch (Win 9x)
Const GB2312_CHARSET = 134  ' Englisch
Const GREEK_CHARSET = 161  ' Griechisch (Win 9x)
Const HANGEUL_CHARSET = 129  ' Hangeul
Const HEBREW_CHARSET = 177  ' Hebräisch (NT/2000)
Const JOHAB_CHARSET = 130  ' Johab (Win 9x)
Const MAC_CHARSET = 77  ' Mac (Win 9x)
Const OEM_CHARSET = 255  ' OEM
Const RUSSIAN_CHARSET = 204  ' Russisch (Win 9x)
Const SHIFTJIS_CHARSET = 128  ' ShiftJis
Const SYMBOL_CHARSET = 2  ' Symbol
Const THAI_CHARSET = 222  ' Thailändisch (NT/2000)
Const TURKISH_CHARSET = 162  ' Türkisch (Win 9x)
 
' LOGFONT lfOutPrecision-Konstanten
Const OUT_DEFAULT_PRECIS = 0  ' Benutzt die Standard Font
Const OUT_DEVICE_PRECIS = 5    ' Benutzt eine Device Font wenn mehrere Dateien  _
' mit dem selben Namen existieren
Const OUT_OUTLINE_PRECIS = 8  ' (NT/2000) Benutzt eine TrueType-Schriftart  _
' oder Outline-Based Fonts.
Const OUT_RASTER_PRECIS = 6   ' Benutzt ein Raster-Font wenn mehrere Dateien  _
' mit dem selben Namen existieren
Const OUT_STRING_PRECIS = 1    ' Raster-Font für die Enumeration
Const OUT_STROKE_PRECIS = 3   ' (Win 9x) Vector Font für die Enumeration /  _
' (NT/2000) TrueType, Outline-Based oder VectorFont für die Enumeration
Const OUT_TT_ONLY_PRECIS = 7    ' Benutzt eine TrueType schriftart
Const OUT_TT_PRECIS = 4  ' Benutzt ein TrueType-Font wenn andere Fonts mit  _
' dem selben Namen Existieren
 
' LOGFONT lfClipPrecision-Konstanten
Const CLIP_DEFAULT_PRECIS = 0   ' Standard
Const CLIP_EMBEDDED = 128  ' wird benutzt für eingebettete Schreibgeschützte 'Fonts 
Const CLIP_LH_ANGLES = 16  ' Die Richtung von irgendwelchen Rotationen wird  _
' vom Koordinatensystem festgelegt (gegen den Uhrzeigersinn)
Const CLIP_STROKE_PRECIS = 2  ' Raster Vector oder TrueType Fonts für die Enumeration 
 
' LOGFONT lfQuality-Konstanten
Const ANTIALIASED_QUALITY = 4  ' (Win 9x, NT 4.0, 2000) Die Schriftart wird  _
' immer mit Anitaliasing gezeichnet wenn möglich
Const DEFAULT_QUALITY = 0  ' Standard-Qualität
Const DRAFT_QUALITY = 1  ' Das Erscheinen des Fonts ist weniger wichtig als _
' bei PROOF_QUALITY
Const NONANTIALIASED_QUALITY = 3   ' (Win 9x, NT 4.0, 2000) Die Schriftart  _
' wird nicht mit Anitaliasing gezeichnet
Const PROOF_QUALITY = 2    ' Die Qualität der Erscheinung ist wichtiger als  _
' das exakte Übereinstimmen mit den Font-Attributen
 
' LOGFONT lfPitchAndFamily-Konstanten
Const DEFAULT_PITCH = 0  ' Standard
Const FIXED_PITCH = 1  ' Fest
Const VARIABLE_PITCH = 2  ' Variabel
Const FF_DECORATIVE = 80  ' Dekoriert
Const FF_DONTCARE = 0  ' Egal
Const FF_MODERN = 48  ' Modern
Const FF_ROMAN = 16  ' Roman
Const FF_SCRIPT = 64  ' Script
Const FF_SWISS = 32  ' Swiss
 
' Get- / SetTextAlign Rückgabe- / wFlags-Konstanten
Private Const TA_BASELINE = 24    ' Alle Textausgaben erfolgen
Private Const TA_BOTTOM = 8    ' Alle Textausgaben werden unterhalb der  _
' angegebenen Koordinaten ausgegeben
Private Const TA_CENTER = 6    ' Alle Textausgaben werden mittig der  _
' angegebenen Koordinaten ausgegeben
Private Const TA_LEFT = 0    ' Alle Textausgaben werden links von den  _
' angegebenen Koordinaten ausgegeben
Private Const TA_NOUPDATECP = 0    ' Der Aktuelle Punkt wird nicht zum  _
' Referenzpunkt gemacht
Private Const TA_RIGHT = 2    ' Alle Textausgaben werden rechts von den  _
' angegebenen Koordinaten ausgegeben
Private Const TA_TOP = 0    ' Alle Textausgaben werden oberhalb der angegebenen  _
' Koordinaten ausgegeben
Private Const TA_UPDATECP = 1    ' die aktuelle Position wird zum Referenzpunkt gemacht 
Private Const TA_RTLREADING = 256   ' der Text wird wenn möglich von rechts  _
' nach links ausgegeben
 
' ExtTextOut wOptions-Konstanten
Private Const ETO_CLIPPED = 4   ' Der Text wird auf das Ziel zurechtgeschnitten
Private Const ETO_GLYPH_INDEX = &H10   ' (ab Win 95 / NT 4.0 und später) bei  _
' lpString wird die Rückgabe der GetCharacterPlacement-Funktion übergebeben
Private Const ETO_IGNORELANGUAGE = &H1000   ' (Win NT 4.0 und später) Es wird  _
' kein Scripting Support eingeschaltet, dies kann dazu führen, dass der Text  _
' nicht angezeigt werden kann
Private Const ETO_NUMERICSLATIN = &H800   ' (Win 96 / NT 4.0 und später) Wird  _
' benutzt um Europäische Zahlen anzuzeigen
Private Const ETO_NUMERICSLOCAL = &H400   ' (Win 96 / NT 4.0 und später) Wird  _
' benutzt um lokale Zahlen anzuzeigen
Private Const ETO_OPAQUE = 2   ' Die aktuelle Hintergrundfarbe wird verwendet  _
' um die Hintergrundfarbe des Ziels auszufüllen
Private Const ETO_PDY = &H2000   ' (Win 2000 / XP) bei lpDX wird ein Pointer  _
' zu einem 2 Felder großen Array übergeben das die Abstände (x und y)  _
' zwischen den buchstaben enthält
Private Const ETO_RTLREADING = &H80 ' (Win 95 / NT 4.0 und später bei Ost  _
' Asiatischen Windows Versionenen) Der Text wird wenn möglich von rechts  _
' nach links ausgegeben

' Zeichnet einen Text inmitten des Fensters
Private Sub Command1_Click()
  Dim Retval As Long, hOldFont As Long, Distance() As Long
  Dim OutStr As String, LF As LOGFONT
 
  ' Text  für die Ausgabe bestimmt
  OutStr = "VB Api Helpline"
 
  ' Form-Maßeinheit auf Pixel stellen (AutoRedraw muss True sein !!)
  Me.ScaleMode = vbPixels
 
  ' Aktuelle Textausrichtung ermitteln
  Retval = GetTextAlign(Me.hdc)
 
  ' Aktuelle Textausrichtung auswerten
  If CBool(Retval And TA_CENTER) Then Debug.Print "Der Text wird  _
  Zentriert am Referenzpunkt ausgegeben"
  If CBool(Retval And TA_TOP) Then Debug.Print "Der Text wird Oberhalb  _
  des Referenzpunktes ausgegeben"
  ' und so weiter...
 
  ' Neue Textausrichtung einstellen (Alle Textausgaben erfolgen zentriert  _
  ' und unterhalb der übergebenen Koordinaten)
  SetTextAlign Me.hdc, TA_CENTER Or TA_BOTTOM Or TA_NOUPDATECP
 
  ' Font Definieren
  With LF
    .lfWeight = FW_BOLD
    .lfCharSet = DEFAULT_CHARSET
    .lfOutPrecision = OUT_DEFAULT_PRECIS
    .lfClipPrecision = CLIP_DEFAULT_PRECIS
    .lfQuality = DEFAULT_QUALITY
    .lfPitchAndFamily = DEFAULT_PITCH Or FF_DECORATIVE
    .lfFaceName = "Times New Roman"
  End With
 
  ' Font erstellen
  Retval = CreateFontIndirect(LF)
  If Retval = 0 Then Exit Sub
 
  ' Font der Form zuweisen und alten Font zwischenspeichern
  hOldFont = SelectObject(Me.hdc, Retval)
 
  ' Distanz zwischen den Buchstaben setzen
  ReDim Distance(Len(OutStr) - 1)
  For i = 0 To UBound(Distance)
    Distance(i) = Me.TextWidth(Mid$(OutStr, i + 1, 1)) + 20
  Next i
 
  ' Einen Text ausgeben in der Mitte des Fensters
  ExtTextOut Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, ETO_OPAQUE,  _
  ByVal 0&, OutStr, Len(OutStr), Distance(0)
 
  ' Alten Font wiederherstellen und erstellten Font löschen
  DeleteObject SelectObject(Me.hdc, hOldFont)
 
  Me.Refresh
End Sub