Blocksatz für Grafikausgabe und Druck Mit diesem kurzen Codesnippsel ist es möglich einen langen Text, auch mit Zeilenwechsel als Blocksatz in einer vorgegebenen Breite in einem Label auszugeben.
Autor:   Rainer Henke	Bewertung:	Views:  116
ohne Homepage	System:  Win7, Win8, Win10, Win11	kein Beispielprojekt

Mit diesem kurzen Codesnippsel ist es möglich einen langen Text, auch mit Zeilenwechsel als Blocksatz in einer vorgegebenen Breite in einem Label auszugeben. Auch das Drucken als Blocksatz ist möglich.

• Erstellt eine Form und plaziert einen Button darauf - nennt ihn "Button_Blocksatz".
• Erstellt dann ein Label, das den Beispieltext anzeigt. Name: "Label_Text", Autosize = False - Schriftgröße 10pt. - Labelgröße entsprechend aufziehen.
• Erstellt dann noch ein Label, das den Blocksatz anzeigt (Größe z.B. 300x320 Pixel) mit dem Namen "Label_Blocksatz", Autosize = False - Schriftgröße 10pt
   
• Deklariert dann eine Variable die den auszugebenden Text enthält.
• Ebenso wird ein PrintDokument erstellt.

Option Strict On
 
Imports System.Drawing.Printing
 
Public Class Form1
  Private Labeltext As String = String.Empty
  Private WithEvents PrintDoc As New PrintDocument
 

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  Dim oText As String
 
  oText = "Nach dem Tode eines Müllers fällt an den ältesten Sohn die Mühle, " & 
    "an den zweiten ein Esel und an den dritten ein Kater, der scheinbar bloß " & 
    "dazu taugt, sich aus dessen Fell Handschuhe zu machen. " &
    "Der Kater stellt jedoch Hilfe in Aussicht, wenn sein neuer Besitzer ihm " & 
    "stattdessen ein Paar Stiefel machen lasse, so dass er sich unter den Leuten " & 
    "sehen lassen könne. So geschieht es. Der Kater fängt nun in einem Sack " &
    "Rebhühner, überlässt sie dem König des Landes als ein Geschenk seines Herrn, " &
    "des Grafen, und wird dafür mit Gold belohnt. Später lässt der Kater den " & 
    "angeblichen Grafen splinternackend in einem See baden, den der König mit " & 
    "seiner Tochter auf einer Ausfahrt passiert, und klagt, ein Dieb habe seinem " & 
    "Herrn die Kleider gestohlen. Der König lässt von seinen eigenen Kleidern " & 
    "holen und den vermeintlichen Grafen einkleiden und in der Kutsche mitfahren. " & 
    "Der Kater eilt voraus und bringt Arbeiter in Feld und Wald dazu, dem später " & 
    "vorbeifahrenden König auf dessen Frage zu antworten, die Ländereien " &
    "gehörten dem Grafen. Deren wahren Besitzer, einen mächtigen Zauberer, " & 
    "verleitet der Kater dazu, seine Macht zu demonstrieren, dass er sich gar " & 
    "in ein Mäuslein verwandeln könne; um ihn darauf aufzufressen und dessen " & 
    "Schloss für den Müllersohn in Besitz zu nehmen. Da ward die Prinzessin mit " & 
    "dem Grafen versprochen, und als der König starb, ward er König, der " & 
    "gestiefelte Kater aber erster Minister."
 
  Labeltext = oText
  Label_Text.Text = oText
 
  PrintDoc.DocumentName = "Blocksatz"
  AddHandler PrintDoc.PrintPage, AddressOf Drucken_PrintPage
End Sub

Private Sub Button_Blocksatz_Click(sender As Object, e As EventArgs) Handles Button_Blocksatz.Click
  ' Nach Zeilenumbrüchen splitten
  Dim oZeilen As String() = Labeltext.Split(CChar(vbCrLf))
  Dim oText As String()
  Dim X As Integer = 0
  Dim Y As Integer = 0
 
  ' Die Breite des Textes jeder Zeile in Pixel
  Dim oZeilenbreite As Double
 
  ' Auf was für eine Breite soll die Ausgabe erfolgen
  Dim Ausgabenbreite As Integer = Label_Blocksatz.Width - 3
  Dim Ausgabeformat As New Size(Integer.MaxValue, Integer.MaxValue)
 
  ' Differenz zwischen Zeilenbreite und Ausgabenbreite
  Dim Differenz As Double
 
  ' vor dem letzten Wort jeder Zeile den Abstand ausgleichen
  Dim Korrektur As Integer
  Dim Zwischenraumbreite As Integer
 
  ' ohne seitliche Abstände ausgeben
  Dim oFlags As TextFormatFlags = TextFormatFlags.NoPadding
 
  Dim oZeilenabstand As Integer = Label_Blocksatz.Font.Height
  Dim Farbe_Front As Color = Color.Black
  Dim Farbe_Back As Color = Label_Blocksatz.BackColor
 
  Labeltext = String.Empty
 
  ' Ausgabe erfolgt hier hin (Label_Blocksatz)
  Using G As Graphics = Label_Blocksatz.CreateGraphics()
    G.FillRectangle(New SolidBrush(Label_Blocksatz.BackColor), 0, 0, _
      Label_Blocksatz.Size.Width, Label_Blocksatz.Size.Height)
 
    For c As Integer = 0 To oZeilen.Count - 1
      oZeilen(c) = oZeilen(c).Replace(vbLf, "") ' LF entfernen
 
      If TextRenderer.MeasureText(G, oZeilen(c) & " ", Label_Blocksatz.Font, _
        Ausgabeformat, oFlags).Width > Ausgabenbreite Then
 
        oText = oZeilen(c).Split(CChar(" "))
 
        For a As Integer = 0 To oText.Length - 1
          oZeilenbreite += TextRenderer.MeasureText(G, oText(a) & " ", _
            Label_Blocksatz.Font, Ausgabeformat, oFlags).Width
 
          ' sind die Worte kleiner oder gleich der Ausgabenbreite?
          If oZeilenbreite <= Ausgabenbreite Then
            Labeltext &= oText(a) & " "
          Else
            ' letztes Leerzeichen jeder Zeile entfernen 
            Dim oZeile As String() = RTrim(Labeltext).Split(CChar(" "))
            Differenz = Ausgabenbreite - TextRenderer.MeasureText(G, RTrim(Labeltext), _
              Label_Blocksatz.Font, Ausgabeformat, oFlags).Width
 
            If oZeile.Length - 1 > 0 Then
              ' Differenzbreite auf die Wortanzahl aufteilen
              Zwischenraumbreite = CInt(Differenz / (oZeile.Length - 1))
            Else
              Zwischenraumbreite = 0
            End If
 
            Korrektur = CInt(Differenz - ((oZeile.Length - 1) * Zwischenraumbreite))
 
            Dim oStep As Integer = 0
 
            For b As Integer = 0 To oZeile.Length - 1
              If Korrektur < 0 AndAlso oStep > Korrektur Then
                oStep -= 1
                TextRenderer.DrawText(G, oZeile(b), Label_Blocksatz.Font, New Point(X, Y), _
                  Farbe_Front, Farbe_Back, oFlags)
                X += TextRenderer.MeasureText(G, oZeile(b) & " ", Label_Blocksatz.Font, _
                  Ausgabeformat, oFlags).Width + Zwischenraumbreite - 1
              ElseIf Korrektur > 0 AndAlso oStep < Korrektur Then
                oStep += 1
                TextRenderer.DrawText(G, oZeile(b), Label_Blocksatz.Font, New Point(X, Y), _
                  Farbe_Front, Farbe_Back, oFlags)
                X += TextRenderer.MeasureText(G, oZeile(b) & " ", Label_Blocksatz.Font, _
                  Ausgabeformat, oFlags).Width + Zwischenraumbreite + 1
              ElseIf oStep = Korrektur Then
                TextRenderer.DrawText(G, oZeile(b), Label_Blocksatz.Font, New Point(X, Y), _
                  Farbe_Front, Farbe_Back, oFlags)
                X += TextRenderer.MeasureText(G, oZeile(b) & " ", Label_Blocksatz.Font, _
                  Ausgabeformat, oFlags).Width + Zwischenraumbreite
              End If
            Next
 
            X = 0
            Y += oZeilenabstand
            Labeltext = oText(a) & " "
            oZeilenbreite = TextRenderer.MeasureText(G, oText(a) & " ", Label_Blocksatz.Font, _
              Ausgabeformat, oFlags).Width
          End If
        Next
 
        ' die letzten Wörter.
        TextRenderer.DrawText(G, Labeltext, Label_Blocksatz.Font, New Point(0, Y), _
          Farbe_Front, Farbe_Back, oFlags)     
        Labeltext = String.Empty
        oZeilenbreite = 0
      Else
        ' alles paßt in eine Zeile
        TextRenderer.DrawText(G, oZeilen(c), Label_Blocksatz.Font, New Point(0, Y), _
          Farbe_Front, Farbe_Back, oFlags)
      End If
      Y += oZeilenabstand
    Next
  End Using
 
  ' --------------------------------------------------------------------------------------
 
  ' Soll eine Druckvorschau erstellt werden:...
 
  Using oVorschau As New PrintPreviewDialog
    With oVorschau
      .Document = PrintDoc
      .WindowState = FormWindowState.Normal
      .Size = New Size(800, 1000)
      .Location = New Point(20, 20)
      .ShowDialog(Me)
    End With
  End Using
 
End Sub

Private Sub Drucken_PrintPage(sender As Object, e As PrintPageEventArgs)
  ' Druckt den Text aus "Labeltext" als Blocksatz in der Breite von "Ausgabenbreite" aus.
 
  Labeltext = Label_Text.Text
 
  ' Nach Zeilenumbrüchen splitten
  Dim oZeilen As String() = Labeltext.Split(CChar(vbCrLf))
  Dim oText As String()
  Dim Druckpos_X As Integer = 100
  Dim Druckpos_Y As Integer = 100
  Dim X As Integer = Druckpos_X
  Dim Y As Integer = Druckpos_Y
 
  ' Die Breite des Textes jeder Zeile in Pixel
  Dim oZeilenbreite As Double
 
  ' Auf was für eine Breite soll die Ausgabe erfolgen
  Dim Ausgabenbreite As Integer = Label_Blocksatz.Width
  Dim Ausgabeformat As New Size(Integer.MaxValue, Integer.MaxValue)
 
  ' Differenz zwischen Zeilenbreite und Ausgabenbreite
  Dim Differenz As Double
 
  ' vor dem letzten Wort jeder Zeile den Abstand ausgleichen
  Dim Korrektur As Integer
  Dim Zwischenraumbreite As Integer
 
  ' ohne seitliche Abstände ausgeben
  Dim oFlags As TextFormatFlags = TextFormatFlags.NoPadding
  Dim oStep As Integer
 
  Dim oZeilenabstand As Integer = Label_Blocksatz.Font.Height
  Dim Farbe_Front As Color = Color.Black
  Dim Farbe_Back As Color = Label_Blocksatz.BackColor
 
  Labeltext = String.Empty
  ' Ausgabe erfolgt hier hin (Label_Blocksatz)
  Using G As Graphics = Label_Blocksatz.CreateGraphics()
    G.FillRectangle(New SolidBrush(Label_Blocksatz.BackColor), 0, 0, _
     Label_Blocksatz.Size.Width, Label_Blocksatz.Size.Height)
 
    For c As Integer = 0 To oZeilen.Count - 1
      ' LF entfernen
      oZeilen(c) = oZeilen(c).Replace(vbLf, "")
 
      If TextRenderer.MeasureText(G, oZeilen(c) & " ", Label_Blocksatz.Font, _
        Ausgabeformat, oFlags).Width > Ausgabenbreite Then
 
        oText = oZeilen(c).Split(CChar(" "))
 
        For a As Integer = 0 To oText.Length - 1
          ' 1.5 gibt beim Drucken bei kleineren schriften unter 10 Punkt ein besseres Bild
          oZeilenbreite += TextRenderer.MeasureText(G, oText(a) & " ", Label_Blocksatz.Font, _
            Ausgabeformat, oFlags).Width + 1.5
 
          ' sind die Worte kleiner oder gleich der Ausgabenbreite?
          If oZeilenbreite <= Ausgabenbreite Then
            Labeltext &= oText(a) & " "
          Else
            ' letztes Leerzeichen jeder Zeile entfernen 
            Dim oZeile As String() = RTrim(Labeltext).Split(CChar(" "))
            Differenz = Ausgabenbreite - TextRenderer.MeasureText(G, RTrim(Labeltext), _
              Label_Blocksatz.Font, Ausgabeformat, oFlags).Width
 
            If oZeile.Length - 1 > 0 Then
              ' Differenzbreite auf die Wortanzahl aufteilen
              Zwischenraumbreite = CInt(Differenz / (oZeile.Count - 1))
            Else
              Zwischenraumbreite = 0
            End If
 
            Korrektur = CInt(Differenz - ((oZeile.Count - 1) * Zwischenraumbreite))
 
            oStep = 0
            For b As Integer = 0 To oZeile.Length - 1
              If Korrektur < 0 AndAlso oStep > Korrektur Then
                oStep -= 1
                e.Graphics.DrawString(oZeile(b), Label_Blocksatz.Font, Brushes.Black, X, Y)
                X += TextRenderer.MeasureText(G, oZeile(b) & " ", Label_Blocksatz.Font, _
                  Ausgabeformat, oFlags).Width + Zwischenraumbreite - 1
              ElseIf Korrektur > 0 AndAlso oStep < Korrektur Then
                oStep += 1
                e.Graphics.DrawString(oZeile(b), Label_Blocksatz.Font, Brushes.Black, X, Y)
                X += TextRenderer.MeasureText(G, oZeile(b) & " ", Label_Blocksatz.Font, _
                  Ausgabeformat, oFlags).Width + Zwischenraumbreite + 1
              ElseIf oStep = Korrektur Then
                e.Graphics.DrawString(oZeile(b), Label_Blocksatz.Font, Brushes.Black, X, Y)
                X += TextRenderer.MeasureText(G, oZeile(b) & " ", Label_Blocksatz.Font, _
                  Ausgabeformat, oFlags).Width + Zwischenraumbreite
              End If
            Next
 
            X = Druckpos_X
            Y += oZeilenabstand
            Labeltext = oText(a) & " "
            oZeilenbreite = TextRenderer.MeasureText(G, Labeltext, Label_Blocksatz.Font, _
              Ausgabeformat, oFlags).Width
 
          End If
        Next
 
        ' die letzte Zeile
        e.Graphics.DrawString(Labeltext, Label_Blocksatz.Font, Brushes.Black, X, Y)
        Labeltext = String.Empty
        oZeilenbreite = 0
      Else
        e.Graphics.DrawString(oZeilen(c), Label_Blocksatz.Font, Brushes.Black, X, Y)
      End If
      Y += oZeilenabstand
    Next
  End Using
End Sub

End Class

Copyright ©2000-2025 vb@rchiv Dieter OtterAlle 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.