home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Basic / GridOne / setup.EXE / CSYSIMAGELIST.CLS < prev    next >
Encoding:
Visual Basic class definition  |  2001-09-09  |  3.6 KB  |  112 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CSysImageList"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  17. '-----------------------------------------------------------------------------
  18. ' This is a part of the BeeGrid ActiveX control.
  19. ' Copyright ⌐ 2000 Stinga
  20. ' All rights reserved.
  21. '
  22. ' You have a right to use and distribute the BeeGrid sample files in original
  23. ' form or modified, provided that you agree that Stinga has no warranty,
  24. ' obligations, or liability for any sample application files.
  25. '-----------------------------------------------------------------------------
  26. Option Explicit
  27. Private Const ICON_SIZE = 16
  28. Public hImageList As Long
  29.  
  30. Private Const ICC_USEREX_CLASSES = &H200
  31. Private Const MAX_PATH = 260
  32. Private Const SHGFI_DISPLAYNAME = &H200
  33. Private Const SHGFI_EXETYPE = &H2000
  34. Private Const SHGFI_ICON = &H100
  35. Private Const SHGFI_SYSICONINDEX = &H4000
  36. Private Const SHGFI_LARGEICON = &H0
  37. Private Const SHGFI_SMALLICON = &H1
  38. Private Const SHGFI_SHELLICONSIZE = &H4
  39. Private Const SHGFI_TYPENAME = &H400
  40. Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
  41.            Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
  42.            Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
  43.  
  44. Private Type SHFILEINFO
  45.     hIcon As Long
  46.     iIcon As Long
  47.     dwAttributes As Long
  48.     szDisplayName As String * MAX_PATH
  49.     szTypeName As String * 80
  50. End Type
  51.  
  52. Private Type tagInitCommonControlsEx
  53.     lngSize As Long
  54.     lngICC As Long
  55. End Type
  56.  
  57. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
  58.    (ByVal pszPath As String, ByVal dwFileAttributes As Long, _
  59.    psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
  60.    
  61. Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  62. Private Declare Function ImageList_GetImageCount Lib "COMCTL32" (ByVal hImageList As Long) As Long
  63. Private Declare Function ImageList_GetIconSize Lib "COMCTL32" (ByVal hImageList As Long, cx As Long, cy As Long) As Long
  64. Public Function Count() As Long
  65.    Count = ImageList_GetImageCount(hImageList)
  66. End Function
  67.  
  68.  
  69.  
  70. Public Function GetIconIndex(sFileName As String, Optional sTypeName As String) As Long
  71.    On Error Resume Next
  72.    Dim lHeight As Long, lWidth As Long
  73.    Dim sfi As SHFILEINFO
  74.     
  75.    Call ImageList_GetIconSize(hImageList, lHeight, lWidth)
  76.     
  77.    If lHeight = ICON_SIZE Then
  78.       Call SHGetFileInfo(sFileName, 0&, sfi, Len(sfi), _
  79.          ByVal SHGFI_SMALLICON Or SHGFI_TYPENAME Or SHGFI_SYSICONINDEX)
  80.       
  81.       If Not IsMissing(sTypeName) Then
  82.          sTypeName = Left(sfi.szTypeName, InStr(sfi.szTypeName, Chr(0)) - 1)
  83.       End If
  84.       GetIconIndex = sfi.iIcon + 1
  85.    End If
  86.    
  87. End Function
  88.  
  89.  
  90.  
  91.  
  92. Private Sub Class_Initialize()
  93.    Dim sfi As SHFILEINFO
  94.    Dim iccex As tagInitCommonControlsEx
  95.  
  96.    With iccex
  97.        .lngSize = LenB(iccex)
  98.        .lngICC = ICC_USEREX_CLASSES
  99.    End With
  100.    Call InitCommonControlsEx(iccex)
  101.    
  102.    'Any valid file system path can be used to retrieve system image list handles.
  103.    hImageList = SHGetFileInfo("C:\", 0&, sfi, Len(sfi), _
  104.       ByVal SHGFI_SYSICONINDEX Or SHGFI_ICON Or SHGFI_SMALLICON)
  105.    Debug.Print Count
  106. End Sub
  107.  
  108.  
  109.  
  110.  
  111.  
  112.