Binaryworld - Printing the contents of a picturebox, including (most) controls, to a ... [ VB -> Printing ]

API Declarations

Option Explicit

Private Declare Function SendMessage Lib "user32.dll" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CLIENT = &H4& ' Draw the window's client area
Private Const PRF_CHILDREN = &H10& ' Draw all visible child
Private Const PRF_OWNED = &H20& ' Draw all owned windows

Module

Click here to copy the following block

'Note - Box could also be a Form, if desired.
Public Sub PrintPictureBox(Box As PictureBox, _
            Optional X As Single = 0, _
            Optional Y As Single = 0)
Dim rv As Long
Dim ar As Boolean

  On Error GoTo Exit_Sub

  With Box
    'Save ReDraw value
    ar = .AutoRedraw

    'Set persistance
    .AutoRedraw = True

    'Wake up printer
    Printer.Print

    'Draw controls to picture box
    rv = SendMessage(.hwnd, WM_PAINT, .hDC, 0)
    rv = SendMessage(.hwnd, WM_PRINT, .hDC, _
      PRF_CHILDREN Or PRF_CLIENT Or PRF_OWNED)

    'Refresh image to picture property
    .Picture = .Image

    'Copy picture to Printer
    Printer.PaintPicture .Picture, X, Y
    Printer.EndDoc

    'Restore backcolor (Re-load picture if picture was used)
    Box.Line (0, 0)-(.ScaleWidth, .ScaleHeight), .BackColor, BF

    'Restore ReDraw
    .AutoRedraw = ar
  End With

Exit_Sub:
  If Err.Number Then MsgBox Err.Description, vbOKOnly, "Printer Error!"

End Sub

Usage

Click here to copy the following block

'USAGE - Add a picture box and a command button to a new form.
'    Add various controls to the picture box.
'    Run this code, and press the button to print.
Private Sub Command1_Click()
  PrintPictureBox Picture1, 1000, 1000
End Sub