Re: RTF printing problem

"Dale" <dale@xxxxxxx> wrote in message news:MPG.1f7a32e6c628afcc9896e5@xxxxxxxxxxxxxxxxxxxxx

The page I'm printing is about 6 lines longer than a printed
page, so the last line is clipped 1/4" from the bottom of the
page, and the remaining five or six lines are on the next page.
I think I understand what it's doing, I just don't know what to
do about it.

If you run the modified code in my previous post it should tell you the size of the printer's unprintable bottom margin. I would imagine that the RTB is printing a line of text partway into that margin, which is causing it to be clipped. The RTB Selprint method doesn't give you much control over the printed output. Here is some code which allows you to print the contents of your RichTextBox in a different way, allowing you to specify precise page margins. Basically it is a copy of some code on the MSDN pages, but I've stripped out all of the wysiwyg stuff to make it simpler (unless of course you need wysiwyg in the RTB, in which case I'll be happy to post it for you). I've also fixed a little bug it had and I've added some more functionality (the ability to print headers and footers etc). The example prints using one inch page margins, but you can of course change them to whatever value you want. The margins you specify must of course not encroach into the printer's unprintable margins. You can call it from your VB Form in the following manner:

Private Sub Command1_Click()
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440
End Sub

The margins are in twips (1440 twips per inch). Anyway, here's the module code (below my sig). Paste it all into a standard VB code module.

Mike

' ***** START OF MODULE CODE *****
Option Explicit
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CharRange
cpMin As Long
cpMax As Long
End Type
Private Type FormatRange
hdc As Long
hdcTarget As Long
rc As Rect
rcPage As Rect
chrg As CharRange
End Type
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "USER32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal msg As Long, ByVal wp As Long, lp As Any) As Long

Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth _
As Long, TopMarginHeight, RightMarginWidth, _
BottomMarginHeight)
Dim LeftOffset As Long, TopOffset As Long
Dim LeftMargin As Long, TopMargin As Long
Dim RightMargin As Long, BottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As Rect
Dim rcPage As Rect
Dim TextLength As Long
Dim NextCharPosition As Long
Dim r As Long
Dim s1 As String, pageNum As Long
Printer.Print Space(1)
Printer.ScaleMode = vbTwips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETY), vbPixels, vbTwips)
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - RightMarginWidth) _
- LeftOffset
BottomMargin = (Printer.Height - BottomMarginHeight) _
- TopOffset
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
fr.rc = rcDrawTo
fr.rcPage = rcPage
fr.chrg.cpMin = 0
fr.chrg.cpMax = -1
TextLength = Len(RTF.Text)
Do
Printer.ScaleMode = vbInches
Printer.Font.Name = "Times New Roman"
Printer.Font.Size = 12
pageNum = pageNum + 1
s1 = "This is the footer of page number " & _
Format(pageNum)
Printer.CurrentX = (Printer.ScaleWidth - _
Printer.TextWidth(s1)) / 2
Printer.CurrentY = Printer.ScaleHeight - _
Printer.TextHeight(s1)
Printer.Print s1
NextCharPosition = SendMessage(RTF.hWnd, _
EM_FORMATRANGE, True, fr)
If NextCharPosition >= TextLength Then Exit Do
fr.chrg.cpMin = NextCharPosition
Printer.NewPage
Printer.Print Space(1)
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
Loop
Printer.EndDoc
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, _
ByVal CLng(0))
End Sub
' ***** END OF MODULE CODE *****

.

Relevant Pages

  • Re: Vista cuts bottom of my form
    ... located at the bottom of the form, but the form still is cut ... Your code then needs to examine the resultant ScaleWidth and ScaleHeight properties of the Form and position all Controls so that they fit within it. ... Private Type RECT ... Dim wide1 As Long, high1 As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: Problem with execution order in print routine
    ... Private Const DM_ORIENTATION = &H1 ... Dim strPrinterDesignation As String ... Dim iRet As Long ... "Unexpectedly could not access printer property ...
    (microsoft.public.word.vba.general)
  • Re: API upgrade problem - VB6 to VB.NET
    ... Private Const mcCaseInsensitive As Long = &H40 ... (ByRef pSection As Long, ByVal pAccess As Long, ByRef pObjAttribs As ... : Private Sub GetSerialParallel() ... Dim vMemoryAs Byte ...
    (microsoft.public.vb.winapi)
  • Re: Communicating between Applications
    ... Private Declare Function CloseHandle _ ... Const SUBLANG_DEFAULT = &H1 ... Private Sub Command1_Click ... Dim BytesWritten As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: AlphaBlending Transparent PNG Files
    ... I'm assuming I need to call the private CreateDIB() to create a DIB, ... Dim lngHeight As Long, lngWidth As Long ... Private Declare Function AlphaBlend Lib "MSImg32.dll" (ByVal hDCDest As ... Private Type Bitmap ' 24 bytes ...
    (microsoft.public.vb.winapi.graphics)