Thread View: comp.lang.basic.visual
2 messages
2 total messages
Started by cowboys
Wed, 16 Dec 1998 00:00
printing a multiline textbox
Author: cowboys
Date: Wed, 16 Dec 1998 00:00
Date: Wed, 16 Dec 1998 00:00
224 lines
5400 bytes
5400 bytes
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!
Please respond to either shankscomp@geocities.com or farmer@iastate.edu
Thanks
______________________________________________________________________
Private Declare Function SendMessageAsLong Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageAsString Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long
Dim Buffer As String
Dim resizing As Integer
Const EM_GETLINE = 196
Const EM_GETLINECOUNT = 186
Private Function fGetLine$(LineNumber As Long)
' This function fills the buffer with a line of text
' specified by LineNumber from the text-box control.
' The first line starts at zero.
Dim MAX_CHAR_PER_LINE As Integer
MAX_CHAR_PER_LINE = Form1.Text1.Width
Dim byteLo%
byteLo% = MAX_CHAR_PER_LINE And (255) '[changed 5/15/92]
Dim byteHi%
byteHi% = Int(MAX_CHAR_PER_LINE / 256) '[changed 5/15/92]
Buffer$ = Chr$(byteLo%) + Chr$(byteHi%) + Space$(MAX_CHAR_PER_LINE - 2)
' [Above line changed 5/15/92 to correct problem.]
Dim x
x = SendMessageAsString(Form1.Text1.hWnd, EM_GETLINE, LineNumber,
Buffer$)
fGetLine$ = Left$(Buffer$, x)
End Function
Private Function fGetLineCount&()
' This function will return the number of lines
' currently in the text-box control.
' Setfocus method illegal while in resize event,
' so use global flag to see if called from there
' (or use setfocus before this function call in general case).
Dim lcount
lcount = SendMessageAsLong(Form1.Text1.hWnd, EM_GETLINECOUNT, 0, 0)
fGetLineCount& = lcount
End Function
Private Sub Command1_Click()
On Error Resume Next 'HELPS US MOVE ON WHEN ERR OCCURS SETTING FONT
Dim c As Control
Dim f As Form
Set f = Form1
Set c = f.Text1
'HIDE THE FORM SO NO ONE SEES THE TEXTBOX SIZE CHANGES
f.Hide
'HOLD THE PREVIOUS FONT AND SWITCH TO NEW FONT
'THIS WILL SIMULATE THE PRINT CONTEXT USING THE SCREEN INSTEAD
c.Width = 10200 'THIS VALUE WAS DETERMINED BY TRIAL AND ERROR
Dim hold_width
hold_width = c.Width
Dim hold_font
hold_font = c.FontName
Dim hold_size
hold_size = c.FontSize
c.FontName = "Arial"
c.FontSize = 11
Dim char_points
char_points = c.FontSize
'GRAB EACH LINE AND SPOOL IT TO A TEXT FILE
Open "C:\spool.prn" For Output As #1
Dim n&
For n& = 1 To fGetLineCount&()
Buffer = fGetLine(n& - 1)
Print #1, Buffer
Next
Close #1
'SET WINDOW AND TEXTBOX BACK TO NORMAL AGAIN
c.FontName = hold_font
c.FontSize = hold_size
c.Width = hold_width
f.Show
'NEED DOEVENTS TO SHOW WINDOW AGAIN
DoEvents
'SETUP THE PRINT HEADER
Printer.Orientation = vbPRORPortrait
Printer.ScaleMode = 5
Printer.Height = 10.5
Printer.Width = 8
Printer.FontName = "Times New Roman"
Printer.FontSize = 12
Printer.Print
Printer.FontSize = 14
Printer.FontBold = True
Printer.FontItalic = True
Printer.Print UCase(Form1.Caption) 'THIS WILL PRINT FORM CAPTION AS
HEADER
'SETUP THE PRINT BODY
Printer.FontName = "Arial"
If Err Then Printer.FontName = "Univers Condensed"
If Err Then Printer.FontName = "Century Schoolbook"
Printer.FontBold = False
Printer.FontItalic = False
Printer.FontSize = 11
Printer.Print
'READ THE SPOOL FILE INTO MEMORY AND SEND TO PRINTER
'ONE LINE AT A TIME
Open "C:\spool.prn" For Input As #1
Do
Dim printbuffer
Line Input #1, printbuffer
printbuffer = Trim(printbuffer) 'NEED THIS TO TAKE OFF INITIAL
SPACES.
Printer.Print printbuffer
Loop Until EOF(1)
Close #1
'TELL THE PRINTER TO PUSH OUT THE PAGE
Printer.EndDoc
On Error GoTo 0
End Sub
Re: printing a multiline textbox
Author: Mike Williams
Date: Thu, 17 Dec 1998 00:00
Date: Thu, 17 Dec 1998 00:00
257 lines
9923 bytes
9923 bytes
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<
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads