Imports System.Windows.Forms.VisualStyles.VisualStyleElement
 
Public Class frmFontCombo
 
    'Namespace genau angeben
    Dim WithEvents cmb As New Windows.Forms.ComboBox With
        {.Parent = Me, .Width = 150, .DropDownStyle = _
          ComboBoxStyle.DropDownList}
 
 
 
    Private Sub frmFontCombo_Load(sender As Object, e As EventArgs) Handles _
      MyBase.Load
        FillCombobox()
    End Sub
 
 
    Private Sub FillCombobox()
 
        ' alle verfügbaren Schriften auflisten
        With cmb.Items
            For Each oFont As FontFamily In Font.FontFamily.Families
                .Add(oFont)
            Next
        End With
 
        ' Wir möchten uns um die Ausgabe der 
        ' Listen-Einträge selbst kümmern
        cmb.DrawMode = DrawMode.OwnerDrawFixed
    End Sub
 
 
    Private Sub cmb_DrawItem(ByVal sender As Object,
         ByVal e As System.Windows.Forms.DrawItemEventArgs) Handles cmb.DrawItem
 
        Dim sitem As String, ofont As Drawing.Font
        If e.Index < 0 Then Exit Sub
 
        With cmb
            ' ComboBox-Eintrag (Schriftname)
            sitem = .Items(e.Index).Name
 
            ' Neues Schrift-Objekt erzeugen und verfügbare Styles 
            ' berücksichtigen
            Dim oFamily As FontFamily = .Items(e.Index)
            If oFamily.IsStyleAvailable(FontStyle.Regular) Then
                ofont = New Font(sItem, .Font.Size, FontStyle.Regular)
            ElseIf oFamily.IsStyleAvailable(FontStyle.Italic) Then
                ofont = New Font(sItem, .Font.Size, FontStyle.Italic)
            ElseIf oFamily.IsStyleAvailable(FontStyle.Bold) Then
                ofont = New Font(sItem, .Font.Size, FontStyle.Bold)
            ElseIf oFamily.IsStyleAvailable(FontStyle.Underline) Then
                ofont = New Font(sItem, .Font.Size, FontStyle.Underline)
            Else
                ofont = New Font(sItem, .Font.Size, FontStyle.Strikeout)
            End If
        End With
 
        ' Brush für Textfarbe
        Using oBrush As Brush = New SolidBrush(e.ForeColor)
 
            ' Hintergrund
            e.DrawBackground()
 
            ' Text (Schriftname) ausgeben
            e.Graphics.DrawString(sitem, ofont, oBrush, e.Bounds.X, e.Bounds.Y)
        End Using
 
    End Sub
 
End Class

Public Class Form1
 
  Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    With ToolStripComboBox1
      For Each f In FontFamily.Families
        .Items.Add(f)
      Next
      .ComboBox.DrawMode = DrawMode.OwnerDrawFixed
      .ComboBox.DropDownStyle = ComboBoxStyle.DropDownList
      AddHandler .ComboBox.DrawItem, AddressOf ToolStripComboBox1_DrawItem
    End With
  End Sub
 
  ' Vertikale Zentrierung
  Private Shared ReadOnly SF As New StringFormat With {.LineAlignment = _
    StringAlignment.Center}
 
  ' Items zeichnen
  Private Sub ToolStripComboBox1_DrawItem(sender As Object, e As _
    DrawItemEventArgs)
    If e.Index < 0 Then Return
    With ToolStripComboBox1
 
      Dim ff As FontFamily = DirectCast(.Items(e.Index), FontFamily)
      Dim fs As Single = .Font.Size
 
      Dim oFont As Font
      If ff.IsStyleAvailable(FontStyle.Regular) Then
        oFont = New Font(ff, fs, FontStyle.Regular)
      ElseIf ff.IsStyleAvailable(FontStyle.Italic) Then
        oFont = New Font(ff, fs, FontStyle.Italic)
      ElseIf ff.IsStyleAvailable(FontStyle.Bold) Then
        oFont = New Font(ff, fs, FontStyle.Bold)
      ElseIf ff.IsStyleAvailable(FontStyle.Underline) Then
        oFont = New Font(ff, fs, FontStyle.Underline)
      Else
        oFont = New Font(ff, fs, FontStyle.Strikeout)
      End If
 
      e.DrawBackground()
      Using oBrush As New SolidBrush(e.ForeColor)
        e.Graphics.DrawString(ff.Name, oFont, oBrush, e.Bounds, SF)
      End Using
    End With
  End Sub
 
End Class

    Private Sub leseFontUndSizeUnterCaret()
        Dim tmpStyle As FontStyle
        Dim farbe As Color = Color.LightSalmon
        Dim tmpRegular As Boolean = True
 
        If LCase(IO.Path.GetExtension(dateiname)) = ".rtf" Then
 
           If tsc_TextEditor_RTFBox.SelectionFont IsNot Nothing Then
 
                ' Schriftschnitt anzeigen
 
                ' hier gekürzt... 
 
                ' Schriftart und Schriftgrösse
                Dim schriftgrösse As Integer = Int( _
                  tsc_TextEditor_RTFBox.SelectionFont.Size + 0.5)
                aktSelectedRTFFont = New Font( _
                tsc_TextEditor_RTFBox.SelectionFont.FontFamily.Name, _
                schriftgrösse, tsc_TextEditor_RTFBox.SelectionFont.Style)
                aktselectedRTFColor = tsc_TextEditor_RTFBox.SelectionColor
 
                Debug.Print("`" & aktSelectedRTFFont.FontFamily.Name & "´ - " & _
                  aktSelectedRTFFont.Style.ToString & " - " & schriftgrösse & "" & _
                  "- " & aktselectedRTFColor.ToString)
 
                sym_TextEditor_Format_cob_Schriftart.Text = _
                  aktSelectedRTFFont.FontFamily.Name
                sym_TextEditor_Format_cob_Schriftgrösse.Text = Int( _
                tsc_TextEditor_RTFBox.SelectionFont.Size + 0.5)
 
                ' Schriftfarbe
                sym_TextEditor_Format_Schriftfarbe.BackColor = _
                  tsc_TextEditor_RTFBox.SelectionColor
            End If
        End If
    End Sub

     sym_TextEditor_Format_cob_Schriftart.Text = _
       tsc_TextEditor_RTFBox.SelectionFont.FontFamily.ToString

     If tsc_TextEditor_RTFBox.SelectionFont IsNot Nothing Then
        tsc_TextEditor_RTFBox.SelectionFont = New Font( _
          sym_TextEditor_Format_cob_Schriftart.Text, _
          tsc_TextEditor_RTFBox.SelectionFont.Size, _
          tsc_TextEditor_RTFBox.SelectionFont.Style)
     End If

If tsc_TextEditor_RTFBox.SelectionFont IsNot Nothing Then
 
    Dim newString As String = _
      sym_TextEditor_Format_cob_Schriftart.SelectedItem.ToString
    Dim newFont As New Font(newString, CInt( _
    tsc_TextEditor_RTFBox.SelectionFont.Size + 0.5), _
    tsc_TextEditor_RTFBox.SelectionFont.Style)
 
    Debug.Print(newFont.FontFamily.ToString & " ... `" & newFont.Name & "´" & "" & _
      "/ " & newString & " - " & tsc_TextEditor_RTFBox.SelectionFont.Size & " -" & _
      "" & tsc_TextEditor_RTFBox.SelectionFont.Style)
 
    tsc_TextEditor_RTFBox.SelectionFont = newFont
End If

Dim newFont As New Font( _
  sym_TextEditor_Format_cob_Schriftart.SelectedItem.ToString, 12, _
  FontStyle.Regular)

Dim newFont As New Font("Playbill", 12, FontStyle.Regular)

If tsc_TextEditor_RTFBox.SelectionFont IsNot Nothing Then
 
    Dim cboString As FontFamily = _
      sym_TextEditor_Format_cob_Schriftart.SelectedItem
    Dim newFont As New Font(cboString.Name, CInt( _
    tsc_TextEditor_RTFBox.SelectionFont.Size + 0.5), _
    tsc_TextEditor_RTFBox.SelectionFont.Style)
    tsc_TextEditor_RTFBox.SelectionFont = newFont
End If

        tsc_TextEditor_RTFBox.SelectionFont = New Font(aktFontFamily, _
          aktFontSize, aktFontStyle)