-
September 1st, 2003, 08:43 AM
#1
Filelistbox
I am using the ocx FILELISTBOX that came with my VB5.
Is there somthing newer I can use.
The filelistbox dose not make use of Icons or file sorting, etc..
Any info would me apriciated
Santiago
-
September 1st, 2003, 09:54 AM
#2
Hi
I have hacked this out from an app of mine for u........
1. i use a filelist to get the list of files in the folder
2. then transfer the list contents to a listview control.
i use other methods to get the file assosciations and select the icons needed to add to each subitem in the list view
here is some code
u can mess with this if u like.
This code is not all mine but was passed on and so the orig author name is lost
To add more file types change the getIcons method and filetypes line (you'll figure it)
hope this gets y' thinkin'
1.
'//open a standard exe project and add the following to the form
ListView control
Filelist control
Imagelist control
DirListbox control
Three Picture boxs named:
>>pixNone, pixDefault, pixSmall
paste in this code between '<<<<>>>> into the form code window
'<<<<START FORM CODE>>>>
Code:
Option Explicit
Private Sub Dir1_Change()
File1.Path = Dir1.Path
populateListView ListView1, True
End Sub
Private Sub Form_Load()
setupLists
getFileIcons
populateListView ListView1, True
End Sub
'
'*********************************************************
'sets up all the lists
'*********************************************************
Private Sub setupLists()
'setup the listview(1) control - files
ListView1.AllowColumnReorder = False
ListView1.FullRowSelect = False
ListView1.HotTracking = False
ListView1.HoverSelection = False
ListView1.LabelEdit = lvwManual
ListView1.View = lvwReport
'add all the headers
ListView1.ColumnHeaders.Add , , "Available files", ListView1.Width / 2
End Sub
'
'**************************************************************
'this fills the image list with system icons for the files displayed in the lists
'*********************************************************
Private Sub getFileIcons()
Dim imageHandle As Long 'the handle to the system image list
Dim imageToList As ListImage 'var to store the listimage we get
Dim i As Integer 'loop counter
Dim fileExists As Boolean 'check for file to get icon for
Dim fileTypes As Variant 'an array of file types
Dim Placeholder, fileType As String
'set a "blank" dummy icon variable name
Placeholder = "dummy"
'Clear the image list and add blank icon to image position 1 (the Placeholder).
'first set this
ListView1.SmallIcons = Nothing
ImageList1.ListImages.clear
pixNone.Picture = pixNone.Image
Set imageToList = ImageList1.ListImages.Add(1, Placeholder, pixNone.Picture)
'
'get the system icon for each of these files
'"a.htm", "a.html", "a.php", "a.txt", "a.js", "a.css", "a.jpg", "a.jpeg", "a.bmp", "a.gif"
fileTypes = Array("a.htm", "a.html", "a.php", "a.txt", "a.js", "a.css", "a.jpg", "a.jpeg", "a.bmp", "a.gif", "a.exe", "a.frx", "a.frm", "a.dll", "a.oca", "a.mdb", "a.vbw", "a.vbp", "a.bas", "a.lib", "a.ctl", "a.chi", "a.chm", "a.srg", "a.olb", "a.tlb")
'first find out if our 'dummy' files are there (we need a real file to pass to SHGetFileInfo)
For i = 0 To UBound(fileTypes) 'look for each file and get the icon
fileExists = False
fileType = App.Path & "\" & fileTypes(i)
If Dir(fileType) <> "" Then 'it exists
fileExists = True
Else 'it needs to be created
Open fileType For Output As #1
Close #1
'if err then just use one from the default image (i added just in case)
'do this test
If Dir(fileType) <> "" Then 'it exists
fileExists = True
Else 'use default
fileExists = False
End If
If Err Then
fileExists = False
End If
End If
'get the system icon associated with the file
If fileExists Then
imageHandle& = SHGetFileInfo(fileType, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
'set a picture box to receive the small icon its size must be 16x16 pixels (240x240 twips),
'with no 3d or border clear any existing image
pixSmall.Picture = LoadPicture()
pixSmall.AutoRedraw = True
'draw the associated icon into the picturebox
Call ImageList_Draw(imageHandle&, shinfo.iIcon, pixSmall.hDC, 0, 0, ILD_TRANSPARENT)
'realize the pixSmall image and
'add it to the imagelist
pixSmall.Picture = pixSmall.Image
Set imageToList = ImageList1.ListImages.Add(, , pixSmall.Picture)
'now delete temp file
Kill fileType
Else 'just add the default picture icon thingy...
pixDefault.Picture = pixDefault.Image
Set imageToList = ImageList1.ListImages.Add(, , pixDefault.Picture)
End If
Next i
'all done so set this
ListView1.SmallIcons = ImageList1
Exit Sub
End Sub
'
'*********************************************************
'this will refill the lists, the flag clear indicates
'either addition to the list or clear and make new list
'*********************************************************
Public Sub populateListView(ByRef List As ListView, ByVal clear As Boolean)
Dim i, file1Count As Integer
Dim v_filename As String
'refesh the file1 control
File1.Refresh
file1Count = File1.ListCount
If clear Then List.ListItems.clear 'clean list first
If file1Count = 0 Then Exit Sub
List.Visible = False
Me.MousePointer = 13 'show busy icon
Me.Refresh
'then add all the items from the filebox
For i = 0 To file1Count - 1
'get the icon to use -"*.ram;*.rm;*.wav;*.mp1;*.mp2;*.mp3;*.wma;*.mpa;*.au;*.m3u;*.pls"
List.ListItems.Add , , File1.List(i), , getIcon(File1.Path & "\" & File1.List(i))
DoEvents
Next i
List.Visible = True
Me.MousePointer = 0
Me.Refresh
'set this
clear = False
End Sub
'
'<<<<END FORM CODE>>>>
2.
add a module to the project and paste in this code
<<<MODULE CODE STARTS>>>
Code:
Option Explicit
'gets systen icons
'get the associated icon image for a given filename
Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 'system icon index
Public Const SHGFI_LARGEICON = &H0 'large icon
Public Const SHGFI_SMALLICON = &H1 'small icon
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const ILD_TRANSPARENT = &H1 'display transparent
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or _
SHGFI_SHELLICONSIZE Or _
SHGFI_SYSICONINDEX Or _
SHGFI_DISPLAYNAME Or _
SHGFI_EXETYPE
Public Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Public Declare Function SHGetFileInfo Lib "SHELL32" _
Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long
Public Declare Function ImageList_Draw Lib "comctl32" _
(ByVal himl As Long, ByVal i As Long, _
ByVal hDCDest As Long, ByVal x As Long, _
ByVal y As Long, ByVal flags As Long) As Long
Public shinfo As SHFILEINFO
'
'********************************************************
'assigns a number for each icon/file
Public Function getIcon(ByVal v_filename As String) As Integer
Dim fileIcon As Integer
If Right(LCase(v_filename), 3) = "htm" Then
fileIcon = 2
ElseIf Right(LCase(v_filename), 4) = "html" Then
fileIcon = 3
ElseIf Right(LCase(v_filename), 3) = "php" Then
fileIcon = 4
ElseIf Right(LCase(v_filename), 3) = "txt" Then
fileIcon = 5
ElseIf Right(LCase(v_filename), 2) = "js" Then
fileIcon = 6
ElseIf Right(LCase(v_filename), 3) = "css" Then
fileIcon = 7
ElseIf Right(LCase(v_filename), 3) = "jpg" Then
fileIcon = 8
ElseIf Right(LCase(v_filename), 3) = "jpeg" Then
fileIcon = 9
ElseIf Right(LCase(v_filename), 3) = "bmp" Then
fileIcon = 10
ElseIf Right(LCase(v_filename), 3) = "gif" Then
fileIcon = 11
ElseIf Right(LCase(v_filename), 3) = "exe" Then
fileIcon = 12
ElseIf Right(LCase(v_filename), 3) = "frx" Then
fileIcon = 13
ElseIf Right(LCase(v_filename), 3) = "frm" Then
fileIcon = 14
ElseIf Right(LCase(v_filename), 3) = "dll" Then
fileIcon = 15
ElseIf Right(LCase(v_filename), 3) = "oca" Then
fileIcon = 16
ElseIf Right(LCase(v_filename), 3) = "mdb" Then
fileIcon = 17
ElseIf Right(LCase(v_filename), 3) = "vbw" Then
fileIcon = 18
ElseIf Right(LCase(v_filename), 3) = "vbp" Then
fileIcon = 19
ElseIf Right(LCase(v_filename), 3) = "bas" Then
fileIcon = 20
ElseIf Right(LCase(v_filename), 3) = "lib" Then
fileIcon = 21
ElseIf Right(LCase(v_filename), 3) = "ctl" Then
fileIcon = 22
ElseIf Right(LCase(v_filename), 3) = "chi" Then
fileIcon = 23
ElseIf Right(LCase(v_filename), 3) = "chm" Then
fileIcon = 24
ElseIf Right(LCase(v_filename), 3) = "srg" Then
fileIcon = 25
ElseIf Right(LCase(v_filename), 3) = "olb" Then
fileIcon = 26
ElseIf Right(LCase(v_filename), 3) = "tlb" Then
fileIcon = 27
Else
fileIcon = 1
End If
getIcon = fileIcon
End Function
<<<MODULE CODE ENDS>>>
I would use .NET if it was more like java....FREE!!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|