Dim w As Integer, h As Integer
Dim iBitmap As Long, iDC As Long
With Picture1
w = Int(.ScaleWidth)
h = Int(.ScaleHeight)
End With
iDC = CreateCompatibleDC(Picture1.hdc)
'MsgBox iDC
iBitmap = CreateBitmap(w, h, 1, 1, ByVal 0&)
'MsgBox iBitmap
SelectObject iDC, iBitmap
With Picture1
'StretchBlt Picture2.hdc, w, 0, -w, h, Picture1.hdc, 0, 0, w, h, vbSrcCopy
SetMapMode Picture1.hdc, GetMapMode(Picture2.hdc)
StretchBlt iDC, w, 0, -w, h, Picture1.hdc, 0, 0, w, h, vbSrcCopy
BitBlt Picture2.hdc, 0, 0, w, h, iDC, 0, 0, vbSrcCopy
Picture2.Refresh
End With
Clipboard.Clear
'Clipboard.Clear
'Call OpenClipboard(hwnd)
'Call SetClipboardData(vbCFDIB, iBitmap)
'Call CloseClipboard
Clipboard.SetData Picture2.Image
DeleteDC iDC
DeleteObject iBitmap |