Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0042: Texte oder Strings die keine Umbrüche haben drucken

 von 

Beschreibung 

Wer einen mehrzeiligen Text ohne Umbrüche aus einer Textbox oder einem String auf einem Drucker ausgeben möchte, steht vor dem Problem, daß der Drucker den Text in einer einzigen Zeile ausgibt und somit alles was über dem druckbaren Bereich hinausgeht, abschneidet. Man steht dann vor der Wahl die Umbrüche per Hand einzufügen oder kann den bequemen Weg über eine API nehmen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

DrawTextA (DrawText)

Download:

Download des Beispielprojektes [2,58 KB]

'Dieser Quellcode 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!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"



Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _
        (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount _
        As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Const DT_BOTTOM = &H8
Const DT_CENTER = &H1
Const DT_LEFT = &H0
Const DT_RIGHT = &H2
Const DT_TOP = &H0
Const DT_VCENTER = &H4
Const DT_WORDBREAK = &H10

Const DT_CALCRECT = &H400
Const DT_EDITCONTROL = &H2000
Const DT_NOCLIP = &H100

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Sub Drucke(Text$)
  Dim Result&
  Dim MyRect As RECT
   
    Printer.Font.Size = 10
    Printer.ScaleMode = vbPixels
    
    'Achtung! Die Angaben müssen in Pixeln gemacht werden!
    MyRect.Left = 0
    MyRect.Top = 0
    MyRect.Right = Printer.ScaleWidth
    MyRect.Bottom = Printer.ScaleHeight

    Printer.Print ""
    Result = DrawText(Printer.hdc, Text, Len(Text), MyRect, DT_LEFT _
                      Or DT_WORDBREAK)
    Printer.EndDoc
End Sub

Private Sub Command1_Click()
  Call Drucke(Text1.Text)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Timo am 09.05.2005 um 17:00

Super Tipp!

Danke

Kommentar von xdsmp am 27.03.2003 um 11:45

hi, hab den code etwas geändert, jetzt druckt die funktion auch mehrere Seiten (1100 Zeichen pro Seite)

Public Sub Drucke(Text$)
On Error Resume Next
Dim Result&
Dim MyRect As RECT


Dim i As Long
Dim zeichenProSeite As Long
Dim seiten As Double
Dim rounder As Long
Const MaxZeichen = 1100


' WIE VIELE SEITEN HAB ICH
seiten = Len(Text) / (MaxZeichen)
rounder = Len(Text) / (MaxZeichen)
If rounder < seiten Then: seiten = seiten + 1
seiten = Round(seiten, 0)
ReDim seitex(0 To seiten) As String

' SUCHE NACH ZEILEN UMBRÜCHEN
Dim zeichen As String * 2
Dim aktuelleSeite As Long
aktuelleSeite = 0
For i = 1 To Len(Text)
zeichenProSeite = zeichenProSeite + 1
zeichen = Mid(Text, i, 2)
If zeichen = vbCrLf Then
If (zeichenProSeite >= MaxZeichen) Then ' Zerlege ne Seite
aktuelleSeite = aktuelleSeite + 1
If aktuelleSeite > UBound(seitex) Then
ReDim Preserve seitex(1 To aktuelleSeite)
End If
seitex(aktuelleSeite) = Mid(Text, Len(seitex(aktuelleSeite - 1)) + 1, zeichenProSeite)
zeichenProSeite = 0
End If
End If
Next i
If zeichenProSeite > 0 Then
aktuelleSeite = aktuelleSeite + 1
If aktuelleSeite > UBound(seitex) Then
ReDim Preserve seitex(1 To aktuelleSeite)
End If
seitex(aktuelleSeite) = Mid(Text, Len(seitex(aktuelleSeite - 1)) + 1, zeichenProSeite)
End If

Printer.Font.Size = 10
Printer.ScaleMode = vbPixels

MyRect.Left = 0
MyRect.Top = 0
MyRect.Right = Printer.ScaleWidth
MyRect.Bottom = Printer.ScaleHeight

Printer.Print ""
For i = 1 To UBound(seitex)
Text = seitex(i)
Result = DrawText(Printer.hdc, Text, Len(Text), MyRect, DT_LEFT _
Or DT_WORDBREAK)
Printer.NewPage
Next i
Printer.EndDoc
End Sub

Kommentar von Mirko am 14.02.2002 um 19:15

Der Tipp ist echt klasse, funktioniert auch bei Forms (nutzbar z.B. bei Usercontrols als Caption). Echt Klasse.
Mirko