home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ownrdclb / imglist.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-06-27  |  13.2 KB  |  365 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CImageList"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Private m_ILDMonoHDC As Long
  13. Private m_ILDMonoHBMP As Long
  14. Private m_ILDMonoHBMPOld As Long
  15.  
  16. Private m_ILDColorHDC As Long
  17. Private m_ILDColorHBMP As Long
  18. Private m_ILDColorHBMPOld As Long
  19.  
  20. Public Enum eilIconSize
  21.   Size16 = 16
  22.   Size32 = 32
  23. End Enum
  24.  
  25. Public Enum eilIconState
  26.   Normal = 0
  27.   Disabled = 1
  28. End Enum
  29.  
  30. Private m_hIml As Long
  31.  
  32. Private Const ILC_MASK = &H1
  33. Private Const ILC_COLOR = &H0
  34. Private Const ILC_COLORDDB = &H0
  35. Private Const ILC_COLOR4 = &H4
  36. Private Const ILC_COLOR8 = &H8
  37. Private Const ILC_COLOR16 = &H10
  38. Private Const ILC_COLOR24 = &H18
  39. Private Const ILC_COLOR32 = &H20
  40.  
  41. Private Const CLR_NONE = -1
  42. Private Const CLR_DEFAULT = -16777216
  43. Private Const CLR_HILIGHT = -16777216
  44.  
  45. Public Enum ImageTypes
  46.   IMAGE_BITMAP = 0
  47.   IMAGE_ICON = 1
  48.   IMAGE_CURSOR = 2
  49.   'IMAGE_ENHMETAFILE = 3
  50. End Enum
  51.  
  52. Private Declare Function ImageList_SetBkColor Lib "COMCTL32" (ByVal hImageList As Long, ByVal clrBk As Long) As Long
  53. Private Declare Function ImageList_GetBkColor Lib "COMCTL32" (ByVal hImageList As Long) As Long
  54. Private Declare Function ImageList_ReplaceIcon Lib "COMCTL32" (ByVal hImageList As Long, ByVal i As Long, ByVal hIcon As Long) As Long
  55. Private Declare Function ImageList_Draw Lib "COMCTL32" (ByVal hImageList As Long, ByVal ImgIndex As Long, ByVal hDCDest As Long, ByVal x As Long, ByVal y As Long, ByVal flags As Long) As Long
  56. Private Declare Function ImageList_DrawEx Lib "COMCTL32" (ByVal hIml As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal rgbBk As Long, ByVal rgbFg As Long, ByVal fStyle As Long) As Long
  57. Private Declare Function ImageList_Convert Lib "COMCTL32" Alias "ImageList_Draw" (ByVal hImageList As Long, ByVal ImgIndex As Long, ByVal hDCDest As Long, ByVal x As Long, ByVal y As Long, ByVal flags As Long) As Long
  58. Private Declare Function ImageList_Create Lib "COMCTL32" (ByVal MinCx As Long, ByVal MinCy As Long, ByVal flags As Long, ByVal cInitial As Long, ByVal cGrow As Long) As Long
  59. Private Declare Function ImageList_AddMasked Lib "COMCTL32" (ByVal hImageList As Long, ByVal hbmImage As Long, ByVal crMask As Long) As Long
  60. Private Declare Function ImageList_Replace Lib "COMCTL32" (ByVal hImageList As Long, ByVal ImgIndex As Long, ByVal hbmImage As Long, ByVal hbmMask As Long) As Long
  61. Private Declare Function ImageList_Add Lib "COMCTL32" (ByVal hImageList As Long, ByVal hbmImage As Long, hbmMask As Long) As Long
  62. Private Declare Function ImageList_Remove Lib "COMCTL32" (ByVal hImageList As Long, ImgIndex As Long) As Long
  63. Private Type IMAGEINFO
  64.     hBitmapImage As Long
  65.     hBitmapMask As Long
  66.     cPlanes As Long
  67.     cBitsPerPixel As Long
  68.     rcImage As RECT
  69. End Type
  70. Private Declare Function ImageList_GetImageInfo Lib "COMCTL32.DLL" ( _
  71.         ByVal hIml As Long, _
  72.         ByVal i As Long, _
  73.         pImageInfo As IMAGEINFO _
  74.     ) As Long
  75. Private Declare Function ImageList_AddIcon Lib "COMCTL32" (ByVal hIml As Long, ByVal hIcon As Long) As Long
  76. Private Declare Function ImageList_GetIcon Lib "COMCTL32" (ByVal hImageList As Long, ByVal ImgIndex As Long, hbmMask As Long) As Long
  77. Private Declare Function ImageList_SetImageCount Lib "COMCTL32" (ByVal hImageList As Long, uNewCount As Long)
  78. Private Declare Function ImageList_GetImageCount Lib "COMCTL32" (ByVal hImageList As Long) As Long
  79. Private Declare Function ImageList_Destroy Lib "COMCTL32" (ByVal hImageList As Long) As Long
  80. Private Declare Function ImageList_GetIconSize Lib "COMCTL32" (ByVal hImageList As Long, cx As Long, cy As Long) As Long
  81. Private Declare Function ImageList_SetIconSize Lib "COMCTL32" (ByVal hImageList As Long, cx As Long, cy As Long) As Long
  82.  
  83. Private Declare Function ImageList_LoadImage Lib "COMCTL32" Alias "ImageList_LoadImageA" (ByVal hInst 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)
  84.  
  85. Public Function Create(ByVal hdc As Long, ByVal ImgSize As eilIconSize) As Boolean
  86.  
  87. Dim SizeofIcon As Integer
  88.  
  89.     ' Do we already have an image list?
  90.     Destroy
  91.  
  92.     'Create the Imagelist
  93.     m_hIml = ImageList_Create(ImgSize, ImgSize, ILC_MASK, 4, 4)
  94.     If (m_hIml <> 0) And (m_hIml <> -1) Then
  95.         pMakeWorkDCS hdc, ImgSize
  96.     Else
  97.         m_hIml = 0
  98.     End If
  99. End Function
  100. Public Sub Destroy()
  101.     If (hIml <> 0) Then
  102.         ImageList_Destroy hIml
  103.         pClearUpWorkDCS
  104.         m_hIml = 0
  105.     End If
  106. End Sub
  107. Public Sub DrawImage( _
  108.         ByVal iImgIndex As Long, _
  109.         ByVal hdc As Long, _
  110.         ByVal xPixels As Integer, _
  111.         ByVal yPixels As Integer, _
  112.         Optional ByVal bSelected = False, _
  113.         Optional ByVal bCut = False, _
  114.         Optional ByVal bDisabled = False, _
  115.         Optional ByVal hExternalIml As Long = 0 _
  116.     )
  117. Dim hIcon As Long
  118. Dim lFlags As Long
  119. Dim lhIml As Long
  120.  
  121.     If (hExternalIml <> 0) Then
  122.         lhIml = hExternalIml
  123.     Else
  124.         lhIml = hIml
  125.     End If
  126.     
  127.     lFlags = ILD_TRANSPARENT
  128.     If (bSelected) Or (bCut) Then
  129.         lFlags = lFlags Or ILD_SELECTED
  130.     End If
  131.     
  132.     If (bCut) Then
  133.         lFlags = lFlags Or ILD_SELECTED
  134.         ImageList_DrawEx _
  135.               lhIml, _
  136.               iImgIndex, _
  137.               hdc, _
  138.               xPixels, yPixels, 0, 0, _
  139.               CLR_NONE, GetSysColor(COLOR_WINDOW), _
  140.               lFlags
  141.     ElseIf (bDisabled) Then
  142.         ' todo
  143.             ' use drawstate...
  144.     Else
  145.         ImageList_Draw _
  146.             lhIml, _
  147.             iImgIndex, _
  148.             hdc, _
  149.             xPixels, _
  150.             yPixels, _
  151.             lFlags
  152.     End If
  153. End Sub
  154. Public Property Get IconSize() As Integer
  155. Dim ImgHeight As Long, ImgWidth As Long
  156.     ImageList_GetIconSize hIml, ImgHeight, ImgWidth
  157.     IconSize = ImgHeight
  158. End Property
  159. Public Property Get ImageCount() As Integer
  160.     ImageCount = ImageList_GetImageCount(hIml)
  161. End Property
  162. Public Sub RemoveImage(ByVal Index As Integer)
  163.     ImageList_Remove hIml, ByVal Index
  164. End Sub
  165. Public Sub Clear()
  166.     ImageList_Remove hIml, -1
  167. End Sub
  168. Public Function AddFromFile( _
  169.         ByVal sFileName As String, _
  170.         ByVal iType As ImageTypes, _
  171.         Optional ByVal bMapSysColors As Boolean = False, _
  172.         Optional ByVal lBackColor As OLE_COLOR = -1 _
  173.     ) As Long
  174. Dim hImage As Long
  175. Dim un2 As Long
  176.     
  177.     un2 = LR_LOADFROMFILE
  178.     ' Load the image from file:
  179.     If bMapSysColors Then
  180.         un2 = un2 Or LR_LOADMAP3DCOLORS
  181.     End If
  182.     hImage = LoadImage(App.hInstance, sFileName, iType, 0, 0, un2)
  183.     If (hImage <> 0) Then
  184.         If (iType = IMAGE_BITMAP) Then
  185.             ' And add it to the image list:
  186.             AddFromFile = ImageList_AddMasked(hIml, hImage, lBackColor)
  187.         ElseIf (iType = IMAGE_ICON) Then
  188.             AddFromFile = ImageList_AddIcon(hIml, hImage)
  189.         End If
  190.     Else
  191.         AddFromFile = -1
  192.     End If
  193.     
  194. End Function
  195. Public Function AddFromPictureBox( _
  196.         ByVal hdc As Long, _
  197.         pic As Object, _
  198.         Optional ByVal LeftPixels As Long = 0, _
  199.         Optional ByVal TopPixels As Long = 0, _
  200.         Optional ByVal lBackColor As OLE_COLOR = -1 _
  201.     ) As Long
  202. Dim lHDC As Long
  203. Dim lHbmp As Long, lHbmpOld As Long
  204. Dim tBm As BITMAP
  205. Dim lAColor As Long
  206. Dim lW As Long, lH As Long
  207. Dim hBrush As Long
  208. Dim tR As RECT
  209. Dim lR As Long
  210. Dim lIconSize As Long
  211. Dim lBPixel As Long
  212.     
  213.     lIconSize = IconSize
  214.     ' Create a DC to hold the bitmap to transfer into the image list:
  215.     lHDC = CreateCompatibleDC(hdc)
  216.     If (lHDC <> 0) Then
  217.         ' Create a bitmap compatible with the current device
  218.         ' to copy the picture into:
  219.         GetObjectAPI pic.Picture.Handle, LenB(tBm), tBm
  220.         tBm.bmBits = 0
  221.         tBm.bmWidth = lIconSize
  222.         tBm.bmHeight = lIconSize
  223.         lHbmp = CreateBitmapIndirect(tBm)
  224.         If (lHbmp <> 0) Then
  225.             ' Get the backcolor to use:
  226.             If (lBackColor = -1) Then
  227.                 ' None specified, use the colour at 0,0:
  228.                 lBackColor = GetPixel(pic.hdc, 0, 0)
  229.             Else
  230.                 ' Try to get the specified backcolor:
  231.                 If OleTranslateColor(lBackColor, 0, lAColor) Then
  232.                     ' Failed- use default of silver
  233.                     lBackColor = &HC0C0C0
  234.                 Else
  235.                     ' Set to GDI version of OLE Color
  236.                     lBackColor = lAColor
  237.                 End If
  238.             End If
  239.             ' Select the bitmap into the DC
  240.             lHbmpOld = SelectObject(lHDC, lHbmp)
  241.             ' Clear the background:
  242.             hBrush = CreateSolidBrush(lBackColor)
  243.             tR.Right = lIconSize: tR.Bottom = lIconSize
  244.             FillRect lHDC, tR, hBrush
  245.             DeleteObject hBrush
  246.             
  247.             ' Get the source picture's dimension:
  248.             GetObjectAPI pic.Picture.Handle, LenB(tBm), tBm
  249.             lW = 16
  250.             lH = 16
  251.             If (lW + LeftPixels > tBm.bmWidth) Then
  252.                 lW = tBm.bmWidth - LeftPixels
  253.             End If
  254.             If (lH + TopPixels > tBm.bmHeight) Then
  255.                 lH = tBm.bmHeight - TopPixels
  256.             End If
  257.             If (lW > 0) And (lH > 0) Then
  258.                 ' Blt from the picture into the bitmap:
  259.                 lR = BitBlt(lHDC, 0, 0, lW, lH, hdc, LeftPixels, TopPixels, SRCCOPY)
  260.                 Debug.Assert (lR <> 0)
  261.             End If
  262.             ' We now have the image in the bitmap, so select it out of the DC:
  263.             SelectObject lHDC, lHbmpOld
  264.             ' And add it to the image list:
  265.             AddFromPictureBox = ImageList_AddMasked(hIml, lHbmp, lBackColor)
  266.                 
  267.             DeleteObject lHbmp
  268.         End If
  269.         ' Clear up the DC:
  270.         DeleteObject lHDC
  271.     End If
  272.     
  273. End Function
  274. Public Property Get hIml() As Long
  275.     hIml = m_hIml
  276. End Property
  277. Private Sub pMakeWorkDCS( _
  278.         ByVal lHDCBasis As Long, _
  279.         ByVal lIconSize As Long _
  280.     )
  281.     m_ILDMonoHDC = CreateCompatibleDC(0)
  282.     If (m_ILDMonoHDC <> 0) Then
  283.         m_ILDMonoHBMP = CreateCompatibleBitmap(m_ILDMonoHDC, lIconSize, lIconSize * 3)
  284.         If (m_ILDMonoHBMP <> 0) Then
  285.             m_ILDMonoHBMPOld = SelectObject(m_ILDMonoHDC, m_ILDMonoHBMP)
  286.         End If
  287.     End If
  288.     
  289.     m_ILDColorHDC = CreateCompatibleDC(lHDCBasis)
  290.     If (m_ILDColorHDC <> 0) Then
  291.         m_ILDColorHBMP = CreateCompatibleBitmap(lHDCBasis, lIconSize, lIconSize * 2)
  292.         If (m_ILDColorHBMP <> 0) Then
  293.             m_ILDColorHBMPOld = SelectObject(m_ILDColorHDC, m_ILDColorHBMP)
  294.         End If
  295.     End If
  296. End Sub
  297. Private Sub pClearUpWorkDCS()
  298.     If (m_ILDMonoHDC <> 0) Then
  299.         If (m_ILDMonoHBMP <> 0) Then
  300.             SelectObject m_ILDMonoHDC, m_ILDMonoHBMPOld
  301.             DeleteObject m_ILDMonoHBMP
  302.         End If
  303.         DeleteObject m_ILDMonoHDC
  304.     End If
  305.     If (m_ILDColorHDC <> 0) Then
  306.         If (m_ILDColorHBMP <> 0) Then
  307.             SelectObject m_ILDColorHDC, m_ILDColorHBMPOld
  308.             DeleteObject m_ILDColorHBMP
  309.         End If
  310.         DeleteObject m_ILDColorHDC
  311.     End If
  312. End Sub
  313. Private Sub pImageListDrawIconDisabled( _
  314.         ByVal lHDC As Long, _
  315.         ByVal hIml As Long, _
  316.         ByVal iiconIndex As Long, _
  317.         ByVal lX As Long, _
  318.         ByVal lY As Long, _
  319.         ByVal lSize As Long _
  320.     )
  321. Dim tR As RECT
  322. Dim hBrush As Long
  323. Dim lStyle As Long
  324.  
  325.     ' Firstly, create the mask & image:
  326.     ' Draw the image into the top square of the mono DC:
  327.     BitBlt m_ILDMonoHDC, 0, 0, lSize, lSize * 3, m_ILDMonoHDC, 0, 0, WHITENESS
  328.     
  329.     lStyle = ILD_IMAGE
  330.     ImageList_Draw hIml, iiconIndex, m_ILDMonoHDC, 0, 0, lStyle
  331.     ' Draw the Mask into the second square:
  332.     lStyle = ILD_MASK
  333.     ImageList_Draw hIml, iiconIndex, m_ILDMonoHDC, 0, lSize, lStyle
  334.     ' Or the mask & mono image together:
  335.     BitBlt m_ILDMonoHDC, 0, 0, lSize, lSize, m_ILDMonoHDC, 0, lSize, SRCPAINT
  336.     ' Invert the thing:
  337.    'BitBlt m_ILDMonoHDC, 0, lSize * 2, lSize, lSize, m_ILDMonoHDC, 0, 0, WHITENESS
  338.     BitBlt m_ILDMonoHDC, 0, lSize * 2, lSize, lSize, m_ILDMonoHDC, 0, lSize, SRCINVERT
  339.  
  340.     ' Now create white & button shadow copies of it:
  341.     BitBlt m_ILDColorHDC, 0, 0, lSize, lSize, m_ILDMonoHDC, 0, lSize * 2, SRCCOPY
  342.     hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNSHADOW))
  343.     tR.left = 0
  344.     tR.Right = lSize
  345.     tR.tOp = lSize
  346.     tR.Bottom = lSize * 2
  347.     FillRect m_ILDColorHDC, tR, hBrush
  348.     DeleteObject hBrush
  349.     BitBlt m_ILDColorHDC, 0, lSize, lSize, lSize, m_ILDMonoHDC, 0, lSize * 2, SRCAND
  350.     BitBlt m_ILDColorHDC, 0, lSize, lSize, lSize, m_ILDMonoHDC, 0, lSize, SRCPAINT
  351.         
  352.     ' Finally, we blit the disabled verson to the DC:
  353.     ' Draw white version, offset by 1 pixel in x & y:
  354.     BitBlt lHDC, lX + 1, lY + 1, lSize - 1, lSize - 1, m_ILDColorHDC, 0, 0, SRCPAINT
  355.     ' Draw mask for dark version:
  356.     BitBlt lHDC, lX, lY, lSize, lSize, m_ILDColorHDC, 0, 0, SRCPAINT
  357.     ' Finally draw the button shadow version:
  358.     BitBlt lHDC, lX, lY, lSize, lSize, m_ILDColorHDC, 0, lSize, SRCAND
  359.  
  360. End Sub
  361.  
  362. Private Sub Class_Terminate()
  363.     Destroy
  364. End Sub
  365.