VB 5/6-Tipp 0042: Texte oder Strings die keine Umbrüche haben drucken
von ActiveVB
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: | Verwendete API-Aufrufe: | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
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