Foro de elhacker.net

                                For lngY = 0 To tBitmapData.Height - 1
                                    For lngX = 0 To tBitmapData.Width - 1
                                    
                                        If tARGB(lngX, lngY).Alpha > 0 Then
                                            If tARGB(lngX, lngY).Alpha < 255 Then
                                            
                                                bolRet = True
                                                Exit For
                                                
                                            End If
                                        End If
                                        
                                    Next lngX

                                    If bolRet Then Exit For
                                    
                                Next lngY

Option Explicit

Private Declare Function GetMenu Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "USER32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "USER32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Const MF_BYPOSITION = &H400&

Public Sub SetMenuIcon(cForm As Form, cMenu As Long, cSubMenu As Long, cBitmap As ListImage)
    On Error Resume Next
    Dim hMenu As Long
    Dim hSubMenu As Long
    Dim Ret As Long
     
     hMenu = GetMenu(cForm.hwnd)
     hSubMenu = GetSubMenu(hMenu, cMenu)
     Ret = SetMenuItemBitmaps(hSubMenu, cSubMenu, MF_BYPOSITION, Val(cBitmap.Picture), Val(cBitmap.Picture))
     
End Sub