any one knows how to print a Picturebox with controls in it?

[who's ur Daddy]

Hi all
I scroll the forum for a quick and simple answer about printing a picturebox with any control in it ,Well i was supprise and shock
that there was nothing clear and easy to use .
Any idea before i get sick?

[crptcblade]

Try this...

Option Explicit
 
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
                                             ByVal x As Long, _
                                             ByVal y As Long, _
                                             ByVal nWidth As Long, _
                                             ByVal nHeight As Long, _
                                             ByVal hSrcDC As Long, _
                                             ByVal xSrc As Long, _
                                             ByVal ySrc As Long, _
                                             ByVal dwRop As Long) _
                                             As Long
 
Private Sub Command1_Click()
Dim pWidth As Long, pHeight As Long
 
    pWidth = Picture1.Width \ Screen.TwipsPerPixelX
    pHeight = Picture1.Height \ Screen.TwipsPerPixelY
        
    Printer.Print
    Call BitBlt(Printer.hDC, 0, 0, pWidth, pHeight, Picture1.hDC, 0, 0, vbSrcCopy)
    Printer.EndDoc
    
End Sub

[who's ur Daddy]

Hi crptcblade

It works The picturebox with the controls in it appear smaller then at the screen what do i need to change ,the picture scalemode or something in your code?

Thanks i'm on the good way

[Matt-D]

Is anyone out there who could give me a hint how to make the dimensions of the printed result bigger? However, the code from crptcblade works great!

Matt-D

[moeur]

did you try StretchBlt?

[Matt-D]

Yes! That's it! Thanks for your hint

Matt-D

[BrailleSchool]

I was looking to do something like this but when the image is saved, shows the common dialog control covering the complete image. hm.

Try this...

Option Explicit
 
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
                                             ByVal x As Long, _
                                             ByVal y As Long, _
                                             ByVal nWidth As Long, _
                                             ByVal nHeight As Long, _
                                             ByVal hSrcDC As Long, _
                                             ByVal xSrc As Long, _
                                             ByVal ySrc As Long, _
                                             ByVal dwRop As Long) _
                                             As Long
 
Private Sub Command1_Click()
Dim pWidth As Long, pHeight As Long
 
    pWidth = Picture1.Width \ Screen.TwipsPerPixelX
    pHeight = Picture1.Height \ Screen.TwipsPerPixelY
        
    Printer.Print
    Call BitBlt(Printer.hDC, 0, 0, pWidth, pHeight, Picture1.hDC, 0, 0, vbSrcCopy)
    Printer.EndDoc
    
End Sub

[jcis]

Add another Picturebox (invisible)

Private Sub Command1_Click()
    With Picture2
        .AutoRedraw = True
        .Width = Picture1.Width
        .Height = Picture1.Height
    End With
    Call BitBlt(Picture2.hDC, 0, 0, Picture1.Width, Picture1.Height, Picture1.hDC, 0, 0, vbSrcCopy)
    CommonDialog1.Filter = "Images .BMP|*.BMP"
    CommonDialog1.ShowSave
    If CommonDialog1.FileName <> vbNullString Then SavePicture Picture2.Image, CommonDialog1.FileName
End Sub

This will work if Picture1 is 100% visible when you press the button, example: if the user moved the Form and the picture is half visible, only that half will be saved.

[BrailleSchool]

Picture2 is the hidden picturebox?

Add another Picturebox (invisible)

Private Sub Command1_Click()
    With Picture2
        .AutoRedraw = True
        .Width = Picture1.Width
        .Height = Picture1.Height
    End With
    Call BitBlt(Picture2.hDC, 0, 0, Picture1.Width, Picture1.Height, Picture1.hDC, 0, 0, vbSrcCopy)
    CommonDialog1.Filter = "Images .BMP|*.BMP"
    CommonDialog1.ShowSave
    If CommonDialog1.FileName <> vbNullString Then SavePicture Picture2.Image, CommonDialog1.FileName
End Sub

This will work if Picture1 is 100% visible when you press the button, example: if the user moved the Form and the picture is half visible, only that half will be saved.

[jcis]

Affirmative

[BrailleSchool]

Affirmative

gotcha, will see what happens here

[BrailleSchool]

jcis, the code works; however when i put the common dialog on frmMain, it disables my user control, so I put the code into another form and when I did that, it saves correctly but then that form is on top of the screen shot. any way i can take the other form away? this is what i mean (screen shot attached)

[jcis]

Could you upload your project?

[BrailleSchool]

Could you upload your project?

i have found that if you add a common dialog control or an image list to the form that has a user control, the user control no longer works. the user control i am using is to resize and move the controls that are added to the picturebox container at run-time. that is why i have to put the common dialogs on different forms which suck badly. i also want to add icons to my menu editor but you cant do that if the image list isnt on the same form, ugh. complete project attached.

frmMain is my main form, and frmSaveAsImage is where your code is located. I also put the BitBlt stuff in a module, just in case i need to use it again.

[jcis]

Replace your cmdYes_Click with this

Private Sub cmdYes_Click()
    'assign a directory name to a string variable
    m_strScreenShotsDirectory = "Project Screen Shots"
    
    'check to see if the directory exists, if it doesnt, create it
    If Len(Dir$(App.Path & "\" & m_strScreenShotsDirectory & "\", vbDirectory)) > 0 Then
        'do nothing because the Screen Shots directory exists
    Else
        MkDir (App.Path & "\" & m_strScreenShotsDirectory & "\")
    End If
    
    'auto redraw the hidden picturebox, set its height and width to the same as the work area
    With frmMain.pbHidden
        .AutoRedraw = True
        .Width = frmMain.pbWorkArea.Width
        .Height = frmMain.pbWorkArea.Height
        .Appearance = 0
        .BorderStyle = 1
    End With
    
    'open the common dialog and allow the file to be saved as a BMP in the screen shots
    'directory
    With CD
        .Filter = "Images (*.BMP)|*.BMP"
        .InitDir = App.Path & "\" & m_strScreenShotsDirectory & "\"
        .ShowSave
    End With
    
    Me.Visible = False 'With this you wont capture this form
    DoEvents           'With this you wont capture the common dialog window
    
    'Copy the contents of the work area to the hidden picturebox using BitBlt
    With frmMain.pbWorkArea
        Call BitBlt(frmMain.pbHidden.hDC, 0, 0, .Width, .Height, .hDC, 0, 0, vbSrcCopy)
    End With
    
    If CD.FileName <> vbNullString Then SavePicture frmMain.pbHidden.Image, CD.FileName
    
    Unload Me
End Sub

By the way, nice splash screen fading

[BrailleSchool]

yep, that worked perfectly. thanks jcis.

question:
i am using initdir to specify the default directory to open, sometimes the directory specified isnt the defaulted (sometimes opens somewhere else, but not often), how can i get it to always be the default?

Replace your cmdYes_Click with this

Private Sub cmdYes_Click()
    'assign a directory name to a string variable
    m_strScreenShotsDirectory = "Project Screen Shots"
    
    'check to see if the directory exists, if it doesnt, create it
    If Len(Dir$(App.Path & "\" & m_strScreenShotsDirectory & "\", vbDirectory)) > 0 Then
        'do nothing because the Screen Shots directory exists
    Else
        MkDir (App.Path & "\" & m_strScreenShotsDirectory & "\")
    End If
    
    'auto redraw the hidden picturebox, set its height and width to the same as the work area
    With frmMain.pbHidden
        .AutoRedraw = True
        .Width = frmMain.pbWorkArea.Width
        .Height = frmMain.pbWorkArea.Height
        .Appearance = 0
        .BorderStyle = 1
    End With
    
    'open the common dialog and allow the file to be saved as a BMP in the screen shots
    'directory
    With CD
        .Filter = "Images (*.BMP)|*.BMP"
        .InitDir = App.Path & "\" & m_strScreenShotsDirectory & "\"
        .ShowSave
    End With
    
    Me.Visible = False 'With this you wont capture this form
    DoEvents           'With this you wont capture the common dialog window
    
    'Copy the contents of the work area to the hidden picturebox using BitBlt
    With frmMain.pbWorkArea
        Call BitBlt(frmMain.pbHidden.hDC, 0, 0, .Width, .Height, .hDC, 0, 0, vbSrcCopy)
    End With
    
    If CD.FileName <> vbNullString Then SavePicture frmMain.pbHidden.Image, CD.FileName
    
    Unload Me
End Sub

By the way, nice splash screen fading