[RESOLVED] Change icon for OLE_DRAG

[some1uk03]

Is there an easy way to change the ICON when we're dragging an OLE object on the form?
I have a small picturebox with drawn stuff it.
Ideally I'd like to convert that in to an image buffer and use as an ICON when dragging it.

Any ideas?

[dilettante]

The easiest way to get an Icon type StdPicture from a Bitmap type StdPicture is probably via an instance of the ImageList control.

However trying to override the icon for an OLE dragdrop operation probably involves Custom mode and setting Screen.MousePointer. I don't have any working example but I think it was outlined in an old MS KB article.

[fafalone]

http://www.vbaccelerator.com/home/VB...s/article.html

is the method I believe dilettante is referring to.

Of course, we all know how I feel about drag/drop
So if you want to do the much more complicated task of dragging a picturebox image as the standard clipboard PNG format, such that it can be dragged to other applications too, brace yourself:




[VB6] Drag drop any format to other apps without custom IDataObject

[some1uk03]

Great resources there fafalone.
I've been going through your example and trying to figure out things.

Initially the idea was to

have a small picturebox with drawn stuff in it, then convert that in to an image buffer and use as an ICON when dragging it.

That is no longer the case. To simplify, I'd like to use the ExtractAssociatedIcon API to get an ICON from the .exe [be it mine or shell32] and use that Icon as the image instead of the PNG you have.

Question1 is: What format do we register the ClipboardFormat as? CF_BITMAP?
Question2 is: Instead of the IShellItemImageFactory, i should be using IExtractIconA right? How do i go about using it to place the ExtractAssociatedIcon there?

[some1uk03]

*bump*

[some1uk03]

Still no one has an idea on this? :/

[fafalone]

Sorry I haven't been online for a while.

The Demo project is showing how to use an HBITMAP as the drag image, and to get one of those (without a messy conversion), you'd really want to use IShellItemImageFactory (you can specify the SIIGBF_ICONONLY option to avoid getting a thumbnail of some files instead its icon) unless you're trying to get an icon that's not the one displayed by default, if you are then I believe you can just use IExtractImage instead of IExtractIcon to similarly avoid having to manually do the HICON->HBITMAP conversion. (Edit: Maybe not, I don't recall if it handles adding an index to the file location... there's lots of examples of manually doing that conversion but good luck getting one that doesn't screw up transparency, haven't figured that out myself, lots of ones that say they do actually don't, at least in VB).
You register it as the underlying format of the actual image data, not the thumbnail you're using for the drag image... like the demo registers as CF_PNG despite generating a bitmap thumbnail.

[some1uk03]

Thanks for getting back. I'm finally getting somewhere....

Not using the IShellItemImageFactory (this only returns the default image/icon) or the IExtractImage or IExtractIcon.
I also don't need to worry about transparency/alpha as non of my icons have alpha. They're full Icons.

Instead, I'm extracting an Icon index from my .exe and doing a hIcon->hBitmap conversion and passing it on to the hbmpDragImage. [which works]
BUT
the drawn Icon, seems very transparent and I don't understand why... Any Idea?

Dim hScr As Long
Dim hDev As Long

Dim hbmp As Long
Dim hbmpOld As Long

'cx = GetSystemMetrics(SM_CXSMICON)
'cy = GetSystemMetrics(SM_CYSMICON)

hScr = GetDC(0&)
hDev = CreateCompatibleDC(hScr)

hbmp = CreateCompatibleBitmap(hDev, cx, cy)
hbmpOld = SelectObject(hDev, hbmp)


Call DrawIconEx(hDev, 0, 0, hIcon, cx, cy, 0, 0, DI_NORMAL)

Call SelectObject(hDev, hbmpOld)
Call DeleteDC(hDev)
Call ReleaseDC(0&, hScr)

[fafalone]

You mean it's making pixels transparent that are opaque in the icon, or just that the whole icon looks ghosted? If it's the latter, that's how it's supposed to work, as you see in Explorer:

It's a visual cue so you can see the icon being dragged amidst other nearby icons.

[some1uk03]

Not like the Windows ghosted, The whole ICON looks ghosted. Literally any colour is gone.
Think of the image you posted above and set the transparency to %10 in photoshop .. That's how invisible it is. Can hardly see anything.

Edit:
Here's an example on a Gray BackGround.

[fafalone]

If it's looking different than Explorer (I'd recommend testing those specific icons), then it's gotta be a problem with the conversion, but I'm really clueless when it comes to drawing apis; though I use the same routine you posted to convert icons for menus... what's it look like when you render it into a picturebox? And is this ExtractIconEx or IExtractIcon... might want to see if those produce different results too.

[some1uk03]

well, the Icon formats are fine, because even with SHELL32 icon, this is what we get.
Drawing it on a picture box is fine but as a DragIcon, all colours get lost?
It's as if it's extracting a MASK of the icon only?
I wonder if we need to BitBlt it first?

Im using ExtractAssociatedIcon & DrawIconEx to get and draw the Icons.

[LaVolpe]

Hopefully not too far off base. Can't see your sample images (issue on my end as pc is locked down fairly hard).

When using CreateCompatibleBitmap, the type of created bitmap is same as in the DC that was passed to the API. This means it is likely 32bpp, depending on screen depth. If cx or cy is zero, then you are looking at a 1x1 black/white bitmap.

So, let's assume a 32bpp bitmap. Is the alpha channel being used?

Don't know. As a test...
- Before selecting the bitmap into the DC for DrawIconEx, call FillMemory API on the entire bitmap with byte 255. That makes the entire bitmap white initially and an alpha channel of 100% opacity.

The catch is that you need to know if this is a 32bpp DIB first else you will miscalculate the number of bytes to fill or won't have the pixel data memory location. Unless you use CreateDIBSection forcing 32bpp instead of CreateCompatibleBitmap, you should test the depth: API GetObject

[some1uk03]

Hi LaVolpe,

Technically it does it with every ICON I've tried (plenty to test with any system .dll/exe)
I believe you're right, it's assuming a 32bpp bitmap as it's masking any dark colour and uses white to display.

cx = 48 | cy = 48 for a 48x48 Icon.

I've never used the FillMemory API. Researched a little and when trying, it's crushing down VB. So there's a mem leak somewhere :/
To simplify, I don't want to use 32bpp as the Icons don't have ALPHA channels.

[LaVolpe]

Now that I can see your images, I don't think the alpha channel is the culprit. What value is your DI_Normal set at?

[some1uk03]

Now that I can see your images, I don't think the alpha channel is the culprit. What value is your DI_Normal set at?

DI_Normal = 3 | I've tried H1 / H2 to no avail. (change is only reflected on the pictureBox)

As a work around, can't we BitBlt the image in to a tmpDC and use that as the Image source?

[LaVolpe]

Can you try something, let's see what type of bitmap we are playing with:

APIs

Private Declare Function GetObjectA Lib "gdi32.dll" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Type BITMAP             ' primarily used to test for DIB vs DDB and bit count of hBitmap
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long              ' 0 = DDB, non-zero = DIB (preferred for bitmaps <= 8 bpp)
End Type

After you create your compatable bitmap, pass it to this call

    Dim uBMP As BITMAP
Debug.Print "return value: "; GetObjectA(hbmp, 24&, uBMP)
Debug.Print vbTab; "BitCount: "; uBmp.bmBitsPerPixel
Debug.Print vtTab; "Bits Ptr: "; uBmp.bmBits

What gets printed out?

[fafalone]

Actually I just noticed... the routine I've been using isn't identical to yours after all. Instead of CreateCompatibleBitmap, I've got a function called Create32BitHbitmap that the hDC from CreateCompatibleDC is passed to...

Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any, ByVal Handle As Long, ByVal dw As Long) As Long
Private Const DIB_RGB_COLORS        As Long = 0&
Private Type BITMAPINFOHEADER
   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 BITMAPINFO
   bmiHeader                As BITMAPINFOHEADER
   bmiColors(3)             As Long
End Type


Private Function Create32BitHBITMAP(hDC As Long, CX As Long, CY As Long) As Long
Dim bmi As BITMAPINFO
    bmi.bmiHeader.biSize = Len(bmi.bmiHeader)
    bmi.bmiHeader.biPlanes = 1
    bmi.bmiHeader.biCompression = 0

    bmi.bmiHeader.biWidth = CX
    bmi.bmiHeader.biHeight = CY
    bmi.bmiHeader.biBitCount = 32
    Create32BitHBITMAP = CreateDIBSection(hDC, bmi, DIB_RGB_COLORS, ByVal 0&, 0, 0)
    
End Function

Private Function HBitmapFromHIcon(hIcon As Long, CX As Long, CY As Long) As Long
Dim hDC As Long
Dim hBackDC As Long
Dim hBitmap As Long
Dim hBackSV As Long

hDC = GetDC(0)
hBackDC = CreateCompatibleDC(hDC)
hBitmap = Create32BitHBITMAP(hBackDC, CX, CY)

hBackSV = SelectObject(hBackDC, hBitmap)
DrawIconEx hBackDC, 0, 0, hIcon, CX, CY, 0, 0, DI_NORMAL

Call SelectObject(hBackDC, hBackSV)
Call ReleaseDC(0, hDC)
Call DeleteDC(hBackDC)
HBitmapFromHIcon = hBitmap
End Function

Give that a try.

[dilettante]

I'm not sure what is going on here but it sounds like the current question in this tangled thread is about dealing with an unwanted appearance of mouse cursor graphics. Isn't this dependent upon the video adapter and its installed driver? Some combinations have a more limited range of device capabilities.

[LaVolpe]

@dilettante. I'm leaning towards a B&W bitmap returned. That could explain the white-washed image

[fafalone]

The cursor is still present; not changed-- see my pictures in post #3... we're using a shell interface explicitly designed to set a drag icon. I suppose if they're rendered by the same subsystem there might be an issue like that, but even my dirt cheap crappy old laptop has no trouble.

And yeah what LaVolpe said sounds right, I'm hoping the Create32BitHbitmap routine instead of CreateCompatibleBitmap takes care of it. If I'm not mistaken I went through similar graphical glitches while trying to find an acceptable icon->bitmap routine.

[some1uk03]

LaVolpe:
Debug Info returns:

return value:  24 
BitCount:  1 
Bits Ptr:  0

But Finally... issue resolved

Fafalone: You're functions seem to have fixed the issue with the Create32BitHbitmap function.

Thanks for the help guys.

[LaVolpe]

As I suspected, a B&W bitmap was the problem.

You may not have needed another function. Passing the form's hDC into CreateCompatibleBitmap may have been all that was required, i.e., hbmp = CreateCompatibleBitmap(Me.hDC, cx, cy)

[some1uk03]

As I suspected, a B&W bitmap was the problem.

You may not have needed another function. Passing the form's hDC into CreateCompatibleBitmap may have been all that was required, i.e., hbmp = CreateCompatibleBitmap(Me.hDC, cx, cy)

Actually spot on!!! Just tested. me.hDC was all that was needed.

[dilettante]

ImageList Controls can do some of the heavy lifting though. This example may be too simple or way off the desired goal but it is a simple approach within its limits:



Lower-left had been dragged/dropped into the right, and now upper-left has been dragged but not yet dropped into the right PictureBox.

Option Explicit

'CHEATS:
'
'   o Assumes 96 DPI so that the mouse cursor is 32x32, though at High DPI settings
'     the image should be scaled up, it will just look pixelated.  There are
'     several ways of dealing with this but they all require more code to adjust
'     the Imagelist dimensions and the overlay image.
'
'   o Our ImageList uses a MaskColor of vbGreen.  Since we'll be creating Mouseicon
'     values from the Picture1(x).Picture properties those images also use vbGreen
'     for transparent areas.
'
'ISSUES:
'
'   o Since we are using Picture2.OLEDropMode = vbOLEDropAutomatic and we are
'     stuffing Picture1(x).Picture's image value into the DataObject... when the
'     result of dragdrop appears the "transparent" area gets rendered without
'     transparency,  so we'll see aras of vbGreen.  Again, with more effort we
'     could deal with that.

Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Picture1(Index).OLEDrag
End Sub

Private Sub Picture1_OLECompleteDrag(Index As Integer, Effect As Long)
    Screen.MousePointer = vbDefault
    With ImageList1.ListImages
        If .Count > 1 Then
            .Remove 3
            .Remove 2
        End If
    End With
End Sub

Private Sub Picture1_OLEGiveFeedback(Index As Integer, Effect As Long, DefaultCursors As Boolean)
    If (Effect And vbDropEffectCopy) Then
        DefaultCursors = False
        With ImageList1
            .ListImages.Add 2, , Picture1(Index).Picture
            .ListImages.Add 3, , .Overlay(2, 1)
            Screen.MousePointer = vbCustom
            Set Screen.MouseIcon = .ListImages(3).ExtractIcon
        End With
    End If
End Sub

Private Sub Picture1_OLEStartDrag(Index As Integer, Data As DataObject, AllowedEffects As Long)
    With Data
        .Clear
        .SetData Picture1(Index).Picture, ccCFBitmap
    End With
    AllowedEffects = vbDropEffectCopy
End Sub

[some1uk03]

dilettante: That's a pretty neat example too, which removes a lot of the heavy stuff, I agree.
But I'm quite against using external controls (commonControls) which is required for the ImageList.

Maybe if I hadn't fixed the issue, I would have resorted to this option