<code>Public Sub Text_Print(ByRef Object, ByVal PosX, _
  ByVal PosY, ByVal Text As String, _
  Optional ByVal Winkel, _
  Optional ByVal Grösse, _
  Optional ByVal Fett As Boolean, _
  Optional ByVal Unterstrichen As Boolean, _
  Optional ByVal Kursiv As Boolean, _
  Optional ByVal Druchgestrichen As Boolean, _
  Optional ByVal FontName As String)
 
  Dim hPrinterDC As Long
  Dim FontOld As Long
  Dim Ret As Long
  Dim hFont As Long
 
 <font color=green> ' Druckt Text in einer X-Beliebigen Position aus
  ' ----------------------------------------------
  '
  ' Parameter: Object Ausgabe- Object
  ' PosX X-Koordinate in Twips
  ' PosY Y-Koordinate in Twips
  ' Text$ Text zum drucken
  ' Optional Winkel Winkel (0 - 360)
  ' Optional Grösse Textgrösse in Punkten (1 - 250)
  ' Optional Fett Ja/Nein
  ' Optional Unterstrichen Ja/Nein
  ' Optional Kursiv Ja/Nein
  ' Optional Durchgestrichen Ja/Nein
  ' Optional Fontname$ Schrifttyp
  '
  ' 11. Oktober 2001
  ' R.Kaufmann
 
  ' Parameter prüfen
  ' ----------------</font>
  If IsMissing(Winkel) Then Let Winkel = 0
  If IsMissing(Grösse) Then Let Grösse = 12
  If IsMissing(Fett) Then Let Fett = False
  If IsMissing(Unterstrichen) Then Let Unterstrichen = False
  If IsMissing(Kursiv) Then Let Kursiv = False
  If IsMissing(FontName) Then
    Let FontName = "Arial"
  Else
    If FontName = "" Then Let FontName = "Arial"
  End If  
 
  <font color=green>' Handle vom Printer in Variable einlesen
  ' ---------------------------------------</font>
  Let hPrinterDC = Object.hdc
  Let PosX = PosX / Object.TwipsPerPixelX
  Let PosY = PosY / Object.TwipsPerPixelY
 
  If Text$ = "" Then Exit Sub
 
  <font color=green>' Neuer Font kreieren</fnt>
  Dim Schrift As LOGFONT
  With Schrift
    .lfHeight = (Grösse * -20) / Screen.TwipsPerPixelY
    .lfEscapement = Winkel * 10
    .lfOrientation = Winkel * 10
    .lfWeight = IIf(Fett = True, 700, 400)
    .lfItalic = Kursiv
    .lfUnderline = Unterstrichen
    .lfStrikeOut = Druchgestrichen
    .lfCharSet = DEFAULT_CHARSET
    .lfFaceName = FontName + Chr$(0)
 
    hFont = CreateFontIndirect(Schrift)
    FontOld = SelectObject(hPrinterDC, hFont)
 
    <font color=green>' Text ausdrucken</font>
    Ret = TextOut(hPrinterDC, PosX, PosY, Text, Len(Text))
 
    <font color=green>' Alten Font wieder herstellen</font>
    Ret = SelectObject(hPrinterDC, FontOld)
 
    <font color=green>' Neuen Font löschen</font>
    Ret = DeleteObject(hFont)
  End With
End Sub</code>