PictToClipBoard




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 Declare Function _
CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, _
ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC _
Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib _
"gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long
' Clipboard

Private Declare Function OpenClipboard Lib _
"user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib _
"user32" () As Long
Private Declare Function EmptyClipboard Lib _
"user32" () As Long
Private Declare Function SetClipboardData Lib "user32" _
(ByVal wFormat As Long, ByVal hMem As Long) As Long
'#

'# API Constants

'#

'Clipboard formats

Private Const CF_BITMAP = 2
' ROP

Private Const SRCCOPY = &HCC0020
Public Sub PicToClip(pic As PictureBox)
Dim hSourceDC As Long
Dim hMemoryDC As Long
Dim lWidth As Long
Dim lHeight As Long
Dim hBitmap As Long
Dim hOldBitmap As Long
'#

'# NOTE: Error trapping has been removed

'for the sake of clarity

'#

With pic
' Determine bitmap size

lWidth = .Parent.ScaleX(.ScaleWidth, _
.ScaleMode, vbPixels)
lHeight = .Parent.ScaleY(.ScaleHeight, _
.ScaleMode, vbPixels)
' Get hBitmap loaded with image on

' Picture control

hSourceDC = GetDC(.hWnd)
hMemoryDC = CreateCompatibleDC(.hDC)
hBitmap = CreateCompatibleBitmap( _
.hDC, lWidth, lHeight)
hOldBitmap = SelectObject(hMemoryDC, _
hBitmap)
Call BitBlt(hMemoryDC, 0, 0, lWidth, _
lHeight, pic.hDC, 0, 0, SRCCOPY)
hBitmap = SelectObject(hMemoryDC, _
hOldBitmap)
' Copy to clip board

Call OpenClipboard(.Parent.hWnd)
Call EmptyClipboard
Call SetClipboardData(CF_BITMAP, _
hBitmap)
Call CloseClipboard
' Clean up GDI

Call ReleaseDC(.hWnd, hSourceDC)
Call SelectObject(hMemoryDC, hBitmap)
Call DeleteDC(hMemoryDC)
End With
End Sub
The VB Picture control can hold several different formats of
pictures: 'BMP, DIB, ICO, CUR, WMF, and others under VB5.
Additionally, you can use graphics methods to "draw" on the
control. The only native method that converts the image on
the picture control, including the drawn graphics, to a bitmap
and transfers the bitmap to the system clipboard requires you
to use AutoRedraw. However, this technique causes problems
This code shows the declarations and function required to
transfer the image on a VB picture control to the system
clipboard as a bitmap. Add this code to a BAS module, call
PicToClip, and pass the picture box as the only parameter:










( picttoclipboard.html )- by Paolo Puglisi - Modifica del 17/12/2023