|
| |
Suche Visual-Basic Code| hier der Code ... fehlende Variablen sind global deklariert ... | |  | | Autor: Enidal | | Datum: 25.07.01 20:26 |
| ' 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)
'========================================================
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)
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
' Maximale Druckbreite für die Textbox
If MaxWidth = 0 Then MaxWidth = .ScaleWidth - xPos Else If MaxWidth < 0 Then MaxWidth = .ScaleWidth - xPos - Abs(MaxWidth)
' Maximale Druckhöhe
If MaxHeight = 0 Then y2 = .ScaleHeight - yPos Else If MaxHeight < 0 Then y2 = .ScaleHeight - yPos - Abs(MaxHeight) Else y2 = yPos + MaxHeight
' zunächst die "harten" Zeilenumbrüche ermitteln
Call VB5_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
.CurrentX = xPos
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
Printer.CurrentX = xPos
Printer.Print sline(I);
sline(I) = NextLine
Loop Until Trim$(sline(I)) = ""
End If
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 = ((yPos + tHeight) <= y2)
Else
' Prüfen, ob Seitenumbruch notwendig
If yPos + tHeight > y2 Then
If sUmbruch Then
.NewPage
yPos = .CurrentY
' y2 neu berechnen (verfügbarer Platz)
If MaxHeight = 0 Then y2 = .ScaleHeight - yPos Else
If MaxHeight < 0 Then y2 = .ScaleHeight - yPos - Abs(MaxHeight)
End If
Else
' kein Seitenumbruch erlaubt
CheckTextHeight = False
End If
End If
End With
End Function
Public Function VB5_Split(ByVal Expression As String, _
ByVal Delimiter As String) As Variant
Dim sPos As Long
Dim sExpr() As String
Dim nCount As Integer
nCount = -1
Do
nCount = nCount + 1
ReDim Preserve sExpr(nCount)
sPos = InStr(Expression, Delimiter)
If sPos > 0 Then
sExpr(nCount) = Left$(Expression, sPos - 1)
Expression = Mid$(Expression, sPos + Len(Delimiter))
Else
sExpr(nCount) = Expression
Expression = ""
End If
Loop Until Expression = ""
VB5_Split = sExpr
End Function | |
 | 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 |
 |
|
Neu! sevEingabe 3.0 
Einfach stark!
Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Weitere InfosTipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Access-Tools Vol.1 
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
Sie sind aktuell nicht angemeldet.
