Copy the full contents of the picture frame to the Clipboard

VB itself does not allow you to copy the entire picture on a form, UserControl, or PictureBox to the Clipboard. If you use Clipboard.setdata, only the bitmap that is loaded into this object will be copied. By using the API method, you can go beyond this limit and make sure that everything is copied, including any graphics you've just drawn.

Start a new project, placing a command and a PictureBox on the form. Set the PictureBox AutoRedraw property to 1. Then add a standard module and copy the following code in.

Private Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
' GDI functions:
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 Const srccopy = &hcc0020 ' (DWORD) dest = Source
' Create a memory DC:
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal HDC as long) as long
' Create a bitmap in memory:
Declare Function createcompatiblebitmap Lib "gdi32" (ByVal HDC as Long, ByVal nwidth as Long, ByVal nheight as Long) as Lo Ng
' Put a GDI object into the DC and return to the original one:
Declare Function selectobject Lib "gdi32" (ByVal HDC as Long, ByVal hobject as long) as long
' Delete GDI objects:
Declare Function deleteobject Lib "gdi32" (ByVal Hobject as long) as long
' Clipboard function:
Private Declare Function openclipboard Lib "USER32" (ByVal hWnd as long) as long
Private Declare Function closeclipboard Lib "USER32" () as Long
Private Declare Function setclipboarddata Lib "USER32" (ByVal Wformat as Long, ByVal Hmem as long) as long
Private Declare Function emptyclipboard Lib "USER32" () as Long
Private Const Cf_bitmap = 2
Public Function copyentirepicture (ByRef objfrom as Object) as Boolean
Dim Lhdc as Long
Dim Lhbmp as Long
Dim Lhbmpold as Long
' Create a DC in memory that points to the object we are going to replicate:
LHDC = CreateCompatibleDC (OBJFROM.HDC)
If (lhdc <> 0) Then
' Create a bitmap that points to the object you want to replicate:
Lhbmp = CreateCompatibleBitmap (OBJFROM.HDC, objfrom.scalewidth \ screen.twipsperpixelx, objFrom.ScaleHeight \ screen.twipsperpixely)
If (lhbmp <> 0) Then
' Select the bitmap into the DC we just built and store the old bitmap there:
Lhbmpold = SelectObject (LHDC, Lhbmp)

' Copy the contents of the Objfrom to the created bitmap:
BitBlt lhdc, 0, 0, objfrom.scalewidth \ Screen.twipsperpixelx, Objfrom.scaleheight, screen.twipsperpixely, ObjFrom.hDC, 0, 0, srccopy

' Restore the contents of the DC:
SelectObject LHDC, Lhbmpold

' Now load the bitmap into the Clipboard:
EmptyClipboard
OpenClipboard 0
SetClipboardData Cf_bitmap, Lhbmp
CloseClipboard
' We don't have to delete the created bitmap here--
' It now belongs to the Clipboard, and when the Clipboard changes, Windows will delete it for us.
End If

' Clear the DC you just created:
DeleteObject LHDC
End If
End Function
To experiment with this method, add the code to the form:
Private Sub Command1_Click ()
Copyentirepicture Picture1
End Sub
Private Sub Form_Load ()
Dim I as Long
' Draw something in the PictureBox:
With Picture1.font
. Name = "Arial"
. Bold = True
. Size = 12
End With
For i = 1 to 20
Picture1.forecolor = QBColor (i Mod 15)
Picture1.Print "Http://www.archtide.com"
Next I
End Sub

After the form is loaded, there will be some text in PictureBox. When you click on the command, the entire contents of the PictureBox will be copied to the Clipboard, you can paste it into other programs, such as brushes, word, and so on.