Imports System
Imports System.Drawing.Printing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Public Class printRTF
Inherits PrintDocument
<StructLayout(LayoutKind.Sequential)> _
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure CHARRANGE
Public cpMin As Integer
Public cpMax As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure sFORMATRANGE
Public hdc As IntPtr
Public hdcTarget As IntPtr
Public rc As RECT
Public rcPage As RECT
Public chrg As CHARRANGE
End Structure
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private PrintQueuePage As Integer = 0
Private Const WM_USER As Integer = 1024
Private Const EM_FORMATRANGE As Integer = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Integer = WM_USER + 72
Private m_nFirstChar As Integer = 0
Private PrintRichTextBox As RichTextBox
Private PrintQueue As ArrayList
Public Sub Clear()
PrintRichTextBox.Clear()
PrintQueue.Clear()
m_nFirstChar = 0
End Sub
Public Sub New()
Me.PrintController = New StandardPrintController()
PrintRichTextBox = New RichTextBox()
PrintQueue = New ArrayList()
PrintRichTextBox.DetectUrls = False
End Sub
Public Sub LoadRichTextFile(ByVal Filename As String)
PrintRichTextBox.LoadFile(Filename)
m_nFirstChar = 0
PrintQueue.Add(PrintRichTextBox.Rtf)
End Sub
Public Sub RichText(ByVal RTB As String)
PrintRichTextBox.Rtf = RTB
m_nFirstChar = 0
PrintQueue.Add(PrintRichTextBox.Rtf)
End Sub
Private Function HundredthInchToTwips(ByVal n As Integer) As Integer
Return CInt(n * 14.4)
End Function
Public Function SetTargetDevice(ByVal g As Graphics, ByVal lineLen As Integer) As Boolean
Dim res As IntPtr
Dim wpar As IntPtr = g.GetHdc()
Dim lpar As IntPtr = New IntPtr(HundredthInchToTwips(lineLen))
res = SendMessage(PrintRichTextBox.Handle, EM_SETTARGETDEVICE, wpar, lpar)
g.ReleaseHdc(wpar)
Return (Not res.ToInt32() = 0)
End Function
Public Function FormatRange(ByVal e As PrintPageEventArgs, ByVal charFrom As Integer, ByVal charTo As Integer) As Integer
Dim cr As CHARRANGE
cr.cpMin = charFrom
cr.cpMax = charTo
Dim rc As RECT
rc.Top = HundredthInchToTwips(e.MarginBounds.Top)
rc.Bottom = HundredthInchToTwips(e.MarginBounds.Bottom)
rc.Left = HundredthInchToTwips(e.MarginBounds.Left)
rc.Right = HundredthInchToTwips(e.MarginBounds.Right)
Dim rcPage As RECT
rcPage.Top = HundredthInchToTwips(e.PageBounds.Top)
rcPage.Bottom = HundredthInchToTwips(e.PageBounds.Bottom)
rcPage.Left = HundredthInchToTwips(e.PageBounds.Left)
rcPage.Right = HundredthInchToTwips(e.PageBounds.Right)
Dim hdc As IntPtr = e.Graphics.GetHdc()
Dim fr As sFORMATRANGE
fr.chrg = cr
fr.hdc = hdc
fr.hdcTarget = hdc
fr.rc = rc
fr.rcPage = rcPage
Dim res As IntPtr
Dim wpar As IntPtr = New IntPtr(1)
Dim lpar As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(fr))
Marshal.StructureToPtr(fr, lpar, True)
res = SendMessage(PrintRichTextBox.Handle, EM_FORMATRANGE, wpar, lpar)
Marshal.FreeCoTaskMem(lpar)
e.Graphics.ReleaseHdc(hdc)
Return res.ToInt32()
End Function
Public Function FormatRangeDone()
Dim wpar As IntPtr = New IntPtr(0)
Dim lpar As IntPtr = New IntPtr(0)
SendMessage(PrintRichTextBox.Handle, EM_FORMATRANGE, wpar, lpar)
End Function
Protected Overrides Sub OnBeginPrint(ByVal e As System.Drawing.Printing.PrintEventArgs)
m_nFirstChar = 0
End Sub
Protected Overrides Sub OnEndPrint(ByVal e As System.Drawing.Printing.PrintEventArgs)
FormatRangeDone()
End Sub
Protected Overrides Sub OnPrintPage(ByVal e As System.Drawing.Printing.PrintPageEventArgs)
If PrintQueue.Count > 0 Then
PrintRichTextBox.Rtf = PrintQueue.Item(PrintQueuePage)
m_nFirstChar = FormatRange(e, m_nFirstChar, PrintRichTextBox.TextLength)
If (m_nFirstChar < PrintRichTextBox.TextLength - 1) Then
e.HasMorePages = True
ElseIf (PrintQueuePage = (PrintQueue.Count - 1)) Then
e.HasMorePages = False
PrintQueuePage = 0
m_nFirstChar = 0
Else
PrintQueuePage = PrintQueuePage + 1
e.HasMorePages = True
m_nFirstChar = 0
End If
End If
End Sub
End Class
