Function PrintWrapped(ByVal strInput As String, Optional bPageBreak As Boolean = False, Optional bBreakWords As Boolean = False) As Integer
' strInput - The string to be printed
' bPageBreak - Set this to true for the
' code to check for end of page,
'and wrap to a new page.
' bBreakWords - Set this to True if you
' do not want to break the line
'at a space if possible (i.e. if you don
't care if it
'breaks words into two pieces)
'
' RETURNS: Number of lines printed. Allo
' ws you to track to end of page
Dim lPointer As Long
Dim lPosition As Long
Dim lPtrWidth As Long
Dim lInputWidth As Long
Dim iLineCount As Integer
Dim strWork As String
lPtrWidth = Printer.ScaleWidth ' Only check this once
lInputWidth = Printer.TextWidth(strInput)
Do While lInputWidth > lPtrWidth
' Estimate breakpoint
lPosition = Int((lPtrWidth / lInputWidth) * Len(strInput))
strWork = Left$(strInput, lPosition)
' Find max that can print on a line
' First, if you have text that is shorte
' r than the max possible, then
' add additional characters to the work
' string
Do While Printer.TextWidth(strWork) < lPtrWidth
If Len(strWork) = Len(strInput) Then Exit Do
strWork = Left$(strInput, Len(strWork) + 2)
Loop
' Now trim characters off the work strin
' g until it is shorter than
' the printer width
Do While Printer.TextWidth(strWork) > lPtrWidth
strWork = Left$(strWork, Len(strWork) - 1)
Loop
' If you are breaking at spaces, then...
'
If Not bBreakWords Then
lPointer = Len(strWork)
' ************ VB3 - VB5 Code **********
' *****
' If using VB6, then uncomment the line
' of code
' containing th InStrRev function, and c
' omment
' out this code.
' **************************************
' *****
lPosition = lPointer
' Hunt for a space in the string
Do Until lPosition = 1
If Mid(strWork, lPosition, 1) = " " Then Exit Do
lPosition = lPosition - 1
Loop
' ************* VB6 Code **************
' This line replaces the above block for
' VB6 ONLY
' *************************************
'lPosition = InStrRev(strWork, " ", lPoi
' nter)
' ************* End Optional Code
' If there is no space before the first
' character, then we will
' be breaking within a word
If lPosition > 1 Then ' Found a space
strWork = Left(strWork, lPosition - 1)
If lPosition < Len(strInput) Then
strInput = Mid(strInput, lPosition + 1)
Else
strInput = ""
End If
Else ' Must break In word
strInput = Mid(strInput, lPointer + 1)
End If
Else
If Len(strInput) > lPointer Then
strInput = Mid(strInput, lPointer + 1)
Else
strInput = ""
End If
End If
Printer.Print strWork
iLineCount = iLineCount + 1
lInputWidth = Printer.TextWidth(strInput)
' Page break if requested
If bPageBreak Then
If Printer.CurrentY > (Printer.ScaleHeight - Printer.TextHeight(strWork)) Then
Printer.NewPage
End If
End If
Loop
If Len(strInput) > 0 Then
Printer.Print strInput
iLineCount = iLineCount + 1
End If
PrintWrapped = iLineCount
End Function
Private Sub Command1_Click()
Call PrintWrapped(True, False)
End Sub