Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.


image path > stdPic > clipboard issue

image path > stdPic > clipboard issue

My apologies to the VB guys on the forum since I am doing this on an Access/VBA platform, but it does seem to be primarily an API issue.
I want to be able to pass an image to the clipboard based on the image file path and do so based on a variety of image types. Converting the image file to an OLE stdPicture seemed a feasible first step and I thought about the LoadPicture function. But LoadPicture wont work with tiff images, so I cast about and found graciously posted GDI+ based functions (LoadPicturePlus) billed as being a more versatile method. As an interim test I used the LoadPicturePlus function to load a picture into an ActiveX image control and this worked satisfactorily.

The next step was to pass a stdPicture to the clipboard and I turned up another function I slightly amended to pfCopyStdPicture. However doing this I get a blank rectangle pasted from the clipboard rather than an image. Any thoughts as to what sort of graphics API abuse I am committing?

If I pass a stdPicture to pfCopyStdPicture using LoadPicture (rather than LoadPicturePlus) I do get an image from the clipboard. Not sure if it is relevant, but LoadPicture and LoadPicturePlus result in different values for BitmapInfo.bitcount.

Thanks much. Code is posted below.

Function calls


Private Sub Command5_Click()
Dim stdPic As New stdole.StdPicture
Dim strFilePath As String
Dim blnUseDIB As Boolean
    blnUseDIB = True
    'strFilePath = "C:\Users\ploceus\All Users\H1.tif"  '185547
    'strFilePath = "C:\Users\ploceus\All Users\H1SunriseTN_t.jpg"  
    strFilePath = "C:\Users\ploceus\All Users\PhotoDB.gif"

    'Set stdPic = LoadPicture(strFilePath) 'will not load tif images
    Set stdPic = LoadPicturePlus(strFilePath)  'will load tif
'    Debug.Print stdPic.type 'returns 1 vbPicTypeBitmap
'    Debug.Print GetObjectType(stdPic.handle)  'returns 7 OBJ_BITMAP
'    Me.Image7.Picture = stdPic  'both stdPic methods work here

    Call pfCopyStdPicture(stdPic, blnUseDIB) 'only LoadPicture works

End Sub 



'Using GDI+ you can load BMP, GIF, TIFF, JPEG and PNG files. This code loads the image and
'then converts it to a StdPicture object to use it in Visual Basic controls.

Private Const vbPicTypeNone As Long = 0
Private Const vbPicTypeBitmap As Long = 1
Private Const vbPicTypeMetafile As Long = 2
Private Const vbPicTypeIcon As Long = 3
Private Const vbPicTypeEMetafile As Long = 4

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

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, _
   inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" ( _
   ByVal FileName As Long, BITMAP As Long) As Long

Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" ( _
   ByVal BITMAP As Long, hbmReturn As Long, ByVal background As Long) As Long

Private Type PICTDESC
   cbSizeOfStruct As Long
   PicType As Long
   hgdiObj As Long
   hPalOrXYExt As Long
End Type

Private Type IID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7)  As Byte
End Type

Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (lpPictDesc As PICTDESC, _
   riid As IID, ByVal fOwn As Boolean, lplpvObj As Object)

' Procedure : LoadPicturePlus
' Purpose   : Loads an image using GDI+
' Returns   : The image loaded in a StdPicture object
' Author    : Eduardo A. Morcillo
Public Function LoadPicturePlus(ByVal FileName As String) As stdole.StdPicture
Dim tSI As GdiplusStartupInput
Dim lGDIP As Long
Dim lRes As Long
Dim lBitmap As Long
Dim hBitmap As Long

   ' Initialize GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI)
   If lRes = 0 Then
      ' Open the image file
      lRes = GdipCreateBitmapFromFile(StrPtr(FileName), lBitmap)
      If lRes = 0 Then
         ' Create a GDI bitmap
         lRes = GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0)
         ' Create the StdPicture object
         Set LoadPicturePlus = HandleToPicture(hBitmap, vbPicTypeBitmap)
         ' Dispose the image
         GdipDisposeImage lBitmap
      End If
      ' Shutdown GDI+
      GdiplusShutdown lGDIP
   End If
   If lRes Then Err.Raise 5, , "Cannot load file"
End Function

' Procedure : HandleToPicture
' Purpose   : Creates a StdPicture object to wrap a GDI
'             image handle
Private Function HandleToPicture(ByVal hGDIHandle As Long, ByVal lngObjectType As Long, Optional ByVal hpal As Long = 0) As stdole.StdPicture

Dim tPictDesc As PICTDESC
Dim IID_IPicture As IID
Dim oPicture As IPicture
   ' Initialize the PICTDESC structure
   With tPictDesc
      .cbSizeOfStruct = Len(tPictDesc)
      .PicType = lngObjectType
      .hgdiObj = hGDIHandle
      .hPalOrXYExt = hpal
   End With

   ' Initialize the IPicture interface ID
   With IID_IPicture
      .Data1 = &H7BF80981
      .Data2 = &HBF32
      .Data3 = &H101A
      .Data4(0) = &H8B
      .Data4(1) = &HBB
      .Data4(3) = &HAA
      .Data4(5) = &H30
      .Data4(6) = &HC
      .Data4(7) = &HAB
   End With
   ' Create the object
   OleCreatePictureIndirect tPictDesc, IID_IPicture, True, oPicture
   ' Return the picture object
   Set HandleToPicture = oPicture
End Function 

stdPicture > Clipboard functions


'slightly amended FROM:!topic/
'posted by: Mike Sutton

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 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 SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
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 SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, _
    ByVal nStartScan As Long, ByVal nNumScans As Long, _
    ByRef lpBits As Any, ByRef lpBI As BitmapInfo8, _
    ByVal wUsage As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type BitmapInfoHeader ' 40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BitmapInfo8
    bmiHeader As BitmapInfoHeader
    bmiColors(255) As Long
End Type

Private Const LOGPIXELSX As Long = 88 ' Logical pixels/inch in X
Private Const LOGPIXELSY As Long = 90 ' Logical pixels/inch in Y
Private Const GMEM_MOVEABLE As Long = &H2

' ClipBoard Formats
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_ENHMETAFILE = 14
Private Const CF_METAFILEPICT = 3

'Copies the source bitmap directly to the destination bitmap.
Private Const SRCCOPY As Long = &HCC0020

Public Function pfCopyStdPicture(ByRef inPic As StdPicture, Optional ByVal inAsDIB As Boolean = True, Optional frm As Form) As Long

Dim CopyDC As Long, CopyBmp As Long, CopyOldBmp As Long
Dim hMemDC As Long, SrcOldBmp As Long
Dim SrcW As Long, SrcH As Long
Dim hDIB As Long
Dim hDIBPtr As Long
Dim BMInfo As BitmapInfo8
Dim lngHeadSize As Long
Dim lngDataSize As Long
Dim OldUsed As Long

    ' Try to open the clipboard
'    If (OpenClipboard(frm.hWnd)) Then
    If OpenClipboard(0) Then
        ' Clear the clipboard of any current data
        '  and to assign us clipboard ownership
        Call EmptyClipboard

        ' Select the original bitmap into a temp DC
        hMemDC = CreateCompatibleDC(0)
        SrcOldBmp = SelectObject(hMemDC, inPic.handle)

        If (inAsDIB) Then ' DIB
            BMInfo.bmiHeader.biSize = Len(BMInfo.bmiHeader)

            ' Get some information about the current Bitmap
            If (GetDIBits(hMemDC, inPic.handle, 0, 0, ByVal 0&, BMInfo, 0)) Then
                With BMInfo.bmiHeader ' Make sure we've got a valid colour count
                    If (.biBitCount <= 8) Then _
                        If (.biClrUsed = 0) Then .biClrUsed = 2 ^ .biBitCount
Debug.Print .biBitCount
                    ' Calculate the header and data sizes
                    lngHeadSize = Len(BMInfo.bmiHeader) + (.biClrUsed * Len(BMInfo.bmiColors(0)))
                    lngDataSize = ((((.biWidth * .biBitCount) + &H1F) And &HFFFFFFE0) \ &H8) * .biHeight
                    OldUsed = .biClrUsed
                End With

                ' Allocate a chunk of memory for the DIB
                hDIB = GlobalAlloc(GMEM_MOVEABLE, lngHeadSize + lngDataSize)
                hDIBPtr = GlobalLock(hDIB) ' Get a pointer to the data

                ' Copy the bitmap data and header into the object
                Call GetDIBits(hMemDC, inPic.handle, 0, BMInfo.bmiHeader.biHeight, _
                    ByVal (hDIBPtr + lngHeadSize), BMInfo, 0)

                ' For some reason the API knocks this out on consecutive
                ' calls to GetDIBits() with a paletted image..
                BMInfo.bmiHeader.biClrUsed = OldUsed

                Call RtlMoveMemory(ByVal hDIBPtr, BMInfo, lngHeadSize)
                Call GlobalUnlock(hDIB) ' Release the memory pointer
                pfCopyStdPicture = SetClipboardData(CF_DIB, hDIB)
                If (Not pfCopyStdPicture) Then Call GlobalFree(hDIB)
            End If
        Else ' DDB
            ' Convert the picture size from OLE's high resolution metrics to twips
            SrcW = (inPic.Width * GetDeviceCaps(hMemDC, LOGPIXELSX)) / 2540
            SrcH = (inPic.Height * GetDeviceCaps(hMemDC, LOGPIXELSY)) / 2540

            ' Create a new Bitmap in compatibility with the original
            CopyBmp = CreateCompatibleBitmap(hMemDC, SrcW, SrcH)
            CopyDC = CreateCompatibleDC(0) ' Create new DC and select Bitmap
            CopyOldBmp = SelectObject(CopyDC, CopyBmp)

            ' Copy original Bitmap to the new buffer
            Call BitBlt(CopyDC, 0, 0, SrcW, SrcH, hMemDC, 0, 0, SRCCOPY)

            ' De-select copied Bitmap and destroy DC
            Call SelectObject(CopyDC, CopyOldBmp)
            Call DeleteDC(CopyDC)

            ' Assign the copied Bitmap to the clipboard
            pfCopyStdPicture = SetClipboardData(CF_BITMAP, CopyBmp)
            If (Not pfCopyStdPicture) Then Call DeleteObject(CopyBmp)
        End If

        ' De-select original bitmap and destroy DC
        Call SelectObject(hMemDC, SrcOldBmp)
        Call DeleteDC(hMemDC)

        ' We're done with the clipboard, so release it
        Call CloseClipboard
    End If
End Function 

RE: image path > stdPic > clipboard issue

What OS? If Vista or later then the OS ships with a really useful library, WIA 2.0 (Windows Image Acquisition), essentially Microsoft's wrapping of certain parts of GDI+ to replace some of the functionality lost whn the Wang/Kodak imaging controls were unbundled. If yiu have got XP, then that only ships with WIA 1.0, which has much less functionality, and all the old Microsoft download links for version 2 are long gone. However you can still find a copy here:  (simple installation instructions included).

In either case all your code can be reduced to something like:


Option Explicit

Private Sub Command1_Click()
    Clipboard.SetData NewLoadPicture("C:\Users\ploceus\All Users\H1.tif")
End Sub

' More flexible version of VB's LoadPicture method, supporting additional formats including TIF and PNG
Public Function NewLoadPicture(strPath As String) As StdPicture
    With CreateObject("WIA.ImageFile")
        .LoadFile strPath
        Set NewLoadPicture = .FileData.Picture
    End With
End Function

And not an API call in sight

(you'll find my original version of the function in thread222-1651299: How to display png graphics in picture/image box.. Pretty much the same as here, just a tiny bit more commentary)


RE: image path > stdPic > clipboard issue

Thank you, strongm, for the WIA heads up. I fondly remember the Kodak control and wasn't familiar with the WIA library. It will be useful. So tif > stdPicture is fine. However, exchanging a couple of pages of code for a mere few lines did seem a wee bit too good. I'm using VBA 7.0 and I don't believe there is a VB clipboard class available.

Absent the nice clipboard objrct, I passed the stdPic back through the clipboard function and pasted a blank rectangle again. aaargh! There is a bitmap on the clipboard with all the more or less relevant formats. Based on MS documentation, the BitmapHeaderInfo structure seems to have all the right info. Maybe the color info is buggered, but now I'm flailing.

Anyway, thanks again. If there are any further thoughts, keep them coming

RE: image path > stdPic > clipboard issue

> I don't believe there is a VB clipboard class available

Good point. Keep forgetting that inexcusable omission from VBA. There's a DLL that duplicates (pretty much) the VB clipboard object for VBA:

original author is westconn1, and you should find additional info here:

Once the dll is registered you only have to make very minor alterations to my code:


Option Explicit
Public myClipboard As New clipbrd.ClipBoard

Private Sub Command1_Click()
    myClipboard.setdata NewLoadPicture("C:\Users\ploceus\All Users\H1.tif")
End Sub

' More flexible version of VB's LoadPicture method, supporting additional formats including TIF and PNG
Public Function NewLoadPicture(strPath As String) As StdPicture
 Dim fred As New WIA.ImageFile
    With CreateObject("WIA.ImageFile")
        .LoadFile strPath
        Set NewLoadPicture = .FileData.Picture
    End With
End Function 

RE: image path > stdPic > clipboard issue

The dll isn't the preferred route, but it would have been interesting for a test. Unfortunately it won't register on Win7 32 bit. Binary and/or dependency issues. I pulled up Dependency Walker and it refused to find clipboard.dll in the Open dialog. So a bit of a rabbithole at the moment.

RE: image path > stdPic > clipboard issue

As I recall you have to register it using elevated rights

RE: image path > stdPic > clipboard issue

>The dll isn't the preferred route

The author used to happily dole out the (VB) source code.

RE: image path > stdPic > clipboard issue


Thank you for staying with this thread. You've been very helpful. I did get the clipboard.dll registered. With Windows 7 it meant placing copies of the dll in BOTH SysWow64 and System32 folders and then following the normal admin regsvr32 procedure. Otherwise, plopping the dll just in System32 and registering with admin privileges carried no weight.

The clipboard class now works as advertised and will facilitate a bit of tinkering.

I see that the vbforums site already has a queue of people asking and waiting for the source code.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close