🚀 go-pugleaf

Hi CowBoy!

I recently wrote a simple VB routine to output text to the printer, which I
have already sent to someone on this Newsgroup - and here it is:

Here is a routine which I am currently working on. It will output a string
(for example a textbox text) to the printer object as a justified block and
will return the height of the printed block. You can specify the x and y
coordinates of the top left corner, the width of the block and the
justification (left, right, centre, full or force). To try it out, start a
new project and add a module to it. Place a text box and a command button on
the form. Set the MultiLine property of the text box to True. Copy the main
block of code below to the (general) (declarations) section of the module.
Then copy the small block of code to the command button Click Event. Run the
program, type a reasonably large amount of text into the text box and click
the button. In normal use in your own programs you would first open the
Printer.Object (Printer.Print), then set the desired Scalemode
(Printer.Scalemode = 5 will give you inches), then set the font name and
size etc. You would then call the PrintBlock function to print a block of
text (call it as many times as you like to print more than one block at
different positions etc) and the finally use Printer.EndDoc to finish the
print job.

Mike


' **************************************************************
' COPY THIS BLOCK TO THE MODULE (GENERAL) (DECLARATIONS)
Public Function PrintBlock(X As Single, Y As Single, text As String,
BlockWidth As Single, justify As String) As Single
' (By Mike Wiliams - Aug 1998)
' Outputs a block of left, centre, right, full or force justified text to
the printer.
' RETURN VALUES - IF CARRIED OUT OK then Height of Block is returned
'                 IF AN ERROR then a negative value (-1) is returned
PrintBlock = -1 ' start off at the error value
If BlockWidth = 0 Then GoTo parameterfault
justify = LCase(justify)
' default to "left" if the justify string is not correct
If justify <> "right" And justify <> "centre" And justify <> "force" And
justify <> "full" Then
  justify = "left"
End If
On Error GoTo pjerror
Dim pointer As Long, counter As Long
Dim nextspace As Long
Dim parafinished As Long, wordlength As Long
Dim tempword As String, space As Long
Dim maxwords As Long: maxwords = 10000
ReDim words(maxwords) As String
Dim paratext As String, extraspace As Single
Dim parapointer As Long, oldpointer As Long
Dim spacewidth As Single, wordwidth As Single, linewidth As Single
Dim linefirstword As Long, linelastword As Long, n As Long
Dim lastline As Boolean
' This first simple routine will deal with paragraphs up to
' [maxwords] words. Later, increase this to any number of
' words by temporarily stopping and outputting when the
' number of words found exceeds a certain amount, and then
' re-starting at the new position in the text. (Note: The
' routine can sort out 100 words in less than 5 milliseconds).
If text = "" Then PrintBlock = 0: Exit Function
BlockWidth = Abs(BlockWidth)
Printer.CurrentY = Y
spacewidth = Printer.TextWidth(" ")
' Find the first paragraph
parapointer = 1
moretext:
oldpointer = parapointer
parapointer = InStr(parapointer, text, Chr$(13))
If parapointer = 0 Then
  paratext = Mid$(text, oldpointer)
  GoSub paragraph
  GoTo textfinished
Else
  ' Note: although it says in the Help Files that the length
  ' specified in Mid$ must be 1 or greater, it works fine
  ' (and returns an empty string) if the length specified
  ' is zero - which it will be whenever the first byte
  ' of the tested section is chr$(13) and therefore
  ' parapointer is equal to oldpointer.
  paratext = Mid$(text, oldpointer, parapointer - oldpointer)
  GoSub paragraph
  parapointer = parapointer + 2 ' skip chr$(13) and chr$(10)
  If parapointer > Len(text) Then
    GoTo textfinished
  Else
    GoTo moretext
  End If
End If
textfinished:
PrintBlock = Printer.CurrentY - Y
' PrintBlock returns the height of the printed block (-1 if error)
Exit Function
paragraph:
pointer = 1: counter = 1: parafinished = False
If paratext = "" Then GoTo gotwords ' empty = new para
While Mid$(paratext, pointer, 1) = " "
pointer = pointer + 1
Wend
If pointer > Len(paratext) Then
  paratext = "" ' empty = new para
  GoTo gotwords
End If
' pointer now points to the first non-space character
' so find the next space AFTER that character
wordloop:
nextspace = InStr(pointer, paratext, " ")
If nextspace > 0 Then ' there is another space
  ' The word is the part before the space just found
  words(counter) = Mid$(paratext, pointer, nextspace - pointer)
Else
  ' The word is the remaining part of the paragraph
  words(counter) = Mid$(paratext, pointer)
  parafinished = True
End If
If parafinished = True Then GoTo gotwords
' now move the pointer to the next non-space character
pointer = nextspace + 1 ' bypass the space just found
While Mid$(paratext, pointer, 1) = " " ' and look for others
pointer = pointer + 1
Wend
' Temporary word limit due to size of word array
If counter >= maxwords Then GoTo gotwords
' Finished if past the end of the paragraph
If pointer > Len(paratext) Then GoTo gotwords
' Finished if the last word has been dealt with
If nextspace = 0 Then GoTo gotwords
counter = counter + 1
GoTo wordloop
gotwords:
GoSub makelines
Return
'
makelines:
lastline = False
If paratext = "" Then
  Printer.Print "" ' Move to start of new para
  GoTo endmakelines
End If
linefirstword = 1
firstwordofline:
linelastword = linefirstword: linewidth = 0
wordwidth = Printer.TextWidth(words(linelastword))
linewidth = linewidth + wordwidth
If linelastword >= counter Then
  lastline = True
  GoSub printerline
  GoTo endmakelines
End If
nextwordofline:
wordwidth = spacewidth + Printer.TextWidth(words(linelastword + 1))
If (linewidth + wordwidth) <= BlockWidth Then
  linewidth = linewidth + wordwidth
  linelastword = linelastword + 1
  If linelastword < counter Then
  GoTo nextwordofline
  Else
  lastline = True
  GoSub printerline
  GoTo endmakelines
  End If
Else
  GoSub printerline
  linefirstword = linelastword + 1
  GoTo firstwordofline
End If
endmakelines:
Return
'
printerline:
If justify = "force" Or justify = "full" Then
  Printer.CurrentX = X
  If linefirstword = linelastword Then
    Printer.Print words(linefirstword)
  Else
    extraspace = linelastword - linefirstword
    extraspace = (BlockWidth - linewidth) / extraspace
    If justify = "full" And lastline = True Then extraspace = 0
    For n = linefirstword To linelastword
    Printer.Print words(n);
    If n = (linelastword - 1) And lastline = False Then
      ' right justify the last word to prevent slightly "jagged"
      ' paragraph edges (possibly due to accumulated 300 dpi
      ' rounding errors.
      Printer.CurrentX = (X + BlockWidth) - Printer.TextWidth(words(n + 1))
    Else
      Printer.CurrentX = Printer.CurrentX + spacewidth + extraspace
    End If
    Next n
    Printer.Print
  End If
  Return
End If
If justify = "left" Then
  Printer.CurrentX = X
  For n = linefirstword To linelastword
  Printer.Print words(n);
  Printer.CurrentX = Printer.CurrentX + spacewidth
  Next n
  Printer.Print
  Return
End If
If justify = "right" Then
  Printer.CurrentX = X + (BlockWidth - linewidth)
  For n = linefirstword To linelastword
  Printer.Print words(n);
  Printer.CurrentX = Printer.CurrentX + spacewidth
  Next n
  Printer.Print
  Return
End If
If justify = "centre" Then
  Printer.CurrentX = X + (BlockWidth - linewidth) / 2
  For n = linefirstword To linelastword
  Printer.Print words(n);
  Printer.CurrentX = Printer.CurrentX + spacewidth
  Next n
  Printer.Print
  Return
End If
Return
'
pjerror:
Resume printingfault
'
printingfault:
PrintBlock = -1
On Error GoTo 0
Exit Function
parameterfault:
PrintBlock = -1
Exit Function
End Function
' **************************************************************

' **************************************************************
' COPY THIS BLOCK TO THE BUTTON CLICK EVENT
Dim BlockHeight As Single
Dim x as Single, y as Single, Wide as Single
x = 0.7 : y = 0.7 : Wide = 2.25
Printer.Print ' initialise the printer object
Printer.ScaleMode = 5 ' inches
BlockHeight = PrintBlock(x, y, Text1.text, Wide, "full")
Form1.Caption = Format$(BlockHeight)
Printer.EndDoc
' **************************************************************


cowboys wrote in message <759cjg$cpa$1@remarQ.com>...
>I've been given the following code that will print a multiline textbox to
>the printer, but for some reason, this code works, but when it comes out on
>the printer, it is as if the printer is only printing on half the page...
>It will print a line, then cut it off and then print the next line and do
>the same thing through the whole textbox.  Why???  Can someone please help
>me here!
>snip<