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

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
Post Reply
vinhphuoc91
Thành viên tích cực
Thành viên tích cực
Posts: 146
Joined: Wed 26/03/2008 5:52 pm
Location: Phú Yên
Been thanked: 15 times
Contact:

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

Post by 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ả :D
My website : http://tinthoitrang.net
User avatar
T7
Thành viên danh dự
Thành viên danh dự
Posts: 415
Joined: Thu 24/05/2007 8:19 pm
Location: Long Xuyên - An Giang
Been thanked: 12 times
Contact:

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

Post by T7 »

vinhphuoc91 wrote: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ả :D
Đ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
While (i <= you) i++;
User avatar
T7
Thành viên danh dự
Thành viên danh dự
Posts: 415
Joined: Thu 24/05/2007 8:19 pm
Location: Long Xuyên - An Giang
Been thanked: 12 times
Contact:

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

Post by 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 :D

Code: Select all

Clipboard.ClearClipboard.SetData Picture1 'Picture1 là tên picturebox muốn đưa vào clipboard
While (i <= you) i++;
User avatar
onlysoft
Thành viên tâm huyết
Thành viên tâm huyết
Posts: 330
Joined: Wed 26/03/2008 6:32 pm
Location: ONLYSOFT
Been thanked: 8 times

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

Post by onlysoft »

Vỉnh phước em à, cái này mà em củng sài API :))
:x Tin học là cuộc sống, Lập trình là người yêu, Vợ là computer :x
Tôi yêu tin học, Tin học lập trình, Để lập trình tôi dùng VB, Tôi là B-)nly
Post Reply

Return to “[VB] Mẹo vặt khác”