Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 188
  • Last Modified:

Get icon of file type

how do i get the icon thats associated with an extension and add it to a listbox?
0
janus102700
Asked:
janus102700
  • 2
1 Solution
 
BlaZerCommented:
Sub UpDateList()
Dim Item As ListItem
Dim CreatedTime As String
Dim ModifiedTime As String
ListView.ListItems.Clear
Set ListView.SmallIcons = Nothing
Dim CurrFIle As String
CurrFIle = Dir(M_Folder & "\", vbNormal)
While CurrFIle <> ""
Set Item = ListView.ListItems.Add()
Item.Key = M_Folder & "\" & CurrFIle
Item.Text = CurrFIle
Item.SubItems(1) = GetFileType("." & GetExtension(CurrFIle))
Item.SubItems(3) = FormatFileSize(FileLen(M_Folder & "\" & CurrFIle))
GetFileTimes M_Folder & "\" & CurrFIle, CreatedTime, ModifiedTime
Item.SubItems(4) = CreatedTime
Item.SubItems(5) = ModifiedTime
GetIcon Item.Key, Item.Index
CurrFIle = Dir
Wend
Set ListView.SmallIcons = Imagelist
For Each Item In ListView.ListItems
Item.SmallIcon = Item.Index
Next

End Sub
Private Function GetIcon(Filename As String, Index As Long) As Long
Dim hLIcon As Long, hSIcon As Long    'Large & Small Icons
Dim imgObj As ListImage               'Single bmp in imagelist.listimages collection
Dim r As Long

'Get a handle to the small icon
hSIcon = SHGetFileInfo(Filename, 0&, ShInfo, Len(ShInfo), _
         BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)

If hSIcon <> 0 Then
  With Pic16
    Set .Picture = LoadPicture("")
    .AutoRedraw = True
    r = ImageList_Draw(hSIcon, ShInfo.iIcon, Pic16.hDC, 0, 0, ILD_TRANSPARENT)
    .Refresh
  End With
  Set imgObj = Imagelist.ListImages.Add(Index, , Pic16.Image)

End If

End Function

this will also show some  more data..but u can delete that!

0
 
janus102700Author Commented:
umm....whats the  BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON

??

aint there something missing?
0
 
BlaZerCommented:
sorry

Private m_DataName
Private M_Folder
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'Icon Sizes in pixels
Private Const LARGE_ICON As Integer = 32
Private Const SMALL_ICON As Integer = 16
Private Const MAX_PATH = 260

Private Const ILD_TRANSPARENT = &H1       'Display transparent

'ShellInfo Flags
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000 'System icon index
Private Const SHGFI_LARGEICON = &H0       'Large icon
Private Const SHGFI_SMALLICON = &H1       'Small icon
Private Const SHGFI_SHELLICONSIZE = &H4
Private Const SHGFI_TYPENAME = &H400

Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
        Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
        Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE

Private Type SHFILEINFO                   'As required by ShInfo
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type


'----------------------------------------------------------
'Functions & Procedures
'----------------------------------------------------------
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
    (ByVal pszPath As String, _
    ByVal dwFileAttributes As Long, _
    psfi As SHFILEINFO, _
    ByVal cbSizeFileInfo As Long, _
    ByVal uFlags As Long) As Long

Private Declare Function ImageList_Draw Lib "comctl32.dll" _
    (ByVal himl&, ByVal i&, ByVal hDCDest&, _
    ByVal X&, ByVal Y&, ByVal flags&) As Long


'----------------------------------------------------------
'Private variables
'----------------------------------------------------------
Private ShInfo As SHFILEINFO
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now