[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 392
  • Last Modified:

Printing image issue

Hello everybody,

I have created a button, to be able to print an image in my form.

The problem that i have is that in my picture box, i have multiple label, textbox, msflexgrid.....

So when i click on print, it only print the with picturebox and not everything in it also.

How can i print everything inside the picture box please?

Thanks for your help.
Module:

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

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Declaration:
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

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Button:
 Private Sub cmdImprimer_Click()
 PrintPictureBox PicBox, 1000, 1000

End Sub

Open in new window

0
Wilder1626
Asked:
Wilder1626
  • 2
1 Solution
 
Wilder1626Author Commented:
Hello again. This is my update of my issue.

Now, i see most of the label and text box of my picture to print.

What's left to be able to see from my picturebox to print is:

MSFlexgrid name: flxCompta (in my first picturebox)

Picture name: Picture2 (in my first picturebox).

What do i have to fix please?

Thanks again.


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 windows.
Private Const PRF_OWNED = &H20& ' Draw all owned windows.

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


Private Sub Print_Click()
Dim rv As Long
   Me.ScaleMode = vbTwips ' default
   With PicBox
      .Top = PicBox.Top
      .Left = PicBox.Left
      .Width = PicBox.Width
      .Height = PicBox.Height
   End With
   Me.Visible = True
   DoEvents
   PicBox.SetFocus
   PicBox.AutoRedraw = True
   rv = SendMessage(PicBox.hwnd, WM_PAINT, PicBox.hDC, 0)
   rv = SendMessage(PicBox.hwnd, WM_PRINT, PicBox.hDC, _
   PRF_CHILDREN + PRF_CLIENT + PRF_OWNED)
   PicBox.Picture = PicBox.Image
   PicBox.AutoRedraw = False

   Printer.Print ""
   Printer.PaintPicture PicBox.Picture, 0, 0
   Printer.EndDoc
End Sub

Open in new window

0
 
Wilder1626Author Commented:
Perfect, it done.

Here is the result:

Dim rv As Long
   Me.ScaleMode = vbTwips ' default
   With PicBox
      .Top = PicBox.Top
      .Left = PicBox.Left
      .Width = PicBox.Width
      .Height = PicBox.Height
   End With
   Me.Visible = True
   DoEvents
   PicBox.SetFocus
   PicBox.AutoRedraw = True
   rv = SendMessage(PicBox.hwnd, WM_PAINT, PicBox.hDC, 0)
   rv = SendMessage(PicBox.hwnd, WM_PRINT, PicBox.hDC, _
   PRF_CHILDREN + PRF_CLIENT + PRF_OWNED)
   PicBox.Picture = PicBox.Image
   PicBox.AutoRedraw = False


   Printer.Print ""
   Printer.PaintPicture PicBox.Picture, 0, 0
    Printer.PaintPicture Picture2.Picture, 0, 0
    Printer.PaintPicture flxCompta.Picture, 450, 4000
   Printer.EndDoc

Open in new window

0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now