Rubrik: Drucker | VB-Versionen: VB6 | 18.06.01 |
Drucken mit autom. Wort- und Zeilenumbruch Längere Textpassagen ausdrucken unter Berücksichtigung von Wort- und Zeilenumbrüchen. | ||
Autor: Dieter Otter | Bewertung: | Views: 34.703 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | 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