How to Print Multiple Pages with PrintDocument

[trbyrne]

I have a program in which I want to print a postcard for each record in a datareader control. Currently I am calling the PrintDocument.Print command after each record is read. What I would like to do is to create a new "page" for each record and then only call the Print command once. I've included some code below:

...while reader reads....
Dim custcitystatezip As String
                        Dim prn As New PrintDocument

                        custcitystatezip = StrConv(Trim(Reader("primcity")), VbStrConv.ProperCase)
                        custcitystatezip += ", " & Trim(Reader("primstate"))
                        custcitystatezip += "  " & Trim(Reader("primzipfirst5"))

                        PostcardAddress = custname & vbCrLf & custaddr & vbCrLf & custcitystatezip & vbCrLf & vbCrLf & vbCrLf & Reader("repairnum")

                        AddHandler prn.PrintPage, AddressOf Me.PrintPageHandler
                        Dim ps As System.Drawing.Printing.PaperSource
                        For Each ps In prn.PrinterSettings.PaperSources
                            If ps.SourceName = "Tray2" Then
                                prn.DefaultPageSettings.PaperSource = ps
                                Exit For
                            End If
                        Next
                        prn.DefaultPageSettings.Landscape = True

                        prn.Print()
                        RemoveHandler prn.PrintPage, AddressOf Me.PrintPageHandler

 

[maytel]

heres a sample code i use

Private WithEvents oPrintDoc As New System.Drawing.printing.PrintDocument
Private hRecPrinted As Short

Private Sub oPrintDoc_BeginPrint(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintEventArgs) Handles oPrintDoc.BeginPrint
hRecPrinted = 0
End Sub

Private Sub oPrintDoc_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles oPrintDoc.PrintPage

Dim oPen As New Pen(Color.Black)
Dim oBrush As Brush = Brushes.Black
Dim oFont As New Font(ogdCounter.Font.Name, ogdCounter.Font.Size, FontStyle.Regular)
Dim gXPos As Single, gYPos As Single
Dim sPrint As String, gWidth As Single, gHeight As Single

With e.Graphics

'Header
oFont = New Font("Times New Roman", 7, FontStyle.Italic)
sPrint = "Header"
gWidth = .MeasureString(sPrint, oFont).Width
gHeight = .MeasureString(sPrint, oFont).Height
gXPos = 115
gYPos = 50
DrawString(e, gXPos, gYPos, gWidth, gHeight, sPrint, oPen, oFont, oBrush)

gYPos += gHeight
oFont = New Font("Courier New", 12, FontStyle.Regular)

For y As Byte = 0 To 21

'Date
gXPos = 62
'sPrint = Format(ogdCounter.CellText(hRecPrinted, 0), "MM/dd/yy")
sPrint = ogdCounter.CellText(hRecPrinted, 0)
gWidth = 88
gHeight = .MeasureString("A", oFont).Height
DrawString(e, gXPos, gYPos, gWidth, gHeight, sPrint, oPen, oFont, oBrush, eAlignment.center, True)

gYPos += gHeight

hRecPrinted += 1
If hRecPrinted > ogdCounter.RecCount - 1 Then Exit For

Next

'Footer
gXPos = 50
gYPos = 737
sPrint = "NOTE: Please make all checks payable to NEW ESKIMO."
oFont = New Font("Times New Roman", 12, FontStyle.Bold)
gWidth = .MeasureString(sPrint, oFont).Width
gHeight = .MeasureString(sPrint, oFont).Height
DrawString(e, gXPos, gYPos, gWidth, gHeight, sPrint, oPen, oFont, oBrush)

If hRecPrinted > ogdCounter.RecCount - 1 Then
e.HasMorePages = False
Else
e.HasMorePages = True
End If

End With

End Sub