[RESOLVED] Resize stdPicture

[Episcopal]

Hey, guys ...

I'm using the DrawState API to draw a disabled image. So far so good. The problem is that the image is 32x32 and I need to draw with 48x48. The API is not doing this.

I was wondering if there is a way to resize the stdPicture before sending it to the DrawState API?

Thanks

[VanGoghGaming]

Put the image in a hBitmap, use StretchBlt and then create a StdPicture from the hBitmap. Or you can put it in an ImageControl that does the stretching for you!

[Episcopal]

But it's icons, not Bitmap

[VanGoghGaming]

Ugh, I don't have any experience with icons. Are they not bitmaps as well?

[Episcopal]

no .... icons have transparency

[-Franky-]

Just an idea. Split the icon into the color and mask bitmap -> GetIconInfo. Enlarge both and reassemble them into one icon with CreateIconIndirect.

[baka]

stdPicture can be used to create a gdi+ bitmap. and from there its left explanatory.
but the best way would be to not use the stdPicture but the source and load it directly into gdi+ bitmap.
but I believe a stdPicture is 24bit so not sure how u could retrieve the alpha at all.
so gdi32 is enough.

[Elroy]

Do icons have a true alpha channel?

Or is it just a specified background color, like a GIF? (i.e., mask alpha)

[Schmidt]

The cGDIPlusCache-class in the CodeBank can resize any IconFile (or IconByteArray) "on-load" into the desired size.

GC.AddIcon "MyIconKey", IconFileNameOrByteArray, 48, 48

After Loading, any (pre-sized) Alpha-Resorce is represented (and held) within the Cache as a GDIPlus-(Alpha)-image.
(so, after loading it does not really matter, from where the resource originated, be it an *.ico or a *.png or a *.gif).

One can then draw these (resized already "onload") Alpha-Images to hDCs directly (using one of the Drawxxx or AlphaRender-methods) -
but also retrieve different GDI- (not GDIPlus-) Handles from them via StringKey ...

as e.g.:
- hIcon = GC.GetHIconFromImage("MyIconKey") ...and if needed later: GC.DestroyHIcon(hIcon)
- hCursor = GC.GetHCursorFromImage("MyIconKey") ...and if needed later: GC.DestroyHCursor(hCursor)
- hBmp = GC.GetHBmpFromImage("MyIconKey") ...and if needed later: GC.DestroyHBmp(hBmp)

The GC.Destroy... methods above are not needed, when you wrap such a GDI-Handle up behind a StdPicture-returning Picture-Property - as shown in #32 in the CodeBank-Thread:
https://www.vbforums.com/showthread....=1#post5589925

HTH

Olaf

[wqweto]

Do icons have a true alpha channel?

Or is it just a specified background color, like a GIF? (i.e., mask alpha)

Both variants exist.

New (since Win8) is that 32-bit DIBs w/ alpha channel can be converted to an hIcon and this in turn to an StdPicture of vbPicTypeIcon sub-type.

Unfortunately StdPicture.Render does not use DrawIconEx to paint vbPicTypeIcon's but custom paints color+mask icons because it was implemented before DrawIconEx was available but DrawIcon cannot *resize* the icon so COM team had to use StretchBlt and ROP hacks to implement mask transparency *and* resize to target size on StdPicture.Render.

Later when DrawIconEx became available no one bothered to refactor StdPicture.Render and still later in Win8+ we have true 32-bit icons which cannot be rendered by StdPictures in VB6 unless custom rendered w/ DrawIconEx which some commercial Ax Controls actually do.

cheers,
</wqw>

[Episcopal]

I managed to solve the sizing with BitBlt, but the drawstate insists on drawing with 32x32.

[baka]

bitblt is a copy while StretchBlt will allow to size it as well.
if u want to place it in the same stdpicture, u will need to first copy it to a memoryDC
after that resize the stdpicture and use stretchblt it back with the size of your choice.
not sure what drawstate api is never used it.

[Episcopal]

Dim lPic As Picture
Set lPic = Picture
Call StretchBlt(GetDC(lPic.Handle), 0, 0, 48, 48, GetDC(m_This.Picture.Handle), 0, 0, 48, 48, vbSrcCopy)
Call DrawState(.hDC, 0, 0, lPic, 0, (50 / 15), ((.ScaleWidth - 720) / 2) / 15, 48, 48, DST_ICON Or DSS_DISABLED)

is not resizing

[VanGoghGaming]

I thought GetDC needs a hWnd parameter, not a hBitmap...

[Episcopal]

I thought GetDC needs a hWnd parameter, not a hBitmap...

GetDC(lPic.Handle)

lPic.handle = lPic.hwnd

[VanGoghGaming]

That is a handle to a Bitmap, not a handle to a Window.

https://learn.microsoft.com/en-us/wi...ure-get_handle

[dilettante]

Seems to work as documented for me (icons don't get automagic stretching):

CallBacks.bas:

Option Explicit

Private Const WIN32_NULL As Long = 0

Private Enum DI_FLAGS
    DI_NORMAL = &H3&
End Enum

Private Declare Function DrawIconEx Lib "user32" ( _
    ByVal hDC As Long, _
    ByVal xLeft As Long, _
    ByVal yTop As Long, _
    ByVal hIcon As Long, _
    Optional ByVal cxWidth As Long = 0, _
    Optional ByVal cyWidth As Long = 0, _
    Optional ByVal istepIfAniCur As Long = 0, _
    Optional ByVal hbrFlickerFreeDraw As Long = WIN32_NULL, _
    Optional ByVal diFlags As DI_FLAGS = DI_NORMAL) As Long

Public Function StretchIconCB( _
    ByVal hDC As Long, _
    ByVal hIcon As Long, _
    ByVal wData As Long, _
    ByVal cx As Long, _
    ByVal cy As Long) As Long

    StretchIconCB = DrawIconEx(hDC, 0, 0, hIcon, cx, cy)
End Function

Form1.frm:

Option Explicit

Private Const WIN32_NULL As Long = 0

Private Enum DST_DSS
    DST_COMPLEX = 0&
    DST_ICON = &H3&

    DSS_DISABLED = &H20&
End Enum

Private Declare Function DrawState Lib "user32" Alias "DrawStateW" ( _
    ByVal hDC As Long, _
    ByVal hbrFore As Long, _
    ByVal qfnCallBack As Long, _
    ByVal lData As Long, _
    ByVal wData As Long, _
    ByVal X As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal uFlags As DST_DSS) As Long

Private Sub Form_Load()
    AutoRedraw = True
    ScaleMode = vbPixels
    DrawWidth = 1
    Line (9, 9)-(57, 57), vbRed, B
    DrawState hDC, _
              WIN32_NULL, _
              AddressOf CallBacks.StretchIconCB, _
              LoadPicture("Sample32.ico", vbLPCustom, , 32, 32).Handle, _
              0, _
              10, _
              10, _
              48, _
              48, _
              DST_COMPLEX Or DSS_DISABLED
End Sub

[dilettante]

Note that there DrawState() does a lot of heavy lifting, such as creating and deleting the intermediate memory DC for you just as DrawIconEx() does when rendering. So there are TWO temporary DCs involved this way but you do not need to manage any yourself.

[dilettante]

Also note that stretching sizes upward always produces jaggy results. Better to scale down from a larger common size instead.

To do better requires fiddling to size with resampling and anti-aliasing and even then it can be blocky. It isn't worth the trouble for UI elements: just size down from larger sizes instead and provide several sizes in ICO resources to help match detail levels to rendered sizes better.

[Episcopal]

Seems to work as documented for me (icons don't get automagic stretching):

CallBacks.bas:

Option Explicit

Private Const WIN32_NULL As Long = 0

Private Enum DI_FLAGS
    DI_NORMAL = &H3&
End Enum

Private Declare Function DrawIconEx Lib "user32" ( _
    ByVal hDC As Long, _
    ByVal xLeft As Long, _
    ByVal yTop As Long, _
    ByVal hIcon As Long, _
    Optional ByVal cxWidth As Long = 0, _
    Optional ByVal cyWidth As Long = 0, _
    Optional ByVal istepIfAniCur As Long = 0, _
    Optional ByVal hbrFlickerFreeDraw As Long = WIN32_NULL, _
    Optional ByVal diFlags As DI_FLAGS = DI_NORMAL) As Long

Public Function StretchIconCB( _
    ByVal hDC As Long, _
    ByVal hIcon As Long, _
    ByVal wData As Long, _
    ByVal cx As Long, _
    ByVal cy As Long) As Long

    StretchIconCB = DrawIconEx(hDC, 0, 0, hIcon, cx, cy)
End Function

Form1.frm:

Option Explicit

Private Const WIN32_NULL As Long = 0

Private Enum DST_DSS
    DST_COMPLEX = 0&
    DST_ICON = &H3&

    DSS_DISABLED = &H20&
End Enum

Private Declare Function DrawState Lib "user32" Alias "DrawStateW" ( _
    ByVal hDC As Long, _
    ByVal hbrFore As Long, _
    ByVal qfnCallBack As Long, _
    ByVal lData As Long, _
    ByVal wData As Long, _
    ByVal X As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal uFlags As DST_DSS) As Long

Private Sub Form_Load()
    AutoRedraw = True
    ScaleMode = vbPixels
    DrawWidth = 1
    Line (9, 9)-(57, 57), vbRed, B
    DrawState hDC, _
              WIN32_NULL, _
              AddressOf CallBacks.StretchIconCB, _
              LoadPicture("Sample32.ico", vbLPCustom, , 32, 32).Handle, _
              0, _
              10, _
              10, _
              48, _
              48, _
              DST_COMPLEX Or DSS_DISABLED
End Sub

Dil...... your VB6 sample library should be approaching 20TB....

Thank you very much ...... it worked ..... although I don't like using CallBack ...... but everything is fine.

[dilettante]

Well you might do it all manually.

Create a memory DC, create and select a monochrome bitmap into it, DrawIconEx into that. Then TransparentBlt from that to your destination. Clean up the temporary GDI objects.

[Episcopal]

I don't know how to do this....... I have to look at some examples to see how it works..... I don't have the skills to work with images.

[dilettante]

I'd just use the callback. Using those two API calls that way saves a lot of lines of code and potential mistakes.

[Schmidt]

I don't know how to do this...

Did you try it with the cGDIPlusCache-Class?
(it's just a few, easy to understand lines)...

Just make sure, to add the Class-File (cGDIPlusCache.cls) from the example in the CodeBank-Link into your Project -
after that the following Form-Code should work...

Option Explicit
 
Private Declare Function DrawStateW Lib "user32" (ByVal hDC As Long, ByVal hbrFore As Long, ByVal qfnCallBack As Long, ByVal lData As Long, ByVal wData As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long

Public GC As New cGDIPlusCache 'normally placed in a *.bas-Module (as a true, global Object)

Private Sub Form_Load() 'add two differently sized Icons into the cache (from the same Ico-File)
  GC.AddIcon "Ico32", "c:\temp\favicon.ico", 32, 32
  GC.AddIcon "Ico48", "c:\temp\favicon.ico", 48, 48
  Caption = "Click me, repeatedly"
End Sub

Private Sub Form_Click()
  Static IcoDisabled As Boolean
  Cls
     RenderCachedIconTo hDC, 10, 10, "Ico32", IcoDisabled 'render the smaller one
     RenderCachedIconTo hDC, 50, 10, "Ico48", IcoDisabled 'and the larger one as well
  IcoDisabled = Not IcoDisabled 'switch the Disabled-flag after each Click
End Sub

Private Sub RenderCachedIconTo(hDC, x, y, GC_Key, Optional ByVal Disabled As Boolean)
  Dim hIcon As Long: Const DST_ICON = &H3&, DSS_DISABLED = &H20&
  
  hIcon = GC.GetHIconFromImage(GC_Key) 'retrieve the Icon from the Cache via String-Key
  
  DrawStateW hDC, 0, 0, hIcon, 0, x, y, 0, 0, DST_ICON Or IIf(Disabled, DSS_DISABLED, 0)
  
  GC.DestroyHIcon hIcon 'don't leak the icon-Handle after the render-call above
End Sub

Note, that this approach has not only a better "Stretching-Quality" (compared with DrawIconEx) -
but it will work as well, in case you add *.png or *.gif Images into the Cache instead of *.ico (in Form_Load)...

HTH

Olaf

[Episcopal]

I found this code that puts it in grayscale ...

Private Function GrayScalePicture()
    Dim Color As Long, intMix As Integer
    Dim intX As Long, intY As Long
    Dim YRes As Long, XRes As Long
    Dim R As Long, G As Long, B As Long

    YRes = Picture1.ScaleHeight - 1
    XRes = Picture1.ScaleWidth - 1
    For intY = 0 To YRes
        For intX = 0 To XRes
            Color = Picture1.Point(intX, intY)
            B = Color \ 65536
            G = (Color - B * 65536) \ 256
            R = Color - B * 65536 - G * 256
            intMix = CInt(R * 0.3 + G * 0.59 + B * 0.11)
            Picture2.PSet (intX, intY), RGB(intMix, intMix, intMix)
        Next
    Next

 End Function

I have no experience in this, but this does not work ...

Private Function GrayScaleImage(ByVal stdPic As StdPicture) As StdPicture
    Dim Color As Long, intMix As Integer
    Dim intX As Long, intY As Long
    Dim YRes As Long, XRes As Long
    Dim R As Long, G As Long, B As Long
    Dim tmpPic As StdPicture
    Dim memDC As Long, tmpDC As Long
    
    Set tmpPic = New StdPicture
    
    memDC = CreateCompatibleDC(0)
    tmpDC = CreateCompatibleDC(0)
    
    YRes = stdPic.Height - 1
    XRes = stdPic.Width - 1

    For intY = 0 To YRes
        For intX = 0 To XRes
            SelectObject memDC, stdPic.Handle
            Color = GetPixel(memDC, intX, intY)
            B = Color \ 65536
            G = (Color - B * 65536) \ 256
            R = Color - B * 65536 - G * 256
            intMix = CInt(R * 0.3 + G * 0.59 + B * 0.11)
            SelectObject tmpDC, tmpPic.Handle
            Call SetPixel(tmpDC, intX, intY, RGB(intMix, intMix, intMix))
        Next
    Next
    Set GrayScaleImage = tmpPic
    DeleteDC memDC
    DeleteDC tmpDC
    
 End Function

What do I do to make it work?

[VanGoghGaming]

StdPic uses Himetric coordinates which you need to convert to pixels and then it will work:

XRes = Me.ScaleX(stdPic.Width, vbHimetric, vbPixels) - 1
YRes = Me.ScaleY(stdPic.Height, vbHimetric, vbPixels) - 1

[VanGoghGaming]

My bad, I haven't read your code carefully. You can't modify StdPicture handles like that. Here's the revised code that works to convert a color picture to grayscale:

Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef PicDesc As PICTDESC, ByRef IID As UUID, ByVal fOwn As Long, ByRef IPicture As IPicture) As Long

Private Function MonoRGB(cRGB As Long) As Long
Dim cRGBQ As RGBQUAD
    CopyMemory ByVal VarPtr(cRGBQ), cRGB, 4
'    MonoRGB = 0.299 * cRGBQ.rgbRed + 0.587 * cRGBQ.rgbGreen + 0.114 * cRGBQ.rgbBlue ' Standard quality
    MonoRGB = 0.2126 * cRGBQ.rgbRed + 0.7152 * cRGBQ.rgbGreen + 0.0722 * cRGBQ.rgbBlue ' Better quality
'    MonoRGB = (0.2126 * cRGBQ.rgbRed ^ 2.2 + 0.7152 * cRGBQ.rgbGreen ^ 2.2 + 0.0722 * cRGBQ.rgbBlue ^ 2.2) ^ (1 / 2.2) ' Best quality but slow due to exponentiation
    MonoRGB = RGB(MonoRGB, MonoRGB, MonoRGB)
End Function

Private Function GrayScaleImage(colorPic As IPicture) As IPicture
Dim i As Long, j As Long, lWidth As Long, lHeight As Long, BitmapPixels() As Long, lStockBitmap As Long, memDC As Long, lDesktopDC As Long, bmiBitmapInfo As BITMAPINFO, IID_IPicture As UUID, PicDesc As PICTDESC
    lWidth = Me.ScaleX(colorPic.Width, vbHimetric, vbPixels): lHeight = Me.ScaleY(colorPic.Height, vbHimetric, vbPixels)
    ReDim BitmapPixels(0 To lWidth - 1, 0 To lHeight - 1): PicDesc.cbSizeofstruct = LenB(PicDesc): PicDesc.picType = vbPicTypeBitmap
    lDesktopDC = GetDC(0): memDC = CreateCompatibleDC(0)
    PicDesc.hgdiobj = CreateCompatibleBitmap(lDesktopDC, lWidth, lHeight)
    lStockBitmap = SelectObject(memDC, PicDesc.hgdiobj)
    colorPic.Render memDC, 0, 0, lWidth, lHeight, 0, colorPic.Height, colorPic.Width, -colorPic.Height, 0
    With bmiBitmapInfo.bmiHeader
        .biSize = LenB(bmiBitmapInfo.bmiHeader): .biPlanes = 1: .biBitCount = 32: .biCompression = BI_RGB
        .biWidth = lWidth: .biHeight = -lHeight
        .biSizeImage = (((.biWidth * .biBitCount) + 31) \ 32) * 4 * lHeight
    End With
    GetDIBits memDC, PicDesc.hgdiobj, 0, lHeight, BitmapPixels(0, 0), bmiBitmapInfo, DIB_RGB_COLORS
    For i = 0 To lWidth - 1
        For j = 0 To lHeight - 1
            BitmapPixels(i, j) = MonoRGB(BitmapPixels(i, j))
        Next j
    Next i
    SetDIBits memDC, PicDesc.hgdiobj, 0, lHeight, BitmapPixels(0, 0), bmiBitmapInfo, DIB_RGB_COLORS
    IIDFromString "{7BF80980-BF32-101A-8BBB-00AA00300CAB}", IID_IPicture
    OleCreatePictureIndirect PicDesc, IID_IPicture, 1, GrayScaleImage
    SelectObject memDC, lStockBitmap: DeleteDC memDC: ReleaseDC 0, lDesktopDC
 End Function

I have provided the "OleCreatePictureIndirect" declaration for you. The rest are standard GDI functions, types and constants which you can declare yourself. Alternatively you can download Bruce MCKinney's typelib which already contains all these declarations so you can run the code straight away.

[Episcopal]

I have provided the "OleCreatePictureIndirect" declaration for you. The rest are standard GDI functions, types and constants which you can declare yourself. Alternatively you can download Bruce MCKinney's typelib which already contains all these declarations so you can run the code straight away.

It works, but where it's white it paints it black...



Edit: This way works with icons
Set Image1.Picture = GrayScaleImage(Picture1.Image)

[VanGoghGaming]

It works, but where it's white it paints it black...

The Rolling Stones approve:



I don't know about icons but with bitmaps it works flawlessly, I don't post untested code!

[Episcopal]

Option Explicit

Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 '  color table in RGBs

Private Type PICTDESC
   cbSizeOfStruct As Long
   picType As Long
   hgdiObj As Long
   hPalOrXYExt As Long
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
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 As RGBQUAD
End Type
Private Type Guid
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef PicDesc As PICTDESC, ByRef IID As Guid, ByVal fOwn As Long, ByRef IPicture As IPicture) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Function GrayScaleImage(colorPic As IPicture) As IPicture
Dim i As Long, j As Long, lWidth As Long, lHeight As Long, BitmapPixels() As Long, lStockBitmap As Long, memDC As Long, lDesktopDC As Long, bmiBitmapInfo As BITMAPINFO, IID_IPicture As Guid, PicDesc As PICTDESC
    lWidth = Me.ScaleX(colorPic.Width, vbHimetric, vbPixels): lHeight = Me.ScaleY(colorPic.Height, vbHimetric, vbPixels)
    ReDim BitmapPixels(0 To lWidth - 1, 0 To lHeight - 1): PicDesc.cbSizeOfStruct = LenB(PicDesc): PicDesc.picType = vbPicTypeBitmap
    lDesktopDC = GetDC(0): memDC = CreateCompatibleDC(0)
    PicDesc.hgdiObj = CreateCompatibleBitmap(lDesktopDC, lWidth, lHeight)
    lStockBitmap = SelectObject(memDC, PicDesc.hgdiObj)
    colorPic.Render memDC, 0, 0, lWidth, lHeight, 0, colorPic.Height, colorPic.Width, -colorPic.Height, 0
    With bmiBitmapInfo.bmiHeader
        .biSize = LenB(bmiBitmapInfo.bmiHeader): .biPlanes = 1: .biBitCount = 32: .biCompression = BI_RGB
        .biWidth = lWidth: .biHeight = -lHeight
        .biSizeImage = (((.biWidth * .biBitCount) + 31) \ 32) * 4 * lHeight
    End With
    GetDIBits memDC, PicDesc.hgdiObj, 0, lHeight, BitmapPixels(0, 0), bmiBitmapInfo, DIB_RGB_COLORS
    For i = 0 To lWidth - 1
        For j = 0 To lHeight - 1
            BitmapPixels(i, j) = MonoRGB(BitmapPixels(i, j))
        Next j
    Next i
    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
    SetDIBits memDC, PicDesc.hgdiObj, 0, lHeight, BitmapPixels(0, 0), bmiBitmapInfo, DIB_RGB_COLORS
    OleCreatePictureIndirect PicDesc, IID_IPicture, 1, GrayScaleImage
    SelectObject memDC, lStockBitmap: DeleteDC memDC: ReleaseDC 0, lDesktopDC
 End Function

This works without tlb ....

[Episcopal]

Now the problem is the transparency of the icon.

[VanGoghGaming]

Obviously it works without the TLB but you're missing the point. You WANT the TLB unless you enjoy copy-pasting chunks of declarations.

Also if your original image had an alpha channel, you can preserve it in the MonoRGB function. Also made it into a SUB for faster execution speed:

Private Sub MonoRGB(cRGB As Long)
Dim cRGBQ As RGBQUAD
    CopyMemory ByVal VarPtr(cRGBQ), cRGB, 4
    With cRGBQ
        .rgbRed = 0.2126 * .rgbRed + 0.7152 * .rgbGreen + 0.0722 * .rgbBlue
        .rgbGreen = .rgbRed: .rgbBlue = .rgbRed
    End With
    CopyMemory cRGB, ByVal VarPtr(cRGBQ), 4
End Sub

Now the loop through the bitmap pixels looks like this:

    For i = 0 To lWidth - 1
        For j = 0 To lHeight - 1
            Call MonoRGB(BitmapPixels(i, j))
        Next j
    Next i

Does this fix your transparency issue?

[Episcopal]

Obviously it works without the TLB but you're missing the point. You WANT the TLB unless you enjoy copy-pasting chunks of declarations.

Yes, I prefer to paste the statements, I don't like to reference anything, it's an old custom.

Does this fix your transparency issue?

No it is returning black color where it is transparent....