| |

Visual-Basic Einsteigerdruckt nur eine seite | |  | Autor: steph | Datum: 26.06.02 00:10 |
| hab den unten folgenden quelltext zum drucken hier im forum bekommen,
funzt auch super, bis auf eins:
es wird immer nur eine seite ausgedruckt!
woran kann das liegen??
-------------------------------------------------------------------------------------
hier der quelltext
-------------------------------------------------------------------------------------
' 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
' 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
Private Sub Command1_Click()
Dim sText As String
With Printer
.ScaleMode = 6 ' Maßeinheit mm
.Font.Name = "Arial"
.Font.Size = 12
PrintMultilineText Text1.Text, 20, 20, -20
.EndDoc
End With
End Sub |  |
 | Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
  |
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats Oktober 2025 Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Neu! sevDTA 3.0 Pro 
SEPA mit Kontonummernprüfung
Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. Weitere Infos
|