Drucken mit autom. Wort- und Zeilenumbruch Längere Textpassagen ausdrucken unter Berücksichtigung von Wort- und Zeilenumbrüchen.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  35.144
https://www.tools4vb.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 86 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Wie man eine Textzeile auf den Drucker ausgibt, weiss wohl jeder: Printer.Print strText. Was aber, wenn der Text länger ist und somit nicht in eine einzelne Zeile passt? Wäre doch schön, wenn der Text entsprechend umgebrochen werden würde - und zwar nicht mitten im Wort, sondern nach dem letzten Wort, welches noch in die Zeile gepasst hat. Die umgebrochene Textzeile sollte dann natürlich nicht ganz links beginnen, sondern genau unter der x-Position der ersten Zeile.

Eine weitere Steigerung wäre dann noch, daß man den Bereich völlig frei festlegen kann - quasi eine Art Rechteck angibt, in welches der Text ausgedruckt werden soll - unter Berücksichtigung der entsprechenden Wort- und Zeilenumbrüche.

NEU! Update
Und zum Abschluss soll es auch noch möglich sein, die Ausrichtung anzugeben: linksbündig, rechtsbündig oder zentriert!

Hierfür gibt es leider keine Standard-VB Funktion. Also stricken wir uns selbst eine univereselle Text-Ausdrucks-Routine. Und wir stellen ziemlich hohe Ansprüche. Nachfolgend, was die Druckroutine alles können soll.

• automatischer Wort- und Zeilenumbruch
• optionale Angabe, ob ggf. Seitenumbruch erfolgen soll
• optionale Angabe eines freien linken Randes
• optionale Angabe der vertikalen Druckposition (y-Pos)
• optionale Angabe eines freien rechten und unteren Randes
• optionale Angabe eines Rechtecks, in welchem der Ausdruck erfolgen soll (ist der Text größer als die Dimension des Rechteckes, soll der Text abgeschnitten werden)
• optionale Angabe der Textausrichtung (linksbündig, rechtsbündig, zentriert)

Hauptroutine

' Text drucken mit automatischem Wortumbruch
' 
' sText     : Text, der gedruckt werden soll
'             (kann auch harte Zeilenumbrüche enthalten)
' 
' xPos, yPos: Beginn Druckposition
'             (0, wenn an der Ausdruck an der aktuellen
'             Position beginnen soll)
' 
' MaxWidth  : Maximale Breite einer Zeile
'             0, für maximale Papierbreite abzgl. xPos
'           < 0, für die Angabe eines rechten Randes
' 
' MaxHeight : Maximale Höhe des gesamten Textausdrucks
'             (passt der Text nicht vollständig in den
'             angegebenen Bereich, wird er abgeschnitten)
'             0, für das Drucken des gesamten Textes
'           < 0, für die Angabe eines unteren Randes
' 
' sUmbruch  : True, wenn Seitenumbruch erlaubt
'             False, kein Seitenumbruch (Text wird
'             dann u.U. nicht vollständig ausgedruckt)
' 
' tAlign    : 0 = linksbündig (Standard)
'             1 = rechtsbündig
'             2 = zentriert
' ========================================================
Public Sub PrintMultilineText(ByVal sText As String, _
  Optional ByVal xPos As Long = 0, _
  Optional ByVal yPos As Long = 0, _
  Optional ByVal MaxWidth As Long = 0, _
  Optional ByVal MaxHeight As Long = 0, _
  Optional ByVal sUmbruch As Boolean = False, _
  Optional ByVal tAlign As Integer = 0)
 
  Dim sLine() As String
  Dim I As Integer
  Dim NextLine As String
  Dim y2 As Long
 
  With Printer
    ' Wenn xPos, yPos = 0, aktuelle Position ermitteln
    If xPos = 0 Then xPos = .CurrentX
    If yPos = 0 Then 
      yPos = .CurrentY
    Else
      .CurrentY = yPos
    End If
 
    ' Maximale Druckbreite für die Textbox
    If MaxWidth = 0 Then
      MaxWidth = .ScaleWidth - xPos
    ElseIf MaxWidth < 0 Then
      MaxWidth = .ScaleWidth - xPos - Abs(MaxWidth)
    End If
 
    ' Maximale Druckhöhe
    If MaxHeight = 0 Then
      y2 = .ScaleHeight - yPos
    ElseIf MaxHeight < 0 Then
      y2 = .ScaleHeight - yPos - Abs(MaxHeight)
    Else
      y2 = yPos + MaxHeight
    End If
 
    ' zunächst die "harten" Zeilenumbrüche ermitteln
    sLine = Split(sText, vbCrLf)
    For I = 0 To UBound(sLine)
      If .TextWidth(sLine(I)) <= MaxWidth Then
        ' Zeile hat keine "Überbreite"
 
        ' wenn nicht mehr ins Rechteck (maxHeight)
        ' passt, Prozedur verlassen
        If Not CheckTextHeight(sLine(I), .CurrentY, _
          y2, MaxHeight, sUmbruch) Then Exit For
 
        ' Ausrichtung
        Select Case tAlign
          Case 1
            ' rechtsbündig
            .CurrentX = xPos + MaxWidth - .TextWidth(sLine(I))
          Case 2
            ' zentriert
            .CurrentX = xPos + (MaxWidth - .TextWidth(sLine(I))) / 2
          Case Else
            ' linksbündig
            .CurrentX = xPos
        End Select
 
        Printer.Print sLine(I)
      Else
        ' Zeile umbrechen
        Do
          NextLine = ""
          While .TextWidth(sLine(I)) > MaxWidth
            NextLine = Right$(sLine(I), 1) + NextLine
            sLine(I) = Left$(sLine(I), Len(sLine(I)) - 1)
          Wend
 
          ' Wortumbruch prüfen
          CheckUmbruch NextLine, sLine(I)
 
          ' wenn nicht mehr ins Rechteck (maxHeight)
          ' passt, Prozedur verlassen
          If Not CheckTextHeight(sLine(I), .CurrentY, _
            y2, MaxHeight, sUmbruch) Then Exit Sub
 
          ' Ausrichtung
          Select Case tAlign
            Case 1
              ' rechtsbündig
              .CurrentX = xPos + MaxWidth - .TextWidth(sLine(I))
            Case 2
              ' zentriert
              .CurrentX = xPos + (MaxWidth - .TextWidth(sLine(I))) / 2
            Case Else
              ' linksbündig
              .CurrentX = xPos
          End Select
 
          Printer.Print sLine(I)
          sLine(I) = NextLine
        Loop Until Trim$(sLine(I)) = ""
      End If
    Next I
  End With
End Sub

Hilfsroutinen

' korrekten Wortumbruch beachten
Private Sub CheckUmbruch(NextLine As String, Text As String)
  Const Check = " .,;:-_!?(/+"
 
  If NextLine <> "" Then
    If InStr(Check, Left$(NextLine, 1)) = 0 Then
      While InStr(Check, Right$(Text, 1)) = 0 And _
        Len(Text) > 0
        NextLine = Right$(Text, 1) + NextLine
        Text = Left$(Text, Len(Text) - 1)
      Wend
    End If
  End If
End Sub
 
' Prüfen, ob Ausdruck innerhalb des Rechtecks
' erfolgt, bzw. falls eingestellt, Seitenumbruch erzwingen
Private Function CheckTextHeight(ByVal sText As String, _
  yPos As Long, y2 As Long, _
  ByVal MaxHeight As Long, _
  ByVal sUmbruch As Boolean) As Boolean
 
  Dim tHeight As Long
 
  CheckTextHeight = True
 
  ' Zeilenhöhe
  With Printer
    tHeight = .TextHeight(sText)
    If MaxHeight > 0 Then
      ' vorgegebenenes Rechteck
      CheckTextHeight = (tHeight <= y2)
    Else
      ' Prüfen, ob Seitenumbruch notwendig
      If tHeight > y2 Then
        If sUmbruch Then
          .NewPage
          yPos = .CurrentY
 
          ' y2 neu berechnen (verfügbarer Platz)
          If MaxHeight = 0 Then
            y2 = .ScaleHeight - yPos
          ElseIf MaxHeight < 0 Then
            y2 = .ScaleHeight - yPos - Abs(MaxHeight)
          End If
        Else
          ' kein Seitenumbruch erlaubt
          CheckTextHeight = False
        End If
      End If
    End If
 
    If CheckTextHeight Then y2 = y2 - tHeight
  End With
End Function

Beispiele
Nachfolgend ein paar Beispiele, welche die Möglichkeiten unserer Ausdrucks-Routine zeigen.

Dim sText As String
sText = "Beispiel für den Ausdruck von " & _
  "längeren Textpassagen unter Berücksichtigung" & _
  "von Wort- und Zeilenumbrüchen" & vbCrLf & vbCrLf & _
  "Wie man eine Textzeile auf den Drucker ausgibt, " & _
  "weiss wohl jeder: Printer.Print strText. Was " & _
  "aber, wenn der Text länger ist und somit nicht " & _
  "in eine einzelne Zeile passt? Wäre doch schön, " & _
  "wenn der Text entsprechend umgebrochen werden " & _
  "würde - und zwar nicht mitten im Wort, sondern " & _
  "nach dem letzten Wort, welches noch in die " & _
  "Zeile gepasst hat. Die umgebrochene Textzeile " & _
  "sollte dann natürlich nicht ganz links " & _
  "beginnen, sondern genau unter der x-Position " & _
  "der ersten Zeile."
 
With Printer
  .ScaleMode = 6  ' Maßeinheit mm
 
  ' Schriftart und Schriftgrösse
  .Font.Name = "Arial"
  .Font.Size = 14
 
  ' Ausdruck an Position x=20, y=20 unter Einhaltung
  ' eines freien rechten Randes von 20mm
  PrintMultiLineText sText, 20, 20, -20
 
  ' Ausdruck im Rechteck: RECHTSBÜNDIG!
  ' x1=70, y1=aktuelle Position,
  ' Breite=100, Höhe=40
  .Font.Size = 10
  PrintMultilineText sText, 70, , 100, 40, , 1
 
  ' Ausdruck zentriert über die gesamte Seitenbreite
  .Font.Size = 11
  PrintMultilineText sText, 20, , -20, , , 2
 
  ' Ausdruck an Position x=100, y=195,
  ' rechter Rand=15mm, untere Rand=10mm,
  ' Seitenumbruch erlaubt
  ' Hinweis: Es erfolgt auch ein Seitenumbruch!
  .Font.Size = 12
  PrintMultiLineText sText, 100, 195, -15, -10, True
 
  .EndDoc
End With