'______________________________________________________________________________
'
' Pre-Select Browse Folder TreeView sample
' ----------------------------------------
'
' Allows pre-selection of folders in the tree. Simply put your list of folders
' in gsPath (separated by a pipe character "|") and they will be selected.
'
' After pressing the "Select" button your selections should be displayed.
'
' Thanks go to Tonny Bjorn for testing on Win 2000 and Edwin Knoppert for his
' (now modified) TreeView_GetCheck function.
'
' If you spot any bugs or have suggestions for improvements,
' then please e-mail me (via my site) [url="http://www.kgpsoftware.com"]http://www.kgpsoftware.com[/url]
'
'
' ** Tested fine on: WIN98/NT4/2000/XP PRO
'
' ------------------------------------
' K.G.Peel, KGP Software. August 2003.
'______________________________________________________________________________
#Compile Exe
#Dim All
#Register All
#Include "WIN32API.INC"
#Include "COMMCTRL.INC"
Declare CallBack Function dlgMain
Declare Function TreeView_GetCheck(ByVal hWnd As Dword, ByVal hItem As Dword) As Long
Global gsPath As String
%IDC_FOLDERS = 100 ' Main TreeView
%IDC_REFRESH = 101 ' Refresh display button
%BFM_RESET = %WM_USER + 801 ' Reset the list (reloads all folders) (no parameters)
%BFM_EXPAND = %WM_USER + 802 ' Expand a treeview branch from array item (lParam = array index with branch handle)
Type DYNAMIC_FOLDER_INFO ' This structure stores the directory info
hItem As Dword ' Handle of the associated TreeView branch
tExpanded As Byte ' Zero until the folder branch is expanded
tHasChild As Byte ' 0 if it is an empty folder (or 2 if search required)
zPath As Asciiz * %MAX_PATH ' Complete relative directory branch path.
End Type
'------------------------------------------------------------------------------
' Returns 1 if an item is checked
'------------------------------------------------------------------------------
Function TreeView_GetCheck(ByVal hWnd As Dword, ByVal hItem As Dword) As Long
Local tvi As TV_ITEM
tvi.mask = %TVIF_STATE
tvi.hItem = hItem
tvi.stateMask = %TVIS_STATEIMAGEMASK
SendMessage hWnd, %TVM_GETITEM, 0, VarPtr(tvi)
Shift Right tvi.state, 12
Function = tvi.state-1
End Function
'------------------------------------------------------------------------------
' 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, p As Long, zSearchText As Asciiz * %MAX_PATH
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 in order they were found...
tvis.hParent = %TVI_ROOT
tvis.hInsertAfter = stFolders(i-1).hItem
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
stFolders(i).hItem = SendMessage(GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_INSERTITEM, 0, VarPtr(tvis))
' Select items if in path list...
If InStr(UCase$(gsPath) + "|", UCase$(stFolders(i).zPath) + "|") Then TreeView_SetCheckState GetDlgItem(CbHndl, %IDC_FOLDERS), stFolders(i).hItem, %True
' Add root folders (skip removable drives, because of floppy drive delay)
Select Case GetDriveType(stFolders(i).zPath)
Case %DRIVE_REMOVABLE
stFolders(i).tHasChild = %True
Case Else
' Expand fixed disk drives...
SendMessage CbHndl, %BFM_EXPAND, 0, i
SendMessage GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_EXPAND, %TVE_EXPAND, stFolders(i).hItem
End Select
Next i
' Add existing checked folders...
For p = 1 To ParseCount(gsPath, "|")
sLocation = UCase$(RTrim$(Parse$(gsPath, "|", p), Any "\/")) + "\"
zSearchText = ""
n = 1
Do Until n = Len(sLocation)+1
zSearchText = zSearchText + Mid$(sLocation, n, 1)
If (Mid$(sLocation, n, 1) = "\") Then
For i = 1 To UBound(stFolders)
If (stFolders(i).tExpanded) Then Iterate
If (zSearchText = UCase$(RTrim$(stFolders(i).zPath, Any "\/")) + "\") Then
SendMessage CbHndl, %BFM_EXPAND, 0, i
Exit For
End If
Next i
End If
Incr n
Loop
Next p
Function = %True
Case %BFM_EXPAND
' Populates our array with some subfolders from the specified location
' For each folder found, it is added to the treeview and the handle stored...
' Format search folder...
If stFolders(CbLParam).tExpanded = %False Then
stFolders(CbLParam).tExpanded = %True
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
i = UBound(stFolders)+1
ReDim Preserve stFolders(i)
stFolders(i).zPath = sLocation + wfd.cFileName
tvis.hParent = stFolders(CbLParam).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...
stFolders(i).hItem = SendMessage(GetDlgItem(CbHndl, %IDC_FOLDERS), %TVM_INSERTITEM, 0, VarPtr(tvis))
' Select items if in path list...
If InStr(UCase$(gsPath) + "|", UCase$(stFolders(i).zPath) + "|") Then
TreeView_SetCheckState GetDlgItem(CbHndl, %IDC_FOLDERS), stFolders(i).hItem, %True
End If
stFolders(i).tHasChild = 2 ' Signal to search subfolders on display
End If
Loop While FindNextFile(hSearch, wfd)
FindClose hSearch
End If
' Set has children flag...
stFolders(CbLParam).tHasChild = IIf&(n, %True, %False)
' Return total folders loaded (branches added)...
Function = n
Exit Function
End If
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
stFolders(tvi.lParam).tExpanded = %False
SendMessage CbHndl, %BFM_EXPAND, 0, tvi.lParam
End If
Case %TVN_ITEMEXPANDING
' Load expanded folders if not already shown...
SendMessage CbHndl, %BFM_EXPAND, 0, @nmt.itemNew.lParam
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)
' Get branch expand flag...
If (stFolders(@nmd.item.lParam).tHasChild = 2) Then
' Check if we have a subfolder...
i = IIf&(Dir$(stFolders(@nmd.item.lParam).zPath + "\*.", 16) <> "", 1, 0)
stFolders(@nmd.item.lParam).tHasChild = i
@nmd.item.cChildren = i
Else
@nmd.item.cChildren = stFolders(@nmd.item.lParam).tHasChild
End If
End Select
Case %WM_SIZE
MoveWindow GetDlgItem(CbHndl, %IDC_FOLDERS), 5, 5, LoWrd(CbLParam)-10, HiWrd(CbLParam)-45, %True
MoveWindow GetDlgItem(CbHndl, %IDOK), LoWrd(CbLParam)-255, HiWrd(CbLParam)-30, 80, 25, %True
MoveWindow GetDlgItem(CbHndl, %IDC_REFRESH), LoWrd(CbLParam)-170, HiWrd(CbLParam)-30, 80, 25, %True
MoveWindow GetDlgItem(CbHndl, %IDCANCEL), LoWrd(CbLParam)-85, HiWrd(CbLParam)-30, 80, 25, %True
Case %WM_COMMAND
If (CbCtlMsg = %BN_CLICKED) Then
Select Case CbCtl
Case %IDOK, %IDC_REFRESH
' Loop through to get checked items...
gsPath = ""
For i = 1 To UBound(stFolders)
' Use special function to get check marks...
n = TreeView_GetCheck(GetDlgItem(CbHndl, %IDC_FOLDERS), stFolders(i).hItem)
If n = 1 Then gsPath = gsPath + "|" + stFolders(i).zPath
Next i
gsPath = Trim$(gsPath, "|")
If (CbCtl = %IDC_REFRESH) Then
PostMessage CbHndl, %BFM_RESET, 0, 0
Else
Replace "|" With $CrLf In gsPath
MessageBox CbHndl, "The folder(s) you selected were: " + $CrLf + $CrLf + gsPath, "Browse Folder", %MB_OK Or %MB_ICONINFORMATION
Dialog End CbHndl
End If
Case %IDCANCEL
Dialog End CbHndl
End Select
End If
End Select
End Function
'------------------------------------------------------------------------------
' Program Start Point
'------------------------------------------------------------------------------
Function PBMain
Local hDlg As Dword
' Auto-select the windows directory...
gsPath = String$(%MAX_PATH+1, $Nul)
GetWindowsDirectory ByVal StrPtr(gsPath), %MAX_PATH
gsPath = RTrim$(gsPath, $Nul)
Dialog New 0, "Browse Folder Test", , , 300, 250, %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, "Select", 0, 0, 0, 0
Control Add Button, hDlg, %IDC_REFRESH, "&Refresh", 0, 0, 0, 0
Control Add Button, hDlg, %IDCANCEL, "Exit", 0, 0, 0, 0
PostMessage hDlg, %BFM_RESET, 0, 0
Dialog Show Modal hDlg Call dlgMain
End Function
'______________________________________________________________________________
'
' 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
Leave a comment: