🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.basic.visual
Article #169

printing a multiline textbox

#169
From: cowboys
Date: Wed, 16 Dec 1998 00:00
224 lines
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-mail

Show 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