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.
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 Dieser Tipp wurde bereits 109 mal aufgerufen.
Anzeige
![]() ![]() ![]() Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
Neu! sevEingabe 3.0 ![]() Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Tipp des Monats Access-Tools Vol.1 ![]() Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |