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