vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
TOP-Angebot: 17 bzw. 24 Entwickler-Vollversionen zum unschlagbaren Preis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Drucker   |   VB-Versionen: VB618.06.01
Drucken mit autom. Wort- und Zeilenumbruch

Längere Textpassagen ausdrucken unter Berücksichtigung von Wort- und Zeilenumbrüchen.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  31.717 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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

Dieser Tipp wurde bereits 31.717 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (2 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

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.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel