Article View: comp.lang.basic.visual
Article #169printing a multiline textbox
From: 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
Technical Details
Message-ID:
<759cjg$cpa$1@remarQ.com>Path:
arc1-ca.pugleaf.net!unknown!not-for-mailShow Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 110e3b,9658a02d9ecc311f,start X-Google-Attributes: gid110e3b,public X-Google-Thread: f645d,9658a02d9ecc311f,start X-Google-Attributes: gidf645d,public X-Google-Thread: 108062,9658a02d9ecc311f,start X-Google-Attributes: gid108062,public From: "cowboys" <cowboys@truserve.com> Subject: printing a multiline textbox Date: 1998/12/16 Message-ID: <759cjg$cpa$1@remarQ.com> X-Deja-AN: 423034616 X-MimeOLE: Produced By Microsoft MimeOLE V4.72.3110.3 X-Complaints-To: newsabuse@remarQ.com X-Trace: 913847728 SWRWGW7ETD34ED08EC usenet87.supernews.com Organization: Posted via RemarQ, http://www.remarQ.com - Discussions start here! Newsgroups: comp.lang.basic.visual,comp.lang.basic.visual.misc,cz.comp.lang.basic.visual