[Code] CommandButton menggunakan Icon 32bit

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type BUTTON_IMAGELIST
    himl As Long
    rc As RECT
    uAlign As Long
End Type

Private Declare Function ImageList_Create Lib "comctl32.dll" (ByVal cx As Long, ByVal cy As Long, ByVal Flags As Long, ByVal cInitial As Long, ByVal cGrow As Long) As Long
Private Declare Function ImageList_AddIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Declare Function PrivateExtractIconsW Lib "user32.dll" (ByVal lpIconPath As Long, ByVal Iconindex As Long, ByVal cxIcon As Long, ByVal cyIcon As Long, ByVal phIcon As Long, ByVal piIconId As Long, ByVal nIcons As Long, ByVal lFlags As Long) As Long
Private Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Enum Align
    IconLeft = 0
    IconRight = 1
    IconTop = 2
    IconBottom = 3
    IconCenter = 4
End Enum

Private Sub CommandButtonIcon1(sLibName As String, objCommandButton As CommandButton, lSize As Long, lIndex As Long, IconAlign As Align, Optional lLeftMargin As Long = 0, Optional lTopMargin As Long = 0, Optional lRightMargin As Long = 0, Optional lBottomMargin As Long = 0)
    
    Const ILC_MASK As Long = &H1
    Const ILC_COLOR32 As Long = &H20
    
    Const LR_DEFAULTCOLOR As Long = &H0
    Const LR_DEFAULTSIZE As Long = &H40
    
    Const BCM_SETIMAGELIST As Long = &H1602&

    Dim hImage As Long
    Dim hIcon As Long
    Dim BI As BUTTON_IMAGELIST
 
    hImage = ImageList_Create(lSize, lSize, ILC_COLOR32 Or ILC_MASK, 1, 1)
    Call PrivateExtractIconsW(StrPtr(sLibName), lIndex, lSize, lSize, VarPtr(hIcon), VarPtr(0), 1, LR_DEFAULTCOLOR Or LR_DEFAULTSIZE)
    Call ImageList_AddIcon(hImage, hIcon)
    Call DestroyIcon(hIcon)

    With BI
        .rc.Left = lLeftMargin
        .rc.Top = lTopMargin
        .rc.Right = lRightMargin
        .rc.Bottom = lBottomMargin
        .himl = hImage
        .uAlign = IconAlign
    End With

    Call SendMessage(objCommandButton.hwnd, BCM_SETIMAGELIST, 4, BI)

End Sub

Private Sub CommandButtonIcon2(objCommandButton As CommandButton, lSize As Long, sIconResName As String, IconAlign As Align, Optional lLeftMargin As Long = 0, Optional lTopMargin As Long = 0, Optional lRightMargin As Long = 0, Optional lBottomMargin As Long = 0)
   
    Const IMAGE_ICON = 1
    
    Const LR_LOADFROMFILE As Long = &H10
    Const LR_LOADMAP3DCOLORS As Long = &H1000
    Const LR_SHARED As Long = &H8000&
    
    Const ILC_MASK As Long = &H1
    Const ILC_COLOR32 As Long = &H20
    
    Const BCM_SETIMAGELIST As Long = &H1602&
    
    Dim hImage As Long
    Dim hIcon As Long
    Dim BI As BUTTON_IMAGELIST
   
    hImage = ImageList_Create(lSize, lSize, ILC_COLOR32 Or ILC_MASK, 1, 1)
    hIcon = LoadImage(App.hInstance, sIconResName, IMAGE_ICON, lSize, lSize, IIf(True, LR_SHARED Or LR_LOADMAP3DCOLORS, LR_LOADFROMFILE))
    Call ImageList_AddIcon(hImage, hIcon)
    DestroyIcon hIcon
     
    With BI
        .rc.Left = lLeftMargin
        .rc.Top = lTopMargin
        .rc.Right = lRightMargin
        .rc.Bottom = lBottomMargin
        .himl = hImage
        .uAlign = IconAlign
    End With
   
    Call SendMessage(objCommandButton.hwnd, BCM_SETIMAGELIST, 4, BI)
   
End Sub

Download Sample:
CommandButtonIcon.rar Update 24 Maret 2011

Advertisement