=> Copy a Picture to the Clipboard API/VBA

[Alexander]

Copy a Picture to the Clipboard API/VBA
=======================================

How can I copy in VBA an "Image1.Picture" to the
Clipboard using WinAPI?

As VBA doesn't offer Clipboard functions for Pictures,
I want to resolve the problem, using the WinAPI.

I tried the following which does not work.

'-----------------------------------------------
'TestCode 1

'LOAD PICTURE TO CLIPBOARD USING A BUFFERSTRING
'FOR THE BITMAP COPY

Dim hBitmapA, hBitmapB,
Dim ScreenDC, TrueFalse, hwnd, SizeByts
Dim Buffer As String * 300

hBitmapA = Image1.Picture
SizeByts = GetBitmapBits(hBitmapA, 0, Buffer) '<<<<<< Does Not Work
(Returns 0)

ScreenDC = CreateCompatibleDC(0)
hBitmapB = CreateCompatibleBitmap(ScreenDC , 16, 16) 'Seems to be OK
TrueFalse = DeleteDC(ScreenDC)

TrueFalse = SetBitmapBits(hBitmapB, SizeByts, Buffer) 'Not tested as
GetBitmapBits doesn't fill Buffer

hwnd = GetActiveWindow()
TrueFalse = OpenClipboard(hwnd)
TrueFalse = EmptyClipboard()
TrueFalse = SetClipboardData(CF_BITMAP, hBitmapB) 'The Clipboard is
filled with a Black 16x16 pixel Bitmap
TrueFalse = CloseClipboard()

'-----------------------------------------------

Possibly the reason why the code does not work is,
that I have to pass a memory-pointer to the string-buffer
as an argument for the "GetBitmapBits" and "SetBitmapBits"
functions, and not the string-buffer itself.

How can this be done?

However the following code, Which alocates
Memory by API functions doesn't work either:

'-----------------------------------------------
'TestCode 2

'LOAD PICTURE TO CLIPBOARD USING A MEMORY-POINTER
'FOR THE BITMAP COPY

Dim hBitmapA, hBitmapB, ScreenDC, TrueFalse, hwnd, SizeByts, hMem,
Pointer, Dummy
Dim AmountOfByts As Long : AmountOfByts = 300

hBitmapA = Image1.Picture
hMem = GlobalAlloc(GMEM_MOVEABLE, AmountOfByts)
Pointer = GlobalLock(hMem)
SizeByts = GetBitmapBits(hBitmapA, 0, Pointer) '<<<<<< Does Not Work
(Returns 0)

ScreenDC = CreateCompatibleDC(0)
hBitmapB = CreateCompatibleBitmap(ScreenDC, 16, 16) 'Seems to be OK
TrueFalse = DeleteDC(ScreenDC)

TrueFalse = SetBitmapBits(hBitmapB, SizeByts, Pointer) 'Not tested as
GetBitmapBits doesn't fill Buffer
Dummy = GlobalUnlock(hMem)
TrueFalse = Not GlobalFree(hMem)

hwnd = GetActiveWindow()
TrueFalse = OpenClipboard(hwnd)
TrueFalse = EmptyClipboard()
TrueFalse = SetClipboardData(CF_BITMAP, hBitmapB) 'The Clipboard is
filled with a Black 16x16 pixel Bitmap
TrueFalse = CloseClipboard()

'-----------------------------------------------

Do I have to fill the allocetd memory with Chr(0)'s first?
How could this be done?

Thanks for your help
Alexander

'-----------------------------------------------
'API Declarations

Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal
dwCount As Long, lpBits As Any) As Long
Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal
dwCount As Long, lpBits As Any) As Long

Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long,
ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
'MemoryDC based on a PhysicalDC
Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long 'CreateDC
and CreatCompatibleDC correspondant)

Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal
hMem As Long) As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetActiveWindow Lib "user32" () As Long
'GetActiveWindowHwnd

'-----------------------------------------------

[Karl E. Peterson]

Hi Alexander --

Take a look at ClipEx.zip on http://www.mvps.org/vb/samples.htm for what might be a
drop-in solution to the missing Clipboard object in VBA.

Later... Karl
--
[Microsoft Basic: 1976-2001, RIP]