1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
|
'Déclarations API
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
'dans un Module
'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
'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 |
Partager