Printing Christmas Labels VBE2005

[Steinie]

I just thought i'd share my little test Class to print Christmas labels with a Graphic

Data base is not included, but you can get the data from your own files.
Here is the code:

Public Class Form1

    Dim img As Bitmap
    Dim i As Integer

    ' Test to print Christmas Labels from my Address List

    'Form1 is 750 X 600
    '   with one ToolStripButton for 'Print'
    'PictureBox1 is 64 X 64  with Background image set to Zoom
    'RichtextBox1 is 300 X 500
    'RichtextBox2 is 300 X 500
    'RichTextBoxs.Font = QuickType II, 12pt, style=Bold Italic, Color DarkGreen prints at 6 lines per inch

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        ' Replace the following with Address list data
        RichTextBox1.AppendText("John Smith" & vbCrLf)
        RichTextBox1.AppendText("123 any Street" & vbCrLf)
        RichTextBox1.AppendText("Anywhere, XX 58258" & vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)

        RichTextBox1.AppendText("John Doe" & vbCrLf)
        RichTextBox1.AppendText("456 any Street" & vbCrLf)
        RichTextBox1.AppendText("Anywhere, XX 00111" & vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)

        RichTextBox1.AppendText("John Dokes" & vbCrLf)
        RichTextBox1.AppendText("456 any Street" & vbCrLf)
        RichTextBox1.AppendText("Anywhere, XX 12345" & vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)

        RichTextBox1.AppendText("William Smith" & vbCrLf)
        RichTextBox1.AppendText("456 any Street" & vbCrLf)
        RichTextBox1.AppendText("Anywhere, XX 98765" & vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)

        RichTextBox1.AppendText("Billy J Coon" & vbCrLf)
        RichTextBox1.AppendText("456 any Street" & vbCrLf)
        RichTextBox1.AppendText("Anywhere, XX 14725" & vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)
        RichTextBox1.AppendText(vbCrLf)

        RichTextBox2.AppendText("William Smith" & vbCrLf)
        RichTextBox2.AppendText("456 any Street" & vbCrLf)
        RichTextBox2.AppendText("Anywhere, XX 33333" & vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)

        RichTextBox2.AppendText("William Smith" & vbCrLf)
        RichTextBox2.AppendText("456 any Street" & vbCrLf)
        RichTextBox2.AppendText("Anywhere, XX 44444" & vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)

        RichTextBox2.AppendText("William Smith" & vbCrLf)
        RichTextBox2.AppendText("456 any Street" & vbCrLf)
        RichTextBox2.AppendText("Anywhere, XX 55555" & vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)

        RichTextBox2.AppendText("William Smith" & vbCrLf)
        RichTextBox2.AppendText("456 any Street" & vbCrLf)
        RichTextBox2.AppendText("Anywhere, XX 66666" & vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)

        RichTextBox2.AppendText("William Smith" & vbCrLf)
        RichTextBox2.AppendText("456 any Street" & vbCrLf)
        RichTextBox2.AppendText("Anywhere, XX 77777" & vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
        RichTextBox2.AppendText(vbCrLf)
    End Sub

    Private Sub ToolStripButtonPrint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButtonPrint.Click

        Dim dpiX As Integer = 96 'Dots per inch
        Dim dpiY As Integer = 96 'Dots per inch

        img = New Bitmap(4 * dpiX, 10 * dpiY) '384 x 960 Dots
        Dim gr As Graphics = Graphics.FromImage(img)
        gr.Clear(Color.White)

        Dim p As Point
        Dim s As Size

        p.X = 50 : p.Y = 5  'Print location
        For i = 0 To 960 Step 96  ' Print 10 Graphics
            s = PictureBox1.Size
            gr.CopyFromScreen(PictureBox1.PointToScreen(New Point(0, 0)), p, s)
            p.Y = p.Y + 96
        Next

        p.X = p.X + s.Width + 10 : p.Y = 15 'Print location of RichTextBox1
        s = RichTextBox1.Size
        gr.CopyFromScreen(RichTextBox1.PointToScreen(New Point(0, 0)), p, s)

        p.Y = p.Y + 480 ' Bump Y by 5 labels for RichTextBox2
        s = RichTextBox2.Size
        gr.CopyFromScreen(RichTextBox2.PointToScreen(New Point(0, 0)), p, s)

        PrintDialog1.Document = PrintDocument1
        Dim result As DialogResult = PrintDialog1.ShowDialog()
        If result = DialogResult.OK Then
            PrintDocument1.Print()
        End If

    End Sub

    Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
        e.Graphics.DrawImage(img, e.PageBounds.Location)
    End Sub

End Class