Ghi chép toàn bộ nội dung của Picturebox vào Clipboard

[vinhphuoc91]

Thủ thuật: Ghi chép toàn bộ nội dung của Picturebox vào Clipboard
Tác giả: Sưu tầm
Mô tả: Ghi chép toàn bộ nội dung của Picturebox vào Clipboard

---

Copy đoạn code sau vào Module :

Code: Select all

Option Explicit Private Type RECT   Left As Long   Top As Long   Right As Long   Bottom As LongEnd Type 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 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As LongDeclare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As LongPrivate Declare Function CloseClipboard Lib "USER32" () As LongPrivate Declare Function SetClipboardData Lib "USER32" (ByVal wFormat As Long, ByVal hMem As Long) As LongPrivate Declare Function EmptyClipboard Lib "USER32" () As LongPrivate 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    lhDC = CreateCompatibleDC(objFrom.hDC)    If (lhDC <> 0) Then        lhBMP = CreateCompatibleBitmap(objFrom.hDC, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY)        If (lhBMP <> 0) Then            lhBMPOld = SelectObject(lhDC, lhBMP)            BitBlt lhDC, 0, 0, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY, objFrom.hDC, 0, 0, SRCCOPY            SelectObject lhDC, lhBMPOld            EmptyClipboard            OpenClipboard 0            SetClipboardData CF_BITMAP, lhBMP            CloseClipboard        End If        DeleteObject lhDC    End IfEnd Function 

Sử dụng nó :

Code: Select all

CopyEntirePicture Picture1 'Picture1 là tên picturebox muốn đưa vào clipboard

Sau khi lưu vào clipboard vào Paint Ctrl+V xem kết quả

[T7]

Thủ thuật: Ghi chép toàn bộ nội dung của Picturebox vào Clipboard
Tác giả: Sưu tầm
Mô tả: Ghi chép toàn bộ nội dung của Picturebox vào Clipboard

---

Copy đoạn code sau vào Module :

Code: Select all

Option Explicit Private Type RECT   Left As Long   Top As Long   Right As Long   Bottom As LongEnd Type 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 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As LongDeclare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As LongPrivate Declare Function CloseClipboard Lib "USER32" () As LongPrivate Declare Function SetClipboardData Lib "USER32" (ByVal wFormat As Long, ByVal hMem As Long) As LongPrivate Declare Function EmptyClipboard Lib "USER32" () As LongPrivate 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    lhDC = CreateCompatibleDC(objFrom.hDC)    If (lhDC <> 0) Then        lhBMP = CreateCompatibleBitmap(objFrom.hDC, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY)        If (lhBMP <> 0) Then            lhBMPOld = SelectObject(lhDC, lhBMP)            BitBlt lhDC, 0, 0, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY, objFrom.hDC, 0, 0, SRCCOPY            SelectObject lhDC, lhBMPOld            EmptyClipboard            OpenClipboard 0            SetClipboardData CF_BITMAP, lhBMP            CloseClipboard        End If        DeleteObject lhDC    End IfEnd Function 

Sử dụng nó :

Code: Select all

CopyEntirePicture Picture1 'Picture1 là tên picturebox muốn đưa vào clipboard

Sau khi lưu vào clipboard vào Paint Ctrl+V xem kết quả

Đoạn code khai báo mấy hàm API này sao hok set là Private luôn, để thế bỏ vô form nó báo lỗi thì sao

Code: Select all

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As LongDeclare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

[T7]

...Sau khi thử nghiệm đoạn code
Ặc, ban đầu tưởng là copy cái control picture vào clipboard, ai nhè chỉ là copy cái ảnh bên trong thôi à
Thế thì cần chi mà phải vất vả thế, chỉ cần hai dòng code đơn giản là được rùi

Code: Select all

Clipboard.ClearClipboard.SetData Picture1 'Picture1 là tên picturebox muốn đưa vào clipboard

[onlysoft]

Vỉnh phước em à, cái này mà em củng sài API