home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / cimageli.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-06-30  |  15.5 KB  |  427 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 = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Private Const MAX_PATH = 260
  13. Private Const SHGFI_DISPLAYNAME = &H200
  14. Private Const SHGFI_EXETYPE = &H2000
  15. Private Const SHGFI_ICON = &H100
  16. Private Const SHGFI_SYSICONINDEX = &H4000
  17. Private Const SHGFI_LARGEICON = &H0
  18. Private Const SHGFI_SMALLICON = &H1
  19. Private Const SHGFI_SHELLICONSIZE = &H4
  20. Private Const SHGFI_TYPENAME = &H400
  21. Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
  22.            Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
  23.            Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
  24.  
  25. Public Enum IconSize
  26.   Size16 = 0
  27.   Size32 = 1
  28. End Enum
  29.  
  30. Public Enum IconState
  31.   Normal = 0
  32.   Disabled = 1
  33. End Enum
  34.  
  35.  
  36. Private Type PictDesc
  37.   cbSizeofStruct As Long
  38.   picType As Long
  39.   hImage As Long
  40.   xExt As Long
  41.   yExt As Long
  42. End Type
  43.  
  44. Private Type Guid
  45.   Data1 As Long
  46.   Data2 As Integer
  47.   Data3 As Integer
  48.   Data4(0 To 7) As Byte
  49. End Type
  50.  
  51. Private Type ImageFileInfo
  52.   FileName As String
  53.   IconIndex As Integer
  54.   SystemIndex As Integer
  55. End Type
  56.  
  57. Private ImgListImgInfo() As ImageFileInfo
  58. Private ImageListHwnd As Long
  59.  
  60. Private Type ImageData
  61.     hbmImage As Long
  62.     hbmMask  As Long
  63.     Unused1  As Long
  64.     Unused2  As Long
  65.     xLeft    As Long
  66.     yTop     As Long
  67.     xRight   As Long
  68.     yBottom  As Long
  69. End Type
  70.  
  71. Private Const ILC_MASK = &H1
  72. Private Const ILC_COLOR = &H0
  73. Private Const ILC_COLORDDB = &H0
  74. Private Const ILC_COLOR4 = &H4
  75. Private Const ILC_COLOR8 = &H8
  76. Private Const ILC_COLOR16 = &H10
  77. Private Const ILC_COLOR24 = &H18
  78. Private Const ILC_COLOR32 = &H20
  79.  
  80. Private Const ILD_NORMAL = &H0
  81. Private Const ILD_TRANSPARENT = &H1
  82. Private Const ILD_MASK = &H10
  83. Private Const ILD_IMAGE = &H20
  84. Private Const ILD_BLEND25 = &H2
  85. Private Const ILD_BLEND50 = &H4
  86. Private Const ILD_OVERLAYMASK = &H0
  87.  
  88. Private Const DI_NORMAL = 3
  89. Private Const DSS_DISABLED = &H20
  90. Private Const DSS_MONO = &H80
  91. Private Const DSS_NORMAL = &H0&
  92. Private Const DSS_RIGHT = &H8000
  93. Private Const DSS_UNION = &H10
  94. Private Const DST_BITMAP = &H4
  95. Private Const DST_COMPLEX = &H0
  96. Private Const DST_ICON = &H3&
  97. Private Const DST_PREFIXTEXT = &H2
  98. Private Const DST_TEXT = &H1
  99.  
  100. Private Type SHFILEINFO
  101.     hIcon As Long
  102.     iIcon As Long
  103.     dwAttributes As Long
  104.     szDisplayName As String * MAX_PATH
  105.     szTypeName As String * 80
  106. End Type
  107.  
  108.  
  109. Private Type tagInitCommonControlsEx
  110.     lngSize As Long
  111.     lngICC As Long
  112. End Type
  113.  
  114. Private ShStruct As SHFILEINFO
  115.  
  116. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
  117.    (ByVal pszPath As String, ByVal dwFileAttributes As Long, _
  118.    psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
  119. Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
  120.    (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, _
  121.    ipic As IPicture) As Long
  122. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  123. Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Boolean
  124. Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Integer, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Boolean
  125. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  126. Private Declare Function DrawStateByString Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As String, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  127. Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, _
  128. ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
  129. Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  130. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  131. Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  132. Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  133. Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
  134. Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  135. Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  136. Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
  137. Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  138. Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  139.  
  140. Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" _
  141.    (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long
  142. Private Declare Function GetSysColor Lib "user32" _
  143.    (ByVal nIndex As Long) As Long
  144. Private Declare Function ImageList_SetBkColor Lib "COMCTL32" _
  145.    (ByVal HIMAGELIST As Long, ByVal clrBk As Long) As Long
  146. Private Declare Function ImageList_GetBkColor Lib "COMCTL32" _
  147.    (ByVal HIMAGELIST As Long) As Long
  148. Private Declare Function ImageList_ReplaceIcon Lib "COMCTL32" _
  149.    (ByVal HIMAGELIST As Long, ByVal i As Long, ByVal hIcon As Long) As Long
  150. Private Declare Function ImageList_Draw Lib "COMCTL32" _
  151.    (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
  152. Private Declare Function ImageList_Convert Lib "COMCTL32" Alias "ImageList_Draw" _
  153.    (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
  154. Private Declare Function ImageList_Create Lib "COMCTL32" _
  155.    (ByVal MinCx As Long, ByVal MinCy As Long, ByVal flags As Long, ByVal cInitial As Long, ByVal cGrow As Long) As Long
  156. Private Declare Function ImageList_AddMasked Lib "COMCTL32" _
  157.    (ByVal HIMAGELIST As Long, ByVal hbmImage As Long, ByVal crMask As Long) As Long
  158. Private Declare Function ImageList_Replace Lib "COMCTL32" _
  159.    (ByVal HIMAGELIST As Long, ByVal ImgIndex As Long, ByVal hbmImage As Long, ByVal hbmMask As Long) As Long
  160. Private Declare Function ImageList_Add Lib "COMCTL32" _
  161.    (ByVal HIMAGELIST As Long, ByVal hbmImage As Long, hbmMask As Long) As Long
  162. Private Declare Function ImageList_Remove Lib "COMCTL32" _
  163.    (ByVal HIMAGELIST As Long, ImgIndex As Long) As Long
  164. Private Declare Function ImageList_GeImageData Lib "COMCTL32" _
  165.    (ByVal himl As Long, ByVal ImgIndex As Long, pImageInfo As ImageData) As Long
  166. Private Declare Function ImageList_AddIcon Lib "COMCTL32" _
  167.    (ByVal himl As Long, ByVal hIcon As Long) As Long
  168. Private Declare Function ImageList_GetIcon Lib "COMCTL32" (ByVal HIMAGELIST As Long, ByVal ImgIndex As Long, hbmMask As Long) As Long
  169. Private Declare Function ImageList_SetImageCount Lib "COMCTL32" (ByVal HIMAGELIST As Long, uNewCount As Long)
  170. Private Declare Function ImageList_GetImageCount Lib "COMCTL32" (ByVal HIMAGELIST As Long) As Long
  171. Private Declare Function ImageList_Destroy Lib "COMCTL32" (ByVal HIMAGELIST As Long) As Long
  172. Private Declare Function ImageList_GetIconSize Lib "COMCTL32" (ByVal HIMAGELIST As Long, cx As Long, cy As Long) As Long
  173. Private Declare Function ImageList_SetIconSize Lib "COMCTL32" (ByVal HIMAGELIST As Long, cx As Long, cy As Long) As Long
  174.  
  175.  Function ConvertIcon(hIcon) As Picture
  176.     If hIcon = hNull Then Exit Function
  177.     
  178.     Dim NewPic As Picture, PicConv As PictDesc, IGuid As Guid
  179.     
  180.     PicConv.cbSizeofStruct = Len(PicConv)
  181.     PicConv.picType = vbPicTypeIcon
  182.     PicConv.hImage = hIcon
  183.     
  184.     IGuid.Data1 = &H20400
  185.     IGuid.Data4(0) = &HC0
  186.     IGuid.Data4(7) = &H46
  187.    
  188.     Call OleCreatePictureIndirect(PicConv, IGuid, True, NewPic)
  189.     
  190.     Set ConvertIcon = NewPic
  191. End Function
  192.  
  193. Public Function Create(ImgSize As IconSize) As Boolean
  194.  
  195. Dim SizeofIcon As Integer
  196.  
  197. If ImgSize = 0 Then SizeofIcon = 16 Else: SizeofIcon = 32
  198. 'Create the Imagelist
  199. ImageListHwnd = ImageList_Create(SizeofIcon, SizeofIcon, ILC_MASK, 0, 0)
  200.  
  201. ReDim ImgListImgInfo(0)
  202.  
  203.  
  204. End Function
  205. Public Sub Destroy()
  206. Call ImageList_Destroy(ImageListHwnd)
  207. End Sub
  208.  
  209. Public Function DrawImage(ImgIndex As Integer, Pic As Object)
  210. Dim hIcon As Long
  211.  
  212. Call ImageList_Draw(ImageListHwnd, ImgIndex, Pic.hdc, 0, 0, ILD_TRANSPARENT)
  213. Pic.Picture = Pic.Image
  214.  
  215.  
  216. End Function
  217.  
  218. Public Function ExtractIcon(ImgIndex As Integer) As Picture
  219. 'Not Finished
  220. 'Use the GetIcon Function for Icons loaded at runtime from System or files.
  221. Dim hIcon As Long
  222. hIcon = ImageList_GetIcon(ImageListHwnd, ImgIndex, ILD_TRANSPARENT)
  223. Set ExtractIcon = ConvertIcon(hIcon)
  224.  
  225. End Function
  226. Public Sub GetIcon(Picindex As Integer, Pic As Object, Optional IconDrawState As IconState)
  227.  
  228. On Error Resume Next
  229. Dim ret As Long
  230. Dim HLarge As Long
  231. Dim HSmall As Long
  232.     
  233. Dim ShStruct As SHFILEINFO
  234. Dim ImgHeight As Long, ImgWidth As Long
  235. 'Clear the current picture if any
  236. Pic.Picture = LoadPicture()
  237. 'Get the IconSize
  238. Call ImageList_GetIconSize(ImageListHwnd, ImgHeight, ImgWidth)
  239. 'Check to see if we got the icon from the system or the file
  240. If ImgListImgInfo(Picindex).IconIndex > -1 Then
  241.  
  242. If ImgHeight = 16 Then
  243.  
  244. 'Extract the Icon
  245. ret = ExtractIconEx(ImgListImgInfo(Picindex).FileName, ImgListImgInfo(Picindex).IconIndex, HLarge, HSmall, 2)
  246. 'If asking for a disabled look check to see if it's a picturebox
  247.  If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
  248.  Pic.AutoRedraw = True
  249.  Call DrawState(Pic.hdc, 0, 0, HSmall, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
  250.  Pic.Refresh
  251.  Else
  252. 'Else just give it the Icon
  253.  Pic.Picture = ConvertIcon(HSmall)
  254.  End If
  255. Else
  256.  
  257.  ret = ExtractIconEx(ImgListImgInfo(Picindex).FileName, ImgListImgInfo(Picindex).IconIndex, HLarge, HSmall, 1)
  258.  If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
  259.  Pic.AutoRedraw = True
  260.  Call DrawState(Pic.hdc, 0, 0, HLarge, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
  261.  Pic.Refresh
  262.  Else
  263.  Pic.Picture = ConvertIcon(HLarge)
  264.  End If
  265. End If
  266.  
  267.  
  268. Else
  269. 'Get the Icon from the System
  270. If ImgHeight = 16 Then
  271.  
  272.  Call SHGetFileInfo(ImgListImgInfo(Picindex).FileName, 0&, ShStruct, Len(ShStruct), _
  273.                     BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_SMALLICON)
  274.                  
  275.                  If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
  276.                  Pic.AutoRedraw = True
  277.                  Pic.AutoSize = True
  278.                  Call DrawState(Pic.hdc, 0, 0, ShStruct.hIcon, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
  279.                  Pic.Refresh
  280.  
  281.  Else
  282.                  Pic.Picture = ConvertIcon(ShStruct.hIcon)
  283.                   
  284.                  End If
  285.  Else
  286.     
  287. Call SHGetFileInfo(ImgListImgInfo(Picindex).FileName, 0&, ShStruct, Len(ShStruct), _
  288.                    BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_LARGEICON)
  289.                  
  290.                  If IconDrawState = Disabled And TypeOf Pic Is PictureBox Then
  291.                  Pic.AutoRedraw = True
  292.                  Call DrawState(Pic.hdc, 0, 0, ShStruct.hIcon, 0, 0, 0, 0, 0, DST_ICON Or DSS_DISABLED)
  293.                  Pic.Refresh
  294.  
  295.  Else
  296.                  Pic.Picture = ConvertIcon(ShStruct.hIcon)
  297.                   
  298.                  End If
  299. End If
  300.  
  301.  
  302. End If
  303.  
  304.   
  305.  
  306.     
  307.     
  308. End Sub
  309.  
  310. Public Function GetIconSize() As Integer
  311.  Dim ImgHeight As Long, ImgWidth As Long
  312.  Call ImageList_GetIconSize(ImageListHwnd, ImgHeight, ImgWidth)
  313.  GetIconSize = ImgHeight
  314. End Function
  315.  
  316. Public Function GetImageCount() As Integer
  317. GetImageCount = ImageList_GetImageCount(ImageListHwnd)
  318. End Function
  319.  
  320. Public Property Get Parent() As Object
  321.     Set Parent = ObjParent
  322. End Property
  323.  
  324. Public Property Set Parent(frm As Object)
  325.     Set ObjParent = frm
  326. End Property
  327.  
  328. Public Sub RemoveImage(Optional Index As Integer = -1)
  329. 'If you don't specify the Index to remove it clears them all
  330. Call ImageList_Remove(ImageListHwnd, ByVal Index)
  331. End Sub
  332.  
  333. Public Sub AddFileIcon(FileName As String, Optional IconIndex As Integer = -1)
  334. On Error Resume Next
  335.  
  336. Dim HLarge As Long
  337. Dim HSmall As Long
  338.    
  339. Dim ShStruct As SHFILEINFO
  340.  
  341.  
  342. Call ImageList_GetIconSize(ImageListHwnd, ImgHeight, ImgWidth)
  343.  
  344. If IconIndex > -1 Then
  345. 'Then Extract the Icon from the File
  346. If Len(FileName) > 0 Then
  347.  
  348. If ImgHeight = 16 Then
  349. ret = ExtractIconEx(FileName, IconIndex, HLarge, HSmall, 2)
  350. Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HSmall))
  351. Else
  352. ret = ExtractIconEx(FileName, IconIndex, HLarge, HSmall, 1)
  353. Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HLarge))
  354. End If
  355.  
  356. Else ' Extract from Shell32
  357.  
  358. If ImgHeight = 16 Then
  359. ret = ExtractIconEx(GetSysDir & "\Shell32.dll", IconIndex, HLarge, HSmall, 2)
  360. Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HSmall))
  361. Else
  362. ret = ExtractIconEx(GetSysDir & "\Shell32.dll", IconIndex, HLarge, HSmall, 1)
  363. Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(HLarge))
  364. End If
  365.  
  366. End If
  367.  
  368. Else 'Get the Icon from the System Imagelist (Icon you see in the Explorer)
  369.  
  370. If ImgHeight = 16 Then
  371.  
  372. Call SHGetFileInfo(FileName, 0&, ShStruct, Len(ShStruct), BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_SMALLICON)
  373. Call ImageList_AddIcon(ImageListHwnd, ShStruct.hIcon)
  374. Else
  375. Call SHGetFileInfo(FileName, 0&, ShStruct, Len(ShStruct), BASIC_SHGFI_FLAGS Or SHGFI_ICON Or SHGFI_LARGEICON)
  376. Call ImageList_AddIcon(ImageListHwnd, ShStruct.hIcon)
  377. End If
  378.  
  379.  
  380. End If
  381.  
  382. 'Add File info
  383. ImgListImgInfo(UBound(ImgListImgInfo)).FileName = FileName
  384. ImgListImgInfo(UBound(ImgListImgInfo)).IconIndex = IconIndex
  385.  
  386. ReDim Preserve ImgListImgInfo(UBound(ImgListImgInfo) + 1)
  387.     
  388.  
  389.  
  390.   
  391. End Sub
  392. Public Function GetWinDir()
  393.  Dim sBuffer As String
  394.  Dim lResult As Long
  395.  sBuffer = String$(255, 0)
  396.  lResult = GetWindowsDirectory(sBuffer, Len(sBuffer))
  397.  GetWinDir = Left(sBuffer, lResult)
  398. End Function
  399.  
  400. Public Function GetSysDir()
  401. Dim sBuffer As String
  402. Dim lResult As Long
  403. sBuffer = String$(255, 0)
  404. lResult = GetSystemDirectory(sBuffer, Len(sBuffer))
  405. GetSysDir = Left(sBuffer, lResult)
  406. End Function
  407.  
  408. Public Function AddIcon(hIcon As Variant) As Integer
  409.  
  410. On Error Resume Next
  411.  
  412. Call ImageList_AddIcon(ImageListHwnd, ConvertIcon(hIcon))
  413.  
  414. AddIcon = GetImageCount
  415. End Function
  416. Public Function ImgListHwnd() As Long
  417. ImgListHwnd = ImageListHwnd
  418. End Function
  419.  
  420. Private Sub Class_Terminate()
  421. If ImageListHwnd <> 0 Then
  422. Call ImageList_Destroy(ImageListHwnd)
  423. End If
  424. End Sub
  425.  
  426.  
  427.