Tweet
Code:
'______________________________________________________________________________
'
' Browse Folder TreeView sample
' -----------------------------
'
' Example of a custom "browse for folder" control.
'
' I found I needed something like this when I required a multiple search
' folder selection in one of my programs. I hope it is of some use.
'
'
' * Covers all drives on system
' * Memory saving implementation only recurses subdirectories when needed
' * Uses the system imagelist to display folder and drive icons
' * Checks for added folders when an item is double-clicked.
' * Does not use subclassing or superclassing - just a standard callback
' * Add or Remove certain treeview styles to change appearance.
'
' - Doesn't check for missing or renamed folders.
'
' Tested fine on: WIN98/NT4/XP PRO
'
' ------------------------------------
' K.G.Peel, KGP Software. August 2003.
'______________________________________________________________________________
#Compile Exe
#Dim All
#Register All
%USEMACROS = 1
#Include "WIN32API.INC"
#Include "COMMCTRL.INC"
Declare CallBack Function dlgMain
%IDC_FOLDERS = 100 ' Main TreeView
%BFM_RECURSE = %WM_USER + 801 ' Recurse more subfolders (lParam = item indx to recurse | retval = number added)
%BFM_RESET = %WM_USER + 802 ' Reset the list (reloads all folders) (no parameters)
Type DYNAMIC_FOLDER_INFO ' This structure stores the directory info
tExpanded As Byte ' Zero until the folder branch is expanded
tHasChild As Byte ' Zero if it is an empty folder
zPath As Asciiz * %MAX_PATH ' Complete relative directory branch path.
End Type
'------------------------------------------------------------------------------
' Main dialog callback procedure
'------------------------------------------------------------------------------
CallBack Function dlgMain
Local i As Long, n As Long, sDrives As String, nCount As Long, shfi As SHFILEINFO, hSysImages As Dword
Local tvis As TV_INSERTSTRUCT, nmt As NM_TREEVIEW Ptr, nmd As TV_DISPINFO Ptr, tvi As TV_ITEM
Local hSearch As Dword, wfd As WIN32_FIND_DATA, sLocation As String
Select Case CbMsg
Case %BFM_RESET
' This message resets all items in the tree
' Load drives only...
sDrives = String$(GetLogicalDriveStrings(0, ByVal %Null), $Nul)
GetLogicalDriveStrings Len(sDrives), ByVal StrPtr(sDrives)
ReDim stFolders(ParseCount(sDrives, $Nul)-2) As Static DYNAMIC_FOLDER_INFO
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_DELETEITEM, 0, %TVI_ROOT
For i = 1 To ParseCount(sDrives, $Nul)-2
stFolders(i).zPath = RTrim$(Parse$(sDrives, $Nul, i), Any "\/") + "\"
If hSysImages = 0 Then
' Get system imagelist and assign to our treeview...
hSysImages = SHGetFileInfo(stFolders(i).zPath, 0, shfi, SizeOf(shfi), %SHGFI_SYSICONINDEX Or %SHGFI_ICON Or %SHGFI_SMALLICON)
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_SETIMAGELIST, %TVSIL_NORMAL, hSysImages
End If
' Add drives...
tvis.hParent = %TVI_ROOT
tvis.hInsertAfter = %TVI_SORT
tvis.item.item.mask = %TVIF_TEXT Or %TVIF_CHILDREN Or %TVIF_PARAM Or %TVIF_IMAGE Or %TVIF_SELECTEDIMAGE
tvis.item.item.lParam = i
tvis.item.item.iImage = %I_IMAGECALLBACK
tvis.item.item.iSelectedImage = %I_IMAGECALLBACK
tvis.item.item.cChildren = %I_CHILDRENCALLBACK
tvis.item.item.pszText = %LPSTR_TEXTCALLBACK
n = SendMessage(GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_INSERTITEM, 0, VarPtr(tvis))
' Add root folders (skip removable drives, because of floppy drive delay)
If (GetDriveType(stFolders(i).zPath) <> %DRIVE_REMOVABLE) Then SendMessage CbHndl, %BFM_RECURSE, 0, i
' Expand drive C
If (UCase$(stFolders(i).zPath) = "C:\") Then SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_EXPAND, %TVE_EXPAND, n
Next i
Function = %True
Case %BFM_RECURSE
' Populates our array with some subfolders from the specified location
' Format search folder...
sLocation = RTrim$(stFolders(CbLParam).zPath, Any "*.\/") + "\"
Replace "\\" With "\" In sLocation
' Recurse directories...
hSearch = FindFirstFile(sLocation + "*.*", wfd)
If (hSearch <> %INVALID_HANDLE_VALUE) Then
Do
If ((wfd.dwFileAttributes And %FILE_ATTRIBUTE_DIRECTORY) = %FILE_ATTRIBUTE_DIRECTORY) And (Left$(wfd.cFileName, 1) <> ".") Then
Incr n
ReDim Preserve stFolders(UBound(stFolders)+1)
stFolders(UBound(stFolders)).zPath = sLocation + wfd.cFileName
End If
Loop While FindNextFile(hSearch, wfd)
' Set has children flag...
stFolders(CbLParam).tHasChild = IIf&(n, %True, %False)
FindClose hSearch
End If
' Return total folders loaded...
Function = n
Exit Function
Case %WM_NOTIFY
nmt = CbLParam
If (@nmt.hdr.idFrom <> %IDC_FOLDERS) Then Exit Function
Select Case @nmt.hdr.code
Case %NM_DBLCLK
' Check for new folders on double-click...
tvi.mask = %TVIF_PARAM
tvi.hItem = SendMessage(GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_GETNEXTITEM, %TVGN_CARET, %TVI_ROOT)
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_GETITEM, 0, VarPtr(tvi)
If (tvi.lParam > 0) And (stFolders(tvi.lParam).tHasChild = %False) Then
nCount = SendMessage(CbHndl, %BFM_RECURSE, 0, tvi.lParam)
If nCount Then
' Set branch has been expanded flag...
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_EXPAND, %TVE_EXPAND, tvi.hItem
stFolders(tvi.lParam).tExpanded = %True
End If
End If
Case %TVN_ITEMEXPANDING
' Load expanded folders if not already shown...
If stFolders(@nmt.itemNew.lParam).tExpanded = %False Then
nCount = SendMessage(CbHndl, %BFM_RECURSE, 0, @nmt.itemNew.lParam)
' Load subitems if available...
If nCount Then
' Set branch has been expanded flag...
stFolders(@nmt.itemNew.lParam).tExpanded = %True
i = UBound(stFolders)
For i = i-(nCount-1) To i
' Must load subfolders for display purposes...
If SendMessage(CbHndl, %BFM_RECURSE, 0, i) Then stFolders(i).tHasChild = %True
tvis.hParent = @nmt.itemNew.hItem
tvis.hInsertAfter = %TVI_SORT
tvis.item.item.mask = %TVIF_TEXT Or %TVIF_IMAGE Or %TVIF_SELECTEDIMAGE Or %TVIF_CHILDREN Or %TVIF_PARAM
tvis.item.item.lParam = i
tvis.item.item.iImage = %I_IMAGECALLBACK
tvis.item.item.iSelectedImage = %I_IMAGECALLBACK
tvis.item.item.cChildren = %I_CHILDRENCALLBACK
tvis.item.item.pszText = %LPSTR_TEXTCALLBACK
' Add the new folders...
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_INSERTITEM, 0, VarPtr(tvis)
Next i
End If
End If
Case %TVN_GETDISPINFO
nmd = CbLParam
If (@nmd.item.state And %TVIS_EXPANDED) = %TVIS_EXPANDED Then
' Set expanded icon...
SHGetFileInfo stFolders(@nmd.item.lParam).zPath, 0, shfi, SizeOf(shfi), _
%SHGFI_DISPLAYNAME Or %SHGFI_SYSICONINDEX Or %SHGFI_OPENICON
Else
' Set normal icon...
SHGetFileInfo stFolders(@nmd.item.lParam).zPath, 0, shfi, SizeOf(shfi), _
%SHGFI_DISPLAYNAME Or %SHGFI_SYSICONINDEX
End If
@nmd.item.iImage = shfi.iIcon
@nmd.item.iSelectedImage = shfi.iIcon
@nmd.item.pszText = VarPtr(shfi.szDisplayName)
@nmd.item.cChildren = stFolders(@nmd.item.lParam).tHasChild
End Select
Case %WM_SIZE
MoveWindow GetDlgItem(CbHndl, %IDC_FOLDERS), 5, 5, LoWrd(CbLParam)-10, HiWrd(CbLParam)-40, %True
MoveWindow GetDlgItem(CbHndl, %IDOK), (LoWrd(CbLParam)/2)-40, HiWrd(CbLParam)-25, 80, 20, %True
Case %WM_COMMAND
If (CbCtl = %IDOK) And (CbCtlMsg = %BN_CLICKED) Then
' Explore selected folder on exit...
tvi.mask = %TVIF_PARAM
tvi.hItem = SendMessage(GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_GETNEXTITEM, %TVGN_CARET, %TVI_ROOT)
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_GETITEM, 0, VarPtr(tvi)
ShellExecute 0, "Explore", stFolders(tvi.lParam).zPath, "", "", %SW_SHOWNORMAL
Dialog End CbHndl
End If
End Select
End Function
'------------------------------------------------------------------------------
' Program Start Point
'------------------------------------------------------------------------------
Function PBMain
Local hDlg As Dword
Dialog New 0, "Browse Folder Test", , , 250, 150, %WS_OVERLAPPEDWINDOW To hDlg
Control Add $WC_TREEVIEW, hDlg, %IDC_FOLDERS, "", 0, 0, 0, 0, %WS_CHILD Or %WS_TABSTOP Or _
%WS_VISIBLE Or %TVS_LINESATROOT Or %TVS_HASBUTTONS Or %TVS_HASLINES Or %TVS_CHECKBOXES, %WS_EX_CLIENTEDGE
Control Add Button, hDlg, %IDOK, "Explore", 0, 0, 0, 0
PostMessage hDlg, %BFM_RESET, 0, 0
Dialog Show Modal hDlg Call dlgMain
End Function
Kev Peel
KGP Software
http://www.kgpsoftware.com
[This message has been edited by Kev Peel (edited August 19, 2003).]
Comment