home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / _Image_Vie3644111212001.psc / ImageView.bas < prev    next >
Encoding:
BASIC Source File  |  2001-11-20  |  11.3 KB  |  236 lines
  1. Attribute VB_Name = "basImageView"
  2. Option Explicit
  3.  
  4. Private mhLargeSysIL    As Long     'Handle to System ImageList (Large Icons)
  5. Private mhSmallSysIL    As Long     'Handle to System ImageList (Small Icons)
  6.  
  7. Private Const MAX_PATH                  As Long = &H104&        '260    - Max Path Len
  8. Private Const GWL_STYLE                 As Long = &HFFFFFFF0    '(-16)  - Get/Set Window Style
  9. Private Const SHGFI_SYSICONINDEX        As Long = &H4000&       '16384  - Get System Icon Index
  10. Private Const SHGFI_LARGEICON           As Long = &H0&          '0      - Get Large Icon
  11. Private Const SHGFI_SMALLICON           As Long = &H1&          '1      - Get Small Icon
  12. Private Const SHGFI_DISPLAYNAME         As Long = &H200&        '512    - Get File Display Name
  13. Private Const SHGFI_TYPENAME            As Long = &H400&        '1024   - Get File Type Name
  14. Private Const SHGFI_ICON                As Long = &H100&        '256    - Get icon
  15. Private Const LVIF_IMAGE                As Long = &H2&          '2      - Setting the Image
  16. Private Const LVM_SETIMAGELIST          As Long = &H1003        '4099   - Set New Image List
  17. Private Const LVM_SETITEM               As Long = &H1006        '4102   - Set Image List Item
  18. Private Const LVM_SETCOLUMNWIDTH        As Long = &H101E&       '4126   - Set ListView Column Width
  19. Private Const LVS_SHAREIMAGELISTS       As Long = &H40&         '64     - Don't Destroy Assigned Image Lists
  20. Private Const LVSIL_NORMAL              As Long = &H0&          '0      - Large Icon
  21. Private Const LVSIL_SMALL               As Long = &H1&          '1      - Small Icon
  22. Private Const LVSCW_AUTOSIZE            As Long = &HFFFFFFFF    '(-1)   - Autosize ListView Column
  23. Private Const LVSCW_AUTOSIZE_USEHEADER  As Long = &HFFFFFFFE    '(-2)   - Autosize ListView Column to Header
  24. Private Const INVALID_HANDLE_VALUE      As Long = &HFFFFFFFF    '(-1)   - File not found
  25.  
  26. Private Const FILE_ATTRIBUTE_READONLY   As Long = &H1&          '1      - Read Only File
  27. Private Const FILE_ATTRIBUTE_HIDDEN     As Long = &H2&          '2      - Hidden File
  28. Private Const FILE_ATTRIBUTE_SYSTEM     As Long = &H4&          '4      - System File
  29. Private Const FILE_ATTRIBUTE_DIRECTORY  As Long = &H10&         '16     - Folder
  30. Private Const FILE_ATTRIBUTE_ARCHIVE    As Long = &H20&         '32     - Archive File
  31.  
  32. Private Type SHFILEINFO
  33.     hIcon           As Long                 'Icon handle
  34.     iIcon           As Long                 'Icon index
  35.     dwAttributes    As Long                 'SFGAO_flags
  36.     szDisplayName   As String * MAX_PATH    'Display name (or path)
  37.     szTypeName      As String * 80          'Type name
  38. End Type
  39.  
  40. Private Type LV_ITEM
  41.     mask        As Long
  42.     iItem       As Long
  43.     iSubItem    As Long
  44.     State       As Long
  45.     stateMask   As Long
  46.     pszText     As String
  47.     cchTextMax  As Long
  48.     iImage      As Long
  49.     lParam      As Long '(~ ItemData)
  50.     iIndent     As Long
  51. End Type
  52.  
  53. Private Type FILETIME
  54.     dwLowDateTime       As Long
  55.     dwHighDateTime      As Long
  56. End Type
  57.  
  58. Private Type SYSTEMTIME
  59.     wYear               As Integer
  60.     wMonth              As Integer
  61.     wDayOfWeek          As Integer
  62.     wDay                As Integer
  63.     wHour               As Integer
  64.     wMinute             As Integer
  65.     wSecond             As Integer
  66.     wMillisecs          As Integer
  67. End Type
  68.  
  69. Private Type WIN32_FIND_DATA
  70.     dwFileAttributes    As Long
  71.     ftCreationTime      As FILETIME
  72.     ftLastAccessTime    As FILETIME
  73.     ftLastWriteTime     As FILETIME
  74.     nFileSizeHigh       As Long
  75.     nFileSizeLow        As Long
  76.     dwReserved0         As Long
  77.     dwReserved1         As Long
  78.     cFileName           As String * MAX_PATH
  79.     cAlternate          As String * 14
  80. End Type
  81.  
  82. Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
  83. Private Declare Function ImageList_GetImageCount Lib "comctl32.dll" (ByVal hIml As Long) As Long
  84. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  85. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  86. 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
  87. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  88. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  89. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  90. Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
  91. Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
  92. Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
  93.  
  94. Public Sub AssignSystemImageLists(ByVal sPath As String, lvwFiles As ListView)
  95.     
  96. 'Retieve handles to the System ImageLists
  97. 'and assign them to the Listview.
  98.  
  99. Dim lIdx    As Long
  100. Dim lStyle  As Long
  101. Dim sfiFile As SHFILEINFO
  102.     
  103.     'Get handles to system image lists.
  104.     'They may change, especially if the user changes display settings.
  105.     'Safest to obtain them each time...
  106.     mhLargeSysIL = SHGetFileInfo(sPath, 0&, sfiFile, Len(sfiFile), SHGFI_SYSICONINDEX Or SHGFI_LARGEICON)
  107.     mhSmallSysIL = SHGetFileInfo(sPath, 0&, sfiFile, Len(sfiFile), SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)
  108.     
  109.     'Make sure that the System ImageLists aren't destroyed when the ImageList is terminated
  110.     lStyle = GetWindowLong(lvwFiles.hWnd, GWL_STYLE)
  111.     Call SetWindowLong(lvwFiles.hWnd, GWL_STYLE, lStyle Or LVS_SHAREIMAGELISTS)
  112.     
  113.     'Assign the System ImageLists to the ListView
  114.     Call SendMessage(lvwFiles.hWnd, LVM_SETIMAGELIST, LVSIL_NORMAL, ByVal mhLargeSysIL)
  115.     Call SendMessage(lvwFiles.hWnd, LVM_SETIMAGELIST, LVSIL_SMALL, ByVal mhSmallSysIL)
  116.     
  117.     If lvwFiles.ListItems.Count > 0 And lvwFiles.View = lvwReport Then
  118.         'Resize the headers for report view
  119.         For lIdx = 0 To lvwFiles.ColumnHeaders.Count - 2
  120.             Call SendMessage(lvwFiles.hWnd, LVM_SETCOLUMNWIDTH, lIdx, LVSCW_AUTOSIZE)
  121.         Next
  122.     End If
  123.     
  124. End Sub
  125.  
  126. Public Sub FillFileList(filFiles As FileListBox, lvwFiles As ListView)
  127.  
  128. 'Populate the listview with the contents of
  129. 'large or small system imagelist icons.
  130.  
  131. Dim lIdx        As Long
  132. Dim lCnt        As Long
  133. Dim lPos        As Long
  134. Dim lRet        As Long
  135. Dim hIml        As Long             'System ImageList Handle
  136. Dim lFlags      As Long             'SHGetFileInfo flags
  137. Dim lAttr       As Long             'File attributes
  138. Dim hFind       As Long             'Find Handle
  139. Dim sPath       As String           'Current Path
  140. Dim sName       As String           'Filename
  141. Dim sAttr       As String           'File attributes string
  142. Dim dDateTime   As Date             'File Date/Time
  143. Dim lvwItem     As LV_ITEM          'API ListView.ListItem
  144. Dim oItem       As ListItem         'VB ListView.ListItem
  145. Dim ftTime      As FILETIME         'Local file date/time
  146. Dim stTime      As SYSTEMTIME       'System file date/time
  147. Dim sfiFile     As SHFILEINFO       'SHGetFileInfo structure
  148. Dim FindData    As WIN32_FIND_DATA  'FindData structure
  149.     
  150.     Screen.MousePointer = vbHourglass
  151.     
  152.     'Clear the ListView
  153.     lvwFiles.ListItems.Clear
  154.     
  155.     'Assign the System ImageLists to the ListView
  156.     Call AssignSystemImageLists(filFiles.Path, lvwFiles)
  157.     
  158.     'Setup the Path and Flags
  159.     sPath = filFiles.Path & IIf(Right$(filFiles.Path, 1) <> "\", "\", "")
  160.     lFlags = SHGFI_ICON Or SHGFI_DISPLAYNAME Or SHGFI_TYPENAME Or SHGFI_SYSICONINDEX
  161.     
  162.     For lIdx = 0 To filFiles.ListCount - 1
  163.         hIml = SHGetFileInfo(sPath & filFiles.List(lIdx), &H0&, sfiFile, Len(sfiFile), lFlags)
  164.         If hIml <> 0 Then
  165.             'Don't need the Icon handle, so free the memory
  166.             If sfiFile.hIcon <> 0 Then
  167.                 lRet = DestroyIcon(sfiFile.hIcon)
  168.             End If
  169.             'Get the display name
  170.             lPos = InStr(sfiFile.szDisplayName, Chr$(0))
  171.             If lPos > 1 Then
  172.                 sName = Left$(sfiFile.szDisplayName, lPos - 1)
  173.             Else
  174.                 sName = ""
  175.             End If
  176.             If Len(sName) > 0 Then
  177.                 Set oItem = lvwFiles.ListItems.Add(, , sName)
  178.                 lvwItem.iItem = lCnt            'Index of ListView item (zero-based)
  179.                 lvwItem.iImage = sfiFile.iIcon  'Index in System ImageList Icon (zero-based)
  180.                 lvwItem.mask = LVIF_IMAGE       'Only setting the Image index
  181.                 'Assign the Icon's image index to the ListView Item
  182.                 Call SendMessage(lvwFiles.hWnd, LVM_SETITEM, &H0&, lvwItem)
  183.                 hFind = FindFirstFile(sPath & sName, FindData)
  184.                 If hFind <> INVALID_HANDLE_VALUE Then
  185.                     'File Size
  186.                     If FindData.nFileSizeLow <= 1024 Then
  187.                         oItem.SubItems(1) = "1 KB"
  188.                     Else
  189.                         oItem.SubItems(1) = Format$(FindData.nFileSizeLow / 1024, "#,##0 KB")
  190.                     End If
  191.                     
  192.                     'File Type
  193.                     oItem.SubItems(2) = Left$(sfiFile.szTypeName, InStr(1, sfiFile.szTypeName, vbNullChar) - 1)
  194.         
  195.                     'Last Modified (Translate to local system time)
  196.                     Call FileTimeToLocalFileTime(FindData.ftLastWriteTime, ftTime)
  197.                     Call FileTimeToSystemTime(ftTime, stTime)
  198.                     dDateTime = DateSerial(stTime.wYear, stTime.wMonth, stTime.wDay) + TimeSerial(stTime.wHour, stTime.wMinute, stTime.wSecond)
  199.                     'Use default system date/time format
  200.                     oItem.SubItems(3) = Format$(dDateTime, "Short Date") & " " & Format$(dDateTime, "Medium Time")
  201.                     
  202.                     'Attributes
  203.                     lAttr = FindData.dwFileAttributes
  204.                     sAttr = IIf((lAttr And FILE_ATTRIBUTE_READONLY) > 0, "R", "") _
  205.                         & IIf((lAttr And FILE_ATTRIBUTE_HIDDEN) > 0, "H", "") _
  206.                         & IIf((lAttr And FILE_ATTRIBUTE_SYSTEM) > 0, "S", "") _
  207.                         & IIf((lAttr And FILE_ATTRIBUTE_ARCHIVE) > 0, "A", "")
  208.                     oItem.SubItems(4) = sAttr
  209.                     
  210.                     'Close the Find
  211.                     FindClose hFind
  212.                 End If
  213.                 lCnt = lCnt + 1
  214.             End If
  215.         End If
  216.         If lCnt Mod 50 = 0 Then
  217.             DoEvents
  218.         End If
  219.     Next
  220.  
  221.     If lvwFiles.ListItems.Count > 0 And lvwFiles.View = lvwReport Then
  222.         'Resize the headers for report view (This activates the autosize
  223.         'for each column in the list.
  224.         For lIdx = 0 To lvwFiles.ColumnHeaders.Count - 2
  225.             Call SendMessage(lvwFiles.hWnd, LVM_SETCOLUMNWIDTH, lIdx, LVSCW_AUTOSIZE)
  226.         Next
  227.     End If
  228.  
  229.     DoEvents
  230.     lvwFiles.Refresh
  231.     Screen.MousePointer = vbNormal
  232.     
  233. End Sub
  234.  
  235.  
  236.