''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' PrintRTF - Prints the contents of a RichTextBox control on the default printer using the
' provided margins
'
' RTF - A RichTextBox control to print
'
' LeftMarginWidth - Width of desired left margin in twips
'
' TopMarginHeight - Height of desired top margin in twips
'
' RightMarginWidth - Width of desired right margin in twips
'
' BottomMarginHeight - Height of desired bottom margin in twips
'
' Notes - If you are also using WYSIWYG_RTF() on the provided RTF
' parameter you should specify the same LeftMarginWidth and
' RightMarginWidth that you used to call WYSIWYG_RTF()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 vl_LastContainerPos_lng As Long
Dim vl_ContainerPos_lng As Long
Dim vl_PotentialPgBreakPos_lng As Long
Dim vl_CurrentPage_int As Integer
Dim r As Long
' Start a print job to get a valid Printer.hDC
On Error GoTo PrintRTF_Error
Stack.Push "PrintRTF"
Printer.Print Space(1)
Printer.ScaleMode = vbTwips
' Get the offsett to the printable area on the page in twips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETY), vbPixels, vbTwips)
' Calculate the Left, Top, Right, and Bottom margins
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
' Set printable area rect
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight
' Set rect in which to print (relative to printable area)
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin
' Set up the print instructions
fr.hdc = Printer.hdc ' Use the same DC for measuring and rendering
fr.hdcTarget = Printer.hdc ' Point at printer hDC
fr.rc = rcDrawTo ' Indicate the area on page to draw to
fr.rcPage = rcPage ' Indicate entire size of page
fr.chrg.cpMin = 0 ' Indicate start of text through
fr.chrg.cpMax = -1 ' end of the text
' Get length of text in RTF
TextLength = Len(RTF.Text)
vl_CurrentPage_int = 0
'This next bit of code is a bit confusing.
'It was used as an attempt to prevent "orphan" paragraphs. The page had to be divided
'into sections denoted by the ". Then, each page had to be rendered,
'the next break found, and the page break moved if necessary. Each page break was two parts:
'the cpMin parameter of the next page, and the cpMax parameter of the current page.
'Therefore, we had to go through the following steps:
' -Rendering the page
' -Determine if any CP_PAGEBREAKCHAR_STRs were present between this page and the next (half on this page)
' -Adjsut the break if necessary
' Loop printing each page until done
Do
'Increment the page counter to keep track of the current page
vl_CurrentPage_int = vl_CurrentPage_int + 1
'Render the page and record the "proposed" end
vl_PotentialPgBreakPos_lng = SendMessage( _
RTF.hWnd, _
EM_FORMATRANGE, _
False, _
fr)
'If the proposed printout is only one page long, no further processing needs to occur.
'We can determine if the printout is only one page long by testing if the potential page break position
'ís greater than the text length.
If vl_PotentialPgBreakPos_lng < TextLength Then
'In this case, there is definately more than one page, so the printout shouldn't have an issue.
'We have to check if there is more than one page to avoid page breaks that are the only container on a page.
'See if there are any key characters in between the last position and the proposed page break
'The easiest way to do this is to look for the key characters until the page is either reached or exceeded.
'If one of those conditions are met, then set the new page break position.
vl_LastContainerPos_lng = fr.chrg.cpMin + 1
Do
vl_ContainerPos_lng = InStr(vl_LastContainerPos_lng + 2, RTF.Text, CP_PAGEBREAKCHAR_STR, vbBinaryCompare)
'There will only be a few situations following this instr operation:
'The key characters will be found farther than the limit (result of instr >proposed limit)
If vl_ContainerPos_lng >= vl_PotentialPgBreakPos_lng Then
'ín which case', we just have to set the maximum to the previously found key character and exit the loop
fr.chrg.cpMax = vl_LastContainerPos_lng - 1
Exit Do
ElseIf (vl_ContainerPos_lng = 0) And (vl_CurrentPage_int = 1) Then
fr.chrg.cpMax = vl_LastContainerPos_lng - 1
Exit Do
'There will be no more instances of the key chracters after the page break, (result of instr = -1)
ElseIf vl_ContainerPos_lng = 0 Then
'in which case, the current stopping position is fine, and the loop can be exited.
Exit Do
'Or, there will be more searching to do
Else
vl_LastContainerPos_lng = vl_ContainerPos_lng
End If
Loop
End If
' Print the page by sending EM_FORMATRANGE message
NextCharPosition = SendMessage(RTF.hWnd, _
EM_FORMATRANGE, True, fr)
If NextCharPosition >= TextLength Then Exit Do 'If done then exit
Printer.NewPage ' Move on to next page
Printer.Print Space(1) ' Re-initialize hDC
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
fr.chrg.cpMin = NextCharPosition
fr.chrg.cpMax = -1
Loop
' Commit the print job
Printer.EndDoc
' Allow the RTF to free up memory
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal _
CLng(0))
On Error GoTo 0
Stack.Pop
Exit Sub
PrintRTF_Error:
ErrHandler "Print", "Module", "PrintRTF", Erl
End Sub
[RESOLVED] Modified printout from an RTB.
Reply With Quote