cimagelist.cls

100个vb编程实例,什么都有

 
End Function

Public Function ExtractIcon(ImgIndex As Integer) As Picture
'Not Finished
'Use the GetIcon Function for Icons loaded at runtime from System or files.
Dim hIcon As Long
hIcon = ImageList_GetIcon(ImageListHwnd, ImgIndex, ILD_TRANSPARENT)
Set ExtractIcon = ConvertIcon(hIcon)

End Function
Public Sub GetIcon(Picindex As Integer, Pic As Object, Optional IconDrawState As IconState)
 
On Error Resume Next
Dim ret As Long
Dim HLarge As Long
Dim HSmall As Long
    
Dim ShStruct As SHFILEINFO
Dim ImgHeight As Long, ImgWidth As Long
'Clear the current picture if any
Pic.Picture = LoadPicture()
'Get the IconSize
Call ImageList_GetIconSize(ImageListHwnd, ImgHeight, ImgWidth)
'Check to see if we got the icon from the system or the file
If ImgListImgInfo(Picindex).IconIndex > -1 Then

If ImgHeight = 16 Then

'Extract the Icon
ret = ExtractIconEx(ImgListImgInfo(Picindex).FileName, ImgListImgInfo(Picindex).IconIndex, HLarge, HSmall, 2)
'If asking for a disabled look check to see if it's a picturebox
 If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
 Pic.AutoRedraw = True
 Call DrawState(Pic.hdc, 0, 0, HSmall, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
 Pic.Refresh
 Else
'Else just give it the Icon
 Pic.Picture = ConvertIcon(HSmall)
 End If
Else

 ret = ExtractIconEx(ImgListImgInfo(Picindex).FileName, ImgListImgInfo(Picindex).IconIndex, HLarge, HSmall, 1)
 If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
 Pic.AutoRedraw = True
 Call DrawState(Pic.hdc, 0, 0, HLarge, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
 Pic.Refresh
 Else
 Pic.Picture = ConvertIcon(HLarge)
 End If
End If
 
 
Else
'Get the Icon from the System
If ImgHeight = 16 Then
 
 Call SHGetFileInfo(ImgListImgInfo(Picindex).FileName, 0&, ShStruct, Len(ShStruct), _
                    BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_SMALLICON)
                 
                 If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
                 Pic.AutoRedraw = True
                 Pic.AutoSize = True
                 Call DrawState(Pic.hdc, 0, 0, ShStruct.hIcon, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
                 Pic.Refresh
 
 Else
                 Pic.Picture = ConvertIcon(ShStruct.hIcon)
                  
                 End If
 Else
    
Call SHGetFileInfo(ImgListImgInfo(Picindex).FileName, 0&, ShStruct, Len(ShStruct), _
                   BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_LARGEICON)
                 
                 If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
                 Pic.AutoRedraw = True
                 Call DrawState(Pic.hdc, 0, 0, ShStruct.hIcon, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
                 Pic.Refresh
 
 Else
                 Pic.Picture = ConvertIcon(ShStruct.hIcon)
                  
                 End If
End If


End If
 
  
 
    
    
End Sub

Public Function GetIconSize() As Integer
 Dim ImgHeight As Long, ImgWidth As Long
 Call ImageList_GetIconSize(ImageListHwnd, ImgHeight, ImgWidth)
 GetIconSize = ImgHeight
End Function

Public Function GetImageCount() As Integer
GetImageCount = ImageList_GetImageCount(ImageListHwnd)
End Function

Public Property Get Parent() As Object
    Set Parent = ObjParent
End Property

Public Property Set Parent(frm As Object)
    Set ObjParent = frm
End Property

Public Sub RemoveImage(Optional Index As Integer = -1)
'If you don't specify the Index to remove it clears them all
Call ImageList_Remove(ImageListHwnd, ByVal Index)
End Sub

Public Sub AddFileIcon(FileName As String, Optional IconIndex As Integer = -1)
On Error Resume Next

Dim HLarge As Long
Dim HSmall As Long
   
Dim ShStruct As SHFILEINFO
 

Call ImageList_GetIconSize(ImageListHwnd, ImgHeight, ImgWidth)
 
If IconIndex > -1 Then
'Then Extract the Icon from the File
If Len(FileName) > 0 Then

If ImgHeight = 16 Then
ret = ExtractIconEx(FileName, IconIndex, HLarge, HSmall, 2)
Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HSmall))
Else
ret = ExtractIconEx(FileName, IconIndex, HLarge, HSmall, 1)
Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HLarge))
End If

Else ' Extract from Shell32

If ImgHeight = 16 Then
ret = ExtractIconEx(GetSysDir & "\Shell32.dll", IconIndex, HLarge, HSmall, 2)
Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HSmall))
Else
ret = ExtractIconEx(GetSysDir & "\Shell32.dll", IconIndex, HLarge, HSmall, 1)
Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HLarge))
End If

End If
 
Else 'Get the Icon from the System Imagelist (Icon you see in the Explorer)

If ImgHeight = 16 Then
 
Call SHGetFileInfo(FileName, 0&, ShStruct, Len(ShStruct), BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_SMALLICON)
Call ImageList_AddIcon(ImageListHwnd, ShStruct.hIcon)
Else
Call SHGetFileInfo(FileName, 0&, ShStruct, Len(ShStruct), BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_LARGEICON)
Call ImageList_AddIcon(ImageListHwnd, ShStruct.hIcon)
End If


End If
 
'Add File info
ImgListImgInfo(UBound(ImgListImgInfo)).FileName = FileName
ImgListImgInfo(UBound(ImgListImgInfo)).IconIndex = IconIndex

ReDim Preserve ImgListImgInfo(UBound(ImgListImgInfo) + 1)
    
 
 
  
End Sub
Public Function GetWinDir()
 Dim sBuffer As String
 Dim lResult As Long
 sBuffer = String$(255, 0)
 lResult = GetWindowsDirectory(sBuffer, Len(sBuffer))
 GetWinDir = Left(sBuffer, lResult)
End Function

Public Function GetSysDir()
Dim sBuffer As String
Dim lResult As Long
sBuffer = String$(255, 0)
lResult = GetSystemDirectory(sBuffer, Len(sBuffer))
GetSysDir = Left(sBuffer, lResult)
End Function
 
Public Function AddIcon(hIcon As Variant) As Integer

On Error Resume Next

Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(hIcon))
 
AddIcon = GetImageCount
End Function
Public Function ImgListHwnd() As Long
ImgListHwnd = ImageListHwnd
End Function

Private Sub Class_Terminate()
If ImageListHwnd <> 0 Then
Call ImageList_Destroy(ImageListHwnd)
End If
End Sub