把圖片框的完整內容復制到剪貼板

　　VB本身不允許你將一個Form、UserControl或PictureBox上的完整圖片復制到剪貼板。如果你使用Clipboard.SetData，將只復制被載入這個對象的位圖。通過使用API方法，你可以超越這個限制，保證全部內容都被復制，包括你剛剛畫上的任何圖形。

　　開始一個新項目，在窗體上放置一個Command和一個PictureBox。將PictureBox的Autoredraw屬性設為1。然後添加一個標准模塊，把以下代碼復制進去。

　　

Private Type RECT
　　
        Left As Long
　　
        Top As Long
　　
        Right As Long
　　
        Bottom As Long
End Type
'GDI函數：
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
'創建一個memory DC：
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
'在memory中建立一個位圖：
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
'把一個GDI對象放入DC，返回原先的那個：
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
'刪除GDI對象：
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'剪貼板函數：
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
　　        '在內存中建立一個指向我們將要復制對象的DC：
　　
        lhDC = CreateCompatibleDC(objFrom.hDC)
　　
        If (lhDC <> 0) Then
　　　　        '建立一張指向將要復制對象的位圖：
　　　　
        lhBMP = CreateCompatibleBitmap(objFrom.hDC, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY)
　　　　
        If (lhBMP <> 0) Then
　　　　　　        '把位圖選入我們剛才建立的DC中，並貯存原先在那裡的老位圖：
　　　　　　
        lhBMPOld = SelectObject(lhDC, lhBMP)
　　　　　　
　　　　　　        '把objFrom的內容復制到建立的位圖裡：
　　　　　　
        BitBlt lhDC, 0, 0, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY, objFrom.hDC, 0, 0, SRCCOPY
　　　　　　
　　　　　　        '恢復DC中的內容：
　　　　　　
        SelectObject lhDC, lhBMPOld
　　　　　　　　　　　　
　　　　　　        '現在把位圖裝入剪貼板：
　　　　　　
        EmptyClipboard
　　　　　　
        OpenClipboard 0
　　　　　　
        SetClipboardData CF_BITMAP, lhBMP
　　　　　　
        CloseClipboard
　　　　　　        '我們在這裡不用刪除建立的位圖——
　　　　　　        '它現在屬於剪貼板，當剪貼板變化時，Windows將為我們刪除它。
　　　　
        End If
　　　　
　　　　        '清除剛才建立的DC：
　　　　
        DeleteObject lhDC
　　
        End If
End Function
　　
        為了試驗這個方法，把這些代碼加入窗體：
Private Sub Command1_Click()
　　
        CopyEntirePicture Picture1
End Sub
Private Sub Form_Load()
　　
        Dim i As Long
　　        '在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

　　窗體加載後，PictureBox中將會有一些文本。當你點擊Command後，PictureBox中的全部內容都將會被復制到剪貼板裡，你可以把它粘貼到別的程序裡，比如畫筆、Word等等。