explorer style

Private m_DataName
Private M_Folder

\'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
Private Sub UserControl_Initialize()
M_Folder = \"C:\"
Pic16.Width = (SMALL_ICON) * Screen.TwipsPerPixelX
Pic16.Height = (SMALL_ICON) * Screen.TwipsPerPixelY
ListView.ListItems.Clear

End Sub

Private Sub UserControl_Resize()
ListView.Move 0, 0, UserControl.Width, UserControl.Height
End Sub


Public Property Get DataName() As String
    DataName = m_DataName
End Property

Public Property Let DataName(ByVal New_DataName As String)
    m_DataName = New_DataName
    PropertyChanged \"DataName\"
End Property

Public Property Let Data(ByVal New_Data As String)
\'M_Folder = App.Path & \"\\\" & New_Data
UpDateList
End Property


Sub UpDateList()

ListView.ListItems.Clear
CurrFile = Dir(M_Folder & \"\\\", vbNormal)
While CurrFile <> \"\"
  Set Item = ListView.ListItems.Add()
  Item.Key = M_Folder & \"\\\" & CurrFile
  Item.Text = CurrFile
  GetIcon Item.Key, Item.Index
  Item.SmallIcon = Item.Index
 
CurrFile = Dir
Wend
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