Public Sub PrintRTF(RTF As Object, PrinterDriver As String, LeftMarginWidth As Long, TopMarginHeight As Long, RightMarginWidth As Long, BottomMarginHeight As Long, OrigPageWidth As Long, OrigPageHeight As Long)
Dim LeftOffset As Long
Dim TopOffset As Long
Dim LeftMargin As Long
Dim TopMargin As Long
Dim RightMargin As Long
Dim BottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As RECT
Dim rcPage As RECT
Dim TextLength As Long
Dim NextCharPosition As Long
Dim OldNextCharPosition As Long
Dim r As Long
Dim Prx As Printer
' Select the printer...
For Each Prx In Printers
If (Prx.DeviceName = PrinterDriver) Then
Set Printer = Prx
Exit For
End If
Next Prx
DoEvents
' Start a print job to get a valid Printer.hDC
Printer.Print Space(1)
Printer.ScaleMode = vbTwips
' Get the offset 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)
' Check margins...
If (LeftMarginWidth = -1) Then LeftMarginWidth = 500
If (RightMarginWidth = -1) Then RightMarginWidth = 500
If (TopMarginHeight = -1) Then TopMarginHeight = 500
If (BottomMarginHeight = -1) Then BottomMarginHeight = 500
If (OrigPageWidth = -1) Then OrigPageWidth = 0
If (OrigPageHeight = -1) Then OrigPageHeight = 0
' Account for the original page dimensions...
XFactor! = IIf(OrigPageWidth = 0, 1, Printer.Width / (OrigPageWidth + 1))
YFactor! = IIf(OrigPageHeight = 0, 1, Printer.Height / (OrigPageHeight + 1))
' Calculate the Left, Top, Right, and Bottom margins
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - (RightMarginWidth / XFactor!)) - LeftOffset
BottomMargin = (Printer.Height - (BottomMarginHeight / YFactor!)) - TopOffset
LeftMargin = LeftMargin / XFactor!
RightMargin = RightMargin / XFactor!
TopMargin = TopMargin / YFactor!
BottomMargin = BottomMargin / YFactor!
' 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)
' Loop printing each page until done
On Error Resume Next
Do
' Print the page by sending EM_FORMATRANGE message
OldNextCharPosition = NextCharPosition
NextCharPosition = SendAnyMessage(RTF.hwnd, EM_FormatRange, True, fr)
If (NextCharPosition >= TextLength) Or (NextCharPosition = OldNextCharPosition) Then Exit Do
fr.chrg.cpMin = NextCharPosition ' Starting position for next page
Printer.NewPage ' Move on to next page
Printer.Print Space(1) ' Re-initialize hDC
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
Loop ' Commit the print job
Printer.EndDoc ' Allow the RTF to free up memory
r = SendMessage(RTF.hwnd, EM_FormatRange, False, ByVal CLng(0))
End Sub