Tipp-Upload: VB.NET 0127: Fliesstext in Zeilen aufteilen

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Drucker

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Drucken, Drucker, Printer, Fliesstext

Der Vorschlag wurde erstellt am: 11.10.2007 15:02.
Die letzte Aktualisierung erfolgte am 07.03.2008 13:19.

Zurück zur Übersicht

Beschreibung  

Dieser Tipp zeigt, wie man einen Fliesstext in Zeilen, z.B. für die Ausgabe auf dem Drucker, aufteilen kann. (Update am 07.03.2008)

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [11,47 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ---------- Anfang Projektdatei SplitLines.vbproj  ----------
' ------------------ Anfang Datei Form1.vb  ------------------
Public Class Form1

    ' einen Fliesstext (mit oder ohne CrLf) in Zeilen
    ' aufteilen unter Berücksichtigung einer Maximalbreite
    ' Einsatz z.Bsp beim Drucken von Texten

    ' Controls:
    ' Splitcontainer1: Panel1 mit Textbox1, Panel2 mit Picturebox1
    ' Button1

    Private Sub Form1_Load(ByVal sender As System.Object, _
                    ByVal e As System.EventArgs) Handles MyBase.Load

        TextBox1.Multiline = True
        TextBox1.Dock = DockStyle.Fill
        PictureBox1.Dock = DockStyle.Fill

        PictureBox1.BorderStyle = BorderStyle.Fixed3D
        SplitContainer1.SplitterDistance = Me.Width \ 3

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, _
                    ByVal e As System.EventArgs) Handles Button1.Click

        If String.IsNullOrEmpty(TextBox1.Text) Then

            Dim Msg As String = "bitte zuerst per Copy & Paste die Textbox mit einem " & _
                "Fliesstext füllen"

            MessageBox.Show(Msg)

            Exit Sub

        End If

        Dim Gr As Graphics = PictureBox1.CreateGraphics
        Dim Ft As Font = PictureBox1.Font

        Dim h As Single = 0
        Dim MaxWidth As Single = Convert.ToSingle(PictureBox1.ClientSize.Width)
        Dim TextLines As List(Of String) = SplitLines(TextBox1.Text, Gr, Ft, MaxWidth, h)

        Dim x As Single = 0
        Dim y As Single = 0

        ' zeilenweise Text ausgeben
        Gr.Clear(PictureBox1.BackColor)

        For i As Integer = 0 To TextLines.Count - 1

            Dim s As String = TextLines(i)

            Gr.DrawString(s, Ft, Brushes.Black, x, y)

            ' vertikale Druckposition anpassen
            y += h
        Next

    End Sub

    ''' <summary>
    ''' liefert eine List(Of String) als Zeilen eines Fliesstextes
    ''' </summary>
    ''' <param name="Text">der aufzuteilende Text</param>
    ''' <param name="Gr">das Grafik Object, eingestellt auf Units
    ''' wie Millimeter</param>
    ''' <param name="Ft">der anzuwendende Font</param>
    ''' <param name="MaxWidth">die Maximalbreite entsprechen den
    ''' eingestellten Units wie Millimeter</param>
    ''' <param name="LineHeight">(abzurufende) Zeilenhöhe</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function SplitLines(ByVal Text As String, _
                                   ByVal Gr As Graphics, _
                                   ByVal Ft As Font, _
                                   ByVal MaxWidth As Single, _
                                   Optional ByRef LineHeight _
                                   As Single = 0) _
                                   As List(Of String)

        If LineHeight = 0 Then
            LineHeight = Gr.MeasureString("x", Ft).Height
        End If

        Dim Layout As New System.Drawing.SizeF(MaxWidth, LineHeight)
        Dim TL As New List(Of String)

        Using SF As StringFormat = StringFormat.GenericDefault

            Do

                Dim CharactersFittet As Integer = 0
                Dim LinesFilled As Integer = 0
                Dim T As New System.Drawing.SizeF()

                ' Zeile auslösen
                T = Gr.MeasureString(Text, Ft, Layout, SF, CharactersFittet, LinesFilled)

                Dim s As String = Text.Substring(0, CharactersFittet)

                ' erzwungener Zeilenumbruch über NewLine
                If s.IndexOf(Environment.NewLine) >= 0 Then

                    ' NewLine entfernen
                    s = s.Replace(Environment.NewLine, "")

                    ' Rest oder Leerzeile übernehmen
                    TL.Add(s)
                    Text = Text.Substring(CharactersFittet)

                Else

                    Dim i As Integer = 0
                    Dim Vg As String = " -"

                    ' ein Umbruch nur über ein Plenk oder ein Bindestrich
                    If Text.Length <> CharactersFittet Then

                        For i = s.Length - 0 To 1 Step -1

                            If Vg.Contains(s.Substring(i - 1, 1)) Then

                                Exit For

                            End If

                        Next

                        ' wurde ein Worttrenner gefunden
                        If i > 0 Then
                            s = s.Substring(0, i)
                        End If
                    End If

                    TL.Add(s)
                    Text = Text.Substring(s.Length)
                End If

            Loop Until Text.Length = 0

        End Using

        Return TL

    End Function

End Class

' ------------------- Ende Datei Form1.vb  -------------------
' ----------- Ende Projektdatei SplitLines.vbproj  -----------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.