急!提取图标后,如何将图标直接保存到ImageList中去

Question

我用ExtractAssociatedIcon获取程序图标句柄后能画到picture中,不知道怎样
把图标直接添加到imagelist中去,请高手指点!下面是这是我的代码
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" _
                Alias "ExtractAssociatedIconA" _
                (ByVal hInst As Long, _
                ByVal lpIconPath As String, _
                lpiIcon As Long) _
                As LongPrivate Declare Function DrawIcon Lib "user32" _
                (ByVal hdc As Long, _
                ByVal x As Long, _
                ByVal y As Long, _
                ByVal hIcon As Long) _
                As LongPrivate Sub Form_Paint()
    Dim hIcon As Long
    Dim IconIndex As Long
    IconIndex = 0
    hIcon = ExtractAssociatedIcon(App.hInstance, "程序路径", IconIndex)
    Set Me.Picture1.Picture = LoadPicture()
    Me.Picture1.AutoRedraw = True
    DrawIcon Me.Picture1.hdc, 10, 10, hIcon
    Picture1.AutoRedraw = False
    Picture1.Refresh
 End Sub

Answer 1

我用picture中转,再用ImageList2.ListImages.Add I, , Picture1.Image把图标加进去,
但加进去的图标只是picture的复制,像个截图,图标成了不透明的,因为背景经常换,看着很不爽!不知道怎样把这样获取的图标直接添加到imagelist中去

Answer 2

可以用 ImageList_Add ,也可以先转换hIcon为StdPicture

Answer 3

我走了个弯路,算解决了吧,但还是要求教高手如何直接存储
我的方法是还用picture做中转,把picture的背景颜色值和ImageList.MaskColor 的颜色值设一样就达到效果了,这个颜色值一定要使用非系统颜色值

Answer 4

使用这个模块把hIcon转换为Icon，不需要PictureBox控件。
Me.Picture = CreateOlePicture(Me.Icon.Handle, vbPicTypeIcon)    Option Explicit    Public Const PICTYPE_UNINITIALIZED = -1
    Public Const PICTYPE_NONE = 0
    Public Const PICTYPE_BITMAP = 1
    Public Const PICTYPE_METAFILE = 2
    Public Const PICTYPE_ICON = 3
    Public Const PICTYPE_ENHMETAFILE = 4
     
    Public Type Guid
     Data1 As Long
     Data2 As Integer
     Data3 As Integer
     Data4(7) As Byte
    End Type
     
    Public Type PICTDESC_ALL
     cbSizeofStruct As Long 
     PicType As Long 
     hPalette As Long 
     reserved As Long 
    End Type
     
  
    Public Type PICTDESC_BMP 'picType = PICTYPE_BITMAP
     cbSizeofStruct As Long 
     PicType As Long 
     hBitmap As Long 
     hPal As Long 
    End Type
     
    ' Type - OleCreatePictureIndirect / OleLoadPicture
    Public Type PICTDESC_META 'picType = PICTYPE_METAFILE
     cbSizeofStruct As Long 'UINT // Size of the PICTDESC structure.
     PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
     hMeta As Long 'HMETAFILE // The HMETAFILE handle identifying the metafile assigned to the picture object.
     xExt As Long 'int // Horizontal extent of the metafile in HIMETRIC units.
     yExt As Long 'int // Vertical extent of the metafile in HIMETRIC units.
    End Type
     
    ' Type - OleCreatePictureIndirect / OleLoadPicture
    Public Type PICTDESC_ICON 'picType = PICTYPE_ICON
     cbSizeofStruct As Long 'UINT // Size of the PICTDESC structure.
     PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
     hIcon As Long 'HICON // The HICON identifying the icon assigned to the picture object.
    End Type
     
    ' Type - OleCreatePictureIndirect / OleLoadPicture
    Public Type PICTDESC_EMETA 'picType = PICTYPE_ENHMETAFILE
     cbSizeofStruct As Long 'UINT // Size of the PICTDESC structure.
     PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
     hEMF As Long 'HENHMETAFILE // The HENHMETAFILE identifying the enhanced metafile to assign to the picture object.
    End Type
     
    Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (ByRef PicDesc As Any, ByRef RefIID As Guid, ByVal fPictureOwnsHandle As Long, ByRef ipic As StdPicture) As Long 'As IPicture) As Long
     
Public Function CreateOlePicture(ByVal PictureHandle As Long, _
     ByVal PictureType As PictureTypeConstants, _
     Optional ByVal BitmapPalette As Long = 0, _
     Optional ByVal MetaHeight As Long = -1, _
     Optional ByVal MetaWidth As Long = -1, _
     Optional ByRef Return_ErrNum As Long, _
     Optional ByRef Return_ErrDesc As String) As StdPicture
    On Error Resume Next
     
     Dim ReturnValue As Long
     Dim PicInfo_BMP As PICTDESC_BMP
     Dim PicInfo_EMETA As PICTDESC_EMETA
     Dim PicInfo_ICON As PICTDESC_ICON
     Dim PicInfo_META As PICTDESC_META
     Dim ThePicture As StdPicture 'IPicture
     Dim riid As Guid
     
     ' Clear the return variables
     Return_ErrNum = 0
     Return_ErrDesc = ""
     
     ' Make sure the variable(s) passed are valid
     If PictureHandle = 0 Then
     Return_ErrNum = -1
     Return_ErrDesc = "Invalid bitmap handle"
     ElseIf PictureType = vbPicTypeNone Then
     Return_ErrNum = -1
     Return_ErrDesc = "Invalid picture type specified."
     ElseIf PictureType = vbPicTypeMetafile Then
     If MetaHeight = -1 Or MetaWidth = -1 Then
     Return_ErrNum = -1
     Return_ErrDesc = "Invalid metafile dimentions specified."
     End If
     End If
     
     ' Set the correct GUID for the "OleCreatePictureIndirect" API
     With riid
     .Data1 = &H20400
     .Data4(0) = &HC0
     .Data4(7) = &H46
     End With
     
     ' Set the appropriate type depending on the type of picture
     Select Case PictureType
     Case vbPicTypeBitmap
     PicInfo_BMP.cbSizeofStruct = Len(PicInfo_BMP)
     PicInfo_BMP.PicType = PICTYPE_BITMAP
     PicInfo_BMP.hBitmap = PictureHandle
     PicInfo_BMP.hPal = BitmapPalette
     ReturnValue = OleCreatePictureIndirect(PicInfo_BMP, riid, 1, ThePicture)
     
     Case vbPicTypeIcon
     PicInfo_ICON.cbSizeofStruct = Len(PicInfo_BMP)
     PicInfo_ICON.PicType = PICTYPE_ICON
     PicInfo_ICON.hIcon = PictureHandle
     ReturnValue = OleCreatePictureIndirect(PicInfo_ICON, riid, 1, ThePicture)
     
     Case vbPicTypeMetafile
     PicInfo_META.cbSizeofStruct = Len(PicInfo_BMP)
     PicInfo_META.PicType = PICTYPE_METAFILE
     PicInfo_META.hMeta = PictureHandle
     PicInfo_META.xExt = MetaWidth
     PicInfo_META.yExt = MetaHeight
     ReturnValue = OleCreatePictureIndirect(PicInfo_META, riid, 1, ThePicture)
     
     Case vbPicTypeEMetafile
     PicInfo_EMETA.cbSizeofStruct = Len(PicInfo_BMP)
     PicInfo_EMETA.PicType = PICTYPE_ENHMETAFILE
     PicInfo_EMETA.hEMF = PictureHandle
     ReturnValue = OleCreatePictureIndirect(PicInfo_BMP, riid, 1, ThePicture)
     End Select
     
     ' Check the result
     If ReturnValue <> 0 Then
        ' Return the new picture
        Set CreateOlePicture = ThePicture
     End If
End Function

Answer 5

http://community.csdn.net/Expert/topic/4606/4606302.xml?temp=.9635126