浏览器

开发平台：
Visual Basic

cImageList.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cImageList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : cImageList
' DateTime  : 2005-3-12 12:49
' Author    : Lingll
' Purpose   :
'    2005-3-12 添加了 AddIcon function'
'    2005-3-14 添加了 Create function
'    2005-3-28 添加了 GetIcon function
'              添加 Share变量,控制结束时是否destroy imagelist
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const ILC_COLOR8 = &H8&
Private Declare Function ImageList_Create Lib "comctl32" (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_ReplaceIcon Lib "comctl32" (ByVal himl As Long, ByVal i As Long, ByVal hIcon As Long) As Long
Private Declare Function ImageList_AddMasked Lib "comctl32.dll" (ByVal himl As Long, ByVal hbmImage As Long, ByVal crMask As Long) As Long
Private Declare Function ImageList_Destroy Lib "comctl32.dll" (ByVal himl As Long) As Long
Private Declare Function ImageList_LoadImage Lib "comctl32.dll" (ByVal hi As Long, ByVal lpbmp As String, ByVal cx As Long, ByVal cGrow As Long, ByVal crMask As Long, ByVal uType As Long, ByVal uFlags As Long) As Long
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcdst As Long, ByVal x As Long, ByVal y As Long, ByVal fStyle As Long) As Long
Private Declare Function ImageList_BeginDrag Lib "comctl32.dll" (ByVal himlTrack As Long, ByVal iTrack As Long, ByVal dxHotspot As Long, ByVal dyHotspot As Long) As Long
Private Declare Function ImageList_DragEnter Lib "comctl32.dll" (ByVal hwndLock As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ImageList_DragLeave Lib "comctl32.dll" (ByVal hwndLock As Long) As Long
Private Declare Function ImageList_DragMove Lib "comctl32.dll" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub ImageList_EndDrag Lib "comctl32.dll" ()
Private Declare Function ImageList_GetIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal flags As Long) As Long
Private Const CLR_NONE As Long = &HFFFFFFFF
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_COLOR As Long = &H2
Private Const LR_COPYDELETEORG As Long = &H8
Private Const LR_COPYFROMRESOURCE As Long = &H4000
Private Const LR_COPYRETURNORG As Long = &H4
Private Const LR_CREATEDIBSECTION As Long = &H2000
Private Const LR_DEFAULTCOLOR As Long = &H0
Private Const LR_DEFAULTSIZE As Long = &H40
Private Const LR_LOADFROMFILE As Long = &H10
Private Const LR_LOADMAP3DCOLORS As Long = &H1000
Private Const LR_LOADTRANSPARENT As Long = &H20
Private Const LR_MONOCHROME As Long = &H1
Private Const LR_SHARED As Long = &H8000
Private Const LR_VGACOLOR As Long = &H80
Private Const ILD_BLEND25 As Long = &H2
Private Const ILD_BLEND50 As Long = &H4
Private Const ILD_BLEND As Long = ILD_BLEND50
Private Const ILD_FOCUS As Long = ILD_BLEND25
Private Const ILD_IMAGE As Long = &H20
Private Const ILD_MASK As Long = &H10
Private Const ILD_NORMAL As Long = &H0
Private Const ILD_OVERLAYMASK As Long = &HF00
Private Const ILD_ROP As Long = &H40
Private Const ILD_SELECTED As Long = ILD_BLEND50
Private Const ILD_TRANSPARENT As Long = &H1
Private Const ILC_COLORDDB As Long = &HFE
Private Const ILC_MASK As Long = &H1
'Private Declare Function LoadImage Lib "user32" 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Dim mIList As Long
'是否共享
Public Share As Boolean
Public Sub LoadImageList_File(nfile$, cx&, cy&, Optional vMskClr = &HFF00FF)
LoadImageList_Object LoadPicture(nfile).handle, cx, cy, vMskClr
End Sub
Public Sub LoadImageList_Object(vBmpHandel&, cx&, cy&, Optional vMskClr = &HFF00FF)
Call Class_Terminate
mIList = ImageList_Create(cx, cy, ILC_COLORDDB Or ILC_MASK, 0, 1)
ImageList_AddMasked mIList, vBmpHandel, vMskClr
End Sub
Public Sub Create(cx&, cy&)
Call Class_Terminate
mIList = ImageList_Create(cx, cy, ILC_COLORDDB Or ILC_MASK, 0, 1)
End Sub
Public Function AddIcon(vHicon&, Optional vAutoDestroy As Boolean = False) As Long
'Debug.Print "addicon", vHicon
If vHicon <> 0 Then
    AddIcon = ImageList_ReplaceIcon(mIList, -1, vHicon)
    If vAutoDestroy Then
        Call DestroyIcon(vHicon)
    End If
Else
    AddIcon = -1
End If
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetIcon
' DateTime  : 2005-3-28 15:59
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Public Function GetIcon(iIcon&) As Long
If mIList <> 0 Then
    GetIcon = ImageList_GetIcon(mIList, iIcon, ILD_TRANSPARENT)
End If
End Function
Public Property Get Hwnd() As Long
Hwnd = mIList
End Property
Public Sub Draw(hdcdst&, i&, x&, y&)
ImageList_Draw mIList, i, hdcdst, x, y, ILD_TRANSPARENT
End Sub
Private Sub Class_Terminate()
If mIList <> 0 Then
    If Share Then
    Else
        ImageList_Destroy mIList
    End If
    mIList = 0
End If
End Sub
Public Sub Drag_Begin(iTrack&, dx&, dy&, hwndLock&)
Dim tRc As RECT
GetWindowRect hwndLock, tRc
Call ImageList_BeginDrag(mIList, iTrack, tRc.Left, tRc.Top)
Call ImageList_DragEnter(hwndLock, dx, dy)
End Sub
Public Sub Drag_Move(x&, y&)
Call ImageList_DragMove(x, y)
End Sub
Public Sub Drag_End()
Call ImageList_EndDrag
End Sub

						