' ============================================================================
' Fully Expand the treeview node at hNode
' SAMPLE CALL using the macros available in COMMCTRL.INC (Windows standard macros)
' iexpand: True = expand, false Collapse
' TreeView_ExpandNode GetDlgItem(hWnd, %ID_TV),_
' TreeView_GetSelection(GetDlgItem(hWnd,%ID_TV)), %TRUE, %FALSE
' true, false = expand, no siblings of selected
' =============================================================================
FUNCTION TreeView_ExpandNode (hTV AS LONG, hNode AS LONG, BYVAL iExpand AS LONG, BYVAL doSiblings AS LONG) AS LONG
LOCAL hItem AS LONG, hChild AS LONG, Expand AS LONG, doSibs AS LONG
' get stuff into LOCAL vars to make sure each recursion gets own copy
doSibs = DoSiblings
Expand = IIF(iExpand, %TVE_EXPAND, %TVE_COLLAPSE)
hItem = hNode
DO WHILE hItem
SendMessage hTV, %TVM_EXPAND, Expand, hItem
' if any children, call this function recursively.
' The getChild macro returns the first child of hItem in hTv
hChild = TreeView_GetChild(hTV,hItem)
IF hChild THEN
TreeView_ExpandNode hTv, hChild, Expand, %TRUE ' when doing children, we always do siblings
END IF
' and make hitem the next sibling at this level
IF DoSibs THEN
hItem = TreeView_GetNextSibling (hTv, hItem)
ELSE
hItem = %NULL
END IF
LOOP
END FUNCTION
MACRO Redraw_Off (hCtrl)
SendMessage hCtrl, %WM_SETREDRAW, %FALSE, 0&
END MACRO
MACRO Redraw_On (hCtrl)
SendMessage hCtrl, %WM_SETREDRAW, %TRUE, 0&
END MACRO
...
REDRAW_OFF (hTv) ' no sense redrawing tree 'till we're done, right?
Call expander function
REDRAW_ON (hTV)
UpdateWindow hTV
' TREEVIEW DIR LIST
' by Chris Holbrook 15-DEC-2008
' Application to investigate using a treeview to list directories
' it doesn't use DIR$ because this does not work in a recursive SUB.
' to change the start directory see the WM_INITDIALOG handler!
'
' changes
' 17-Dec-2008 performance improved by expanding branches on demand
'
#compile exe
#dim all
#include "commctrl.inc"
%IDC_DBB_TREEVIEW = 1320
%IDC_TEXTBOX1 = 1323
' list of values used in lParam member of TC_ITEM to indicate
' whether item is a stub for an unexpanded directory or not
%DTV_STUB = 1
%DTV_NOTSTUB = 0
global ghTreeImgList as dword
global gRootofSearch as string
'------------------------------------------------------------------------------
function DirTreeViewInsertItem(byval hTree as dword, _
byval hParent as dword, _
sItem as string, _
licon as long, _
expandable as long) as long
local tTVItem as TV_ITEM
local tTVInsert as TV_INSERTSTRUCT
if hParent then
tTVItem.mask = %TVIF_CHILDREN or %TVIF_HANDLE
tTVItem.hItem = hParent
tTVItem.cchildren = 1
TreeView_SetItem hTree, tTVItem
end if
tTVInsert.hParent = hParent
tTVInsert.Item.Item.mask = %TVIF_TEXT or %TVIF_IMAGE or %TVIF_SELECTEDIMAGE or %TVIF_PARAM or %TVIF_CHILDREN
tTVInsert.Item.Item.pszText = strptr(sItem)
tTVInsert.Item.Item.cchTextMax = len(sItem)
ttvinsert.Item.Item.iImage = licon
ttvinsert.Item.Item.iSelectedImage = licon
ttvinsert.Item.Item.lParam = expandable
if expandable then ttvinsert.Item.Item.cChildren = 1
function = TreeView_InsertItem(hTree, tTVInsert)
end function
'------------------------------------------------------------------------------
sub DirTreeView(byval hCtl as dword, byval hParent as dword, byval Startdir as asciz ptr)
local hdir as dword
local item, subitem as long
local fn as asciiz * %MAX_PATH
local FindData as WIN32_FIND_DATA
local s as string
FindData.dwFileAttributes = %FILE_ATTRIBUTE_DIRECTORY or %FILE_ATTRIBUTE_NORMAL
fn = @startdir + "\*.*"
hDir = FindFirstFile(fn, FindData)
if hDir = %INVALID_HANDLE_VALUE then
? "Cannot read directory!"
exit sub
end if
do
fn = FindData.cFileName
if trim$(fn) = "." or trim$(fn) = ".." then iterate
s = fn
if (getattr (@startdir + "\" + fn) and %SUBDIR) = %SUBDIR then
item = DirTreeViewInsertItem(hCtl, hParent, s, 2, %DTV_STUB)
else
item = DirTreeViewInsertItem(hCtl, hParent, s, 2, %DTV_NOTSTUB)
end if
fn = dir$
loop while FindNextFile(hDir, FindData)
end sub
'------------------------------------------------------------------------------
' this sub ascends the tree from the current item, prepending the path varaible
' with with each preceding parent directory'e name.
' Assumption: that the hItem part of the structure pointed to by 2nd param
' is valid.
'
function GetDirPath ( hTVWnd as dword, byval pTV as TV_ITEM ptr) as string
local TreeItem as TV_ITEM
local i as long
static spath as string
local sz as asciz * %MAX_PATH
spath = ""
TreeItem = @pTV
TreeItem.mask = %TVIF_HANDLE or %TVIF_TEXT
TreeItem.psztext = varptr(sz)
Treeitem.cchTextMax = %MAX_PATH
SendMessage(hTVWnd, %TVM_GETITEM, 0, byval varptr(TreeItem))
spath = sz
TreeItem.hItem = TreeView_GetParent ( hTVWnd, TreeItem.hitem)
while TreeItem.hItem <> %NULL
TreeItem.mask = %TVIF_STATE or %TVIF_HANDLE or %TVIF_TEXT
SendMessage(hTVWnd, %TVM_GETITEM, 0, byval varptr(TreeItem))
spath = [email protected] + "\" + spath
TreeItem.hItem = TreeView_GetParent ( hTVWnd , TreeItem.hitem)
wend
function = gRootofSearch + "\" + spath
end function
'------------------------------------------------------------------------------
callback function CBProc()
static hparent, hTVWnd as dword
local sz as asciiz*%MAX_PATH
local lpNmh as NMHDR ptr
local treeItem as TV_ITEM
local TVht as TV_HITTESTINFO
local DWPOS as dword
local htreeitem as dword
local lr as long
local s as string
select case as long cbmsg
case %wm_initdialog
' Initialization handler
hTVWnd = getdlgitem(cbhndl, %IDC_DBB_TREEVIEW)
' Add image list to TreeView
gRootofSearch = "c:\Program Files"
DirTreeView(hTVWnd, %NULL, byval strptr(GrootofSearch))
'
case %wm_notify
lpNmh = cblparam
select case @lpNmh.Code
case %TVN_ITEMEXPANDING
dwPos = GetMessagePos ' Get the mouse position
TVht.pt.x = lo(word, dwPos) ' Store the mouse x pos in the hittest udt
tvht.pt.y = hi(word, dwPos) ' Store the mouse y pos in the hittest udt
MapWindowPoints(%HWND_DESKTOP, @LPnMH.hwndFrom, TVht.pt, 1)
' Get the TreeView item/node returned in the hittest udt member of hItem
SendMessage(hTVWnd, %TVM_HITTEST, 0, byval varptr(TVht))
' get item
TreeItem.mask = %TVIF_STATE or %TVIF_HANDLE or %TVIF_PARAM
TreeItem.hItem = TVHT.Hitem
sendmessage hTVWnd, %TVM_GETITEM, 0, varptr(TreeItem)
' construct the path to the selected parent dir by going "up tree"
if TreeItem.lParam = %DTV_STUB then
' clear the indicator in lparam
TreeItem.lParam = %DTV_NOTSTUB
sendmessage hTVWnd, %TVM_SETITEM, 0, varptr(TreeItem)
s = getdirpath ( hTVWnd, byval varptr(TreeItem))
' expand the directory whose path has been discovered
DirTreeView(hTVWnd, TVHT.hItem, byval strptr(s))
end if
case %nm_click
if @lpNmh.idFrom <> %IDC_DBB_TREEVIEW then exit select
' This will ensure that when the user either clicks the checkbox or the
' buttons (+/-) the item/node will be selected. You get a strange flashing
' experience if you do not do this, comment out this code and then use a
' checkbox or the buttons and see what occurs. (found this code on MSDN)
dwPos = GetMessagePos ' Get the mouse position
TVht.pt.x = lo(word, dwPos) ' Store the mouse x pos in the hittest udt
tvht.pt.y = hi(word, dwPos) ' Store the mouse y pos in the hittest udt
MapWindowPoints(%HWND_DESKTOP, @LPnMH.hwndFrom, TVht.pt, 1)
' Get the TreeView item/node returned in the hittest udt member of hItem
SendMessage(hTVWnd, %TVM_HITTEST, 0, byval varptr(TVht))
' get item
TreeItem.mask = %TVIF_STATE or %TVIF_HANDLE
TreeItem.hItem = TVHT.Hitem
sendmessage hTVWnd, %TVM_GETITEM, 0, varptr(TreeItem)
' Select the TreeView item/node that was clicked on (returned above)
SendMessage(hTVWnd, %TVM_SELECTITEM, %TVGN_CARET, TVht.hItem)
end select
case %wm_lbuttondown
SendMessage cbhndl, %wm_nclbuttondown, %HTCAPTION, byval %NULL ' force drag
case %wm_command
select case cbctl ' <- look at control's id
end select
end select
end function
'------------------------------------------------------------------------------
function dlg(byval hParent as dword) as long
local lRslt as long
local hDlg as dword
local s as string
dialog new hParent, "DIR TV Chris Holbrook Dec 2008", 10, 100, 170, 205, %ws_popup or _
%ws_clipsiblings or %ws_visible or %ws_sysmenu or %ws_dlgframe or %ws_border or _
%ds_modalframe or %ds_3dlook or %ds_nofailcreate or _
%ds_setfont, %ws_ex_controlparent or _
%ws_ex_topmost or %ws_ex_left or %ws_ex_ltrreading to hdlg
control add "SysTreeView32", hDlg,%IDC_DBB_TREEVIEW, "SysTreeView32_1", _
0, 0, 170, 200, %ws_child or %ws_visible or %ws_tabstop or _
%tvs_hasbuttons or %tvs_haslines or %tvs_linesatroot _ 'or %tvs_checkboxes
or %tvs_showselalways, %ws_ex_clientedge or _
%ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar
dialog show modal hDlg, call CBProc to lRslt
function = lRslt
end function
'---------------------------------------------------------------------------------
function pbmain () as long
InitCommonControls
dlg(0)
end function
' TREEVIEW DIR LIST
' by Chris Holbrook 15-DEC-2008
' Application to investigate using a treeview to list directories
' it doesn't use DIR$ because this does not work in a recursive SUB.
' to change the start directory seethe WM_INITDIALOG handler!
'
#compile exe
#dim all
#include "commctrl.inc"
%IDC_DBB_TREEVIEW = 1320
%IDC_TEXTBOX1 = 1323
'------------------------------------------------------------------------------
function SampleTreeViewInsertItem(byval hTree as dword, byval hParent as dword, sItem as string, licon as long) as long
local tTVItem as TV_ITEM
local tTVInsert as TV_INSERTSTRUCT
if hParent then
tTVItem.mask = %TVIF_CHILDREN or %TVIF_HANDLE
tTVItem.hItem = hParent
tTVItem.cchildren = 1
TreeView_SetItem hTree, tTVItem
end if
tTVInsert.hParent = hParent
tTVInsert.Item.Item.mask = %TVIF_TEXT or %TVIF_IMAGE or %TVIF_SELECTEDIMAGE
tTVInsert.Item.Item.pszText = strptr(sItem)
tTVInsert.Item.Item.cchTextMax = len(sItem)
ttvinsert.Item.Item.iImage = licon
ttvinsert.Item.Item.iSelectedImage = licon
function = TreeView_InsertItem(hTree, tTVInsert)
end function
'------------------------------------------------------------------------------
sub SampleTreeView(byval hCtl as dword, byval hParent as dword, byval Startdir as asciz ptr)
local hdir as dword
local item as long
local fn as asciiz * %MAX_PATH
local FindData as WIN32_FIND_DATA
local s as string
FindData.dwFileAttributes = %FILE_ATTRIBUTE_DIRECTORY or %FILE_ATTRIBUTE_NORMAL
fn = @startdir + "\*.*"
hDir = FindFirstFile(fn, FindData)
if hDir = %INVALID_HANDLE_VALUE then
? "Cannot read directory!"
exit sub
end if
do
fn = FindData.cFileName
if trim$(fn) = "." or trim$(fn) = ".." then iterate
s = fn
item = SampleTreeViewInsertItem(hCtl, hParent, s, 0)
s = @startdir + "\" + fn
if (getattr (@startdir + "\" + fn) and %SUBDIR) = %SUBDIR then
SampleTreeView(hCtl, item, byval strptr(s))
end if
fn = dir$
loop while FindNextFile(hDir, FindData)
end sub
'------------------------------------------------------------------------------
callback function CBProc()
static hparent, hTVWnd as dword
local sz as asciiz*%MAX_PATH
local lpNmh as NMHDR ptr
local treeItem as TV_ITEM
local TVht as TV_HITTESTINFO
local DWPOS as dword
select case as long cbmsg
case %wm_initdialog
' Initialization handler
hTVWnd = getdlgitem(cbhndl, %IDC_DBB_TREEVIEW)
sz = "c:\Program Files"
SampleTreeView(hTVWnd, %NULL, byval varptr(sz))
'
case %wm_notify
lpNmh = cblparam
select case @lpNmh.Code
case %nm_click
if @lpNmh.idFrom = %IDC_DBB_TREEVIEW then
' This will ensure that when the user either clicks the checkbox or the
' buttons (+/-) the item/node will be selected. You get a strange flashing
' experience if you do not do this, comment out this code and then use a
' checkbox or the buttons and see what occurs. (found this code on MSDN)
dwPos = GetMessagePos ' Get the mouse position
TVht.pt.x = lo(word, dwPos) ' Store the mouse x pos in the hittest udt
tvht.pt.y = hi(word, dwPos) ' Store the mouse y pos in the hittest udt
MapWindowPoints(%HWND_DESKTOP, @LPnMH.hwndFrom, TVht.pt, 1)
' Get the TreeView item/node returned in the hittest udt member of hItem
SendMessage(hTVWnd, %TVM_HITTEST, 0, byval varptr(TVht))
' get item
TreeItem.mask = %TVIF_STATE or %TVIF_HANDLE
TreeItem.hItem = TVHT.Hitem
sendmessage hTVWnd, %TVM_GETITEM, 0, varptr(TreeItem)
' Select the TreeView item/node that was clicked on (returned above)
SendMessage(hTVWnd, %TVM_SELECTITEM, %TVGN_CARET, TVht.hItem)
end if
end select
case %wm_lbuttondown
SendMessage cbhndl, %wm_nclbuttondown, %HTCAPTION, byval %NULL ' force drag
case %wm_command
select case cbctl ' <- look at control's id
end select
end select
end function
'------------------------------------------------------------------------------
function DBBrowser(byval hParent as dword) as long
local lRslt as long
local hDlg as dword
local s as string
dialog new hParent, "DIR TV Chris Holbrook Dec 2008", 10, 100, 170, 205, %ws_popup or _
%ws_clipsiblings or %ws_visible or %ws_sysmenu or %ws_dlgframe or %ws_border or _
%ds_modalframe or %ds_3dlook or %ds_nofailcreate or _
%ds_setfont, %ws_ex_controlparent or _
%ws_ex_topmost or %ws_ex_left or %ws_ex_ltrreading to hdlg
control add "SysTreeView32", hDlg,%IDC_DBB_TREEVIEW, "SysTreeView32_1", _
0, 0, 170, 200, %ws_child or %ws_visible or %ws_tabstop or _
%tvs_hasbuttons or %tvs_haslines or %tvs_checkboxes or %tvs_linesatroot _
or %tvs_showselalways, %ws_ex_clientedge or _
%ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar
dialog show modal hDlg, call CBProc to lRslt
function = lRslt
end function
'---------------------------------------------------------------------------------
function pbmain () as long
InitCommonControls
DBBrowser(0)
end function
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "Commctrl.inc"
'#INCLUDE "debug.inc"
'Include file statements
'========================================================================
%ID_TREE = 100
TYPE itemRef_UDT
hItem AS LONG 'handle of item
PARENT AS LONG 'item number of parent
subDirs AS BYTE '1 = subdirectories exist, otherwise 0
expand AS BYTE '1 for expanded, 0 for collapsed
END TYPE
GLOBAL hTree AS LONG
GLOBAL numItems AS LONG
GLOBAL maxDim AS LONG
GLOBAL ITEM() AS STRING
GLOBAL itemRef() AS itemRef_UDT
GLOBAL UserSelected$
GLOBAL dirToSearch$
DECLARE FUNCTION TVInsertItem(LONG, LONG, STRING, BYTE) AS LONG
DECLARE FUNCTION getItemNo(LONG) AS LONG
DECLARE FUNCTION subDirsExist(STRING) AS BYTE
DECLARE SUB getNextDirs(LONG)
'========================================================================
FUNCTION PBMAIN()
LOCAL hMain AS LONG
LOCAL dummy$()
DIM dummy$(0)
DIALOG NEW PIXELS, 0, "my TreeView", , , 500, 400,%WS_SYSMENU OR %WS_MINIMIZEBOX TO hMain
'add treeview common control
CONTROL ADD "SysTreeView32", hMain, %ID_TREE, "", 0, 0, 300, 300, _
%WS_CHILD OR %WS_VISIBLE OR %TVS_HASBUTTONS OR %TVS_HASLINES OR _
%TVS_LINESATROOT OR %TVS_SHOWSELALWAYS, %WS_EX_CLIENTEDGE
CONTROL ADD BUTTON, hMain,201,"&Close",100,320,80,30
CONTROL ADD BUTTON, hMain,202,"&OK",100,360,80,30
CONTROL ADD LISTBOX, hMain,301,dummy$(),310,0,170,300,%WS_VSCROLL 'OR %ES_MULTILINE
CONTROL ADD TEXTBOX, hMain,302,"",310,320,120,22',%ES_MULTILINE OR %WS_VSCROLL
DIALOG SHOW MODAL hMain CALL TreeViewProc
MSGBOX "File is "+dirToSearch$+"\"+userSelected$
END FUNCTION
CALLBACK FUNCTION TreeViewProc()
LOCAL i, m, n, hTreeItem, hItem, hParent, hChild AS LONG
LOCAL s AS STRING, szTxt AS ASCIIZ*64
LOCAL lpNmh AS NMHDR PTR
LOCAL lpTV AS NM_TREEVIEW PTR
LOCAL treeItem AS TV_ITEM
LOCAL TVdi AS TV_DISPINFO
LOCAL txt$,lResult$
'LOCAL dirtosearch$
LOCAL dummy$()
LOCAL PATH$
DIM dummy$(0)
SELECT CASE CBMSG
CASE %WM_INITDIALOG
maxDim = 2000
DIM ITEM(maxDim)
DIM itemRef(maxDim)
'find the first level children of C:\
ITEM(0) = "C:": getNextDirs 0
'display the folders and files
CONTROL HANDLE CBHNDL, %ID_TREE TO hTree
itemRef(0).hItem = TVInsertItem(hTree, 0, "C:\", 1)
FOR i = 1 TO numItems
s = PARSE$(ITEM(i), "\", -1)
hParent = itemRef(itemRef(i).PARENT).hItem
hChild = TVInsertItem(hTree, hParent, s, itemRef(i).subDirs)
itemRef(i).hItem = hChild
NEXT i
'open with first level folders... the children of C:\
SendMessage hTree, %TVM_EXPAND, %TVE_EXPAND, itemRef(0).hItem
CASE %WM_PAINT
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE 201 'close button
UserSelected$=""
DIALOG END CBHNDL,0
CASE 202 'ok
DIALOG END CBHNDL,1
CASE 301 'select a file from textbox
LISTBOX GET TEXT CBHNDL,301 TO UserSelected$
CONTROL SET TEXT CBHNDL,302,UserSelected$
CASE 302 'file name text box
CONTROL GET TEXT CBHNDL,302 TO UserSelected$
END SELECT
CASE %WM_NOTIFY
lpNmh = CBLPARAM
SELECT CASE @lpNmh.CODE
CASE %TVN_ITEMEXPANDING
'expand or collapse the treeview node hTreeItem
lpTV = CBLPARAM
hTreeItem = @lpTV.ItemNew.hItem
m = numItems: n = getItemNo(hTreeItem)
IF itemRef(n).expand = 0 THEN getNextDirs n
FOR i = m + 1 TO numItems
s = PARSE$(ITEM(i), "\", -1)
hParent = itemRef(itemRef(i).PARENT).hItem
hChild = TVInsertItem(hTree, hParent, s, itemRef(i).subDirs)
itemRef(i).hItem = hChild
NEXT i
txt$=""
LISTBOX RESET CBHNDL,301
dirtosearch$=ITEM(n)
lResult$=DIR$(dirtosearch$+"\*.*",0)
WHILE lresult$<>""
txt$ =LResult$ 'txt$+lResult$+$CRLF
LISTBOX ADD CBHNDL,301,txt$
lResult$=DIR$
WEND
CASE %TVN_SELCHANGING 'LAST 'FIRST 'KEYDOWN
lpTV = CBLPARAM
hTreeItem = @lpTV.ItemNew.hItem
m = numItems: n = getItemNo(hTreeItem)
txt$=""
LISTBOX RESET CBHNDL,301
dirtosearch$=ITEM(n)
lResult$=DIR$(dirtosearch$+"\*.*",0)
WHILE lresult$<>""
txt$ =lrEsult$ 'txt$+lResult$+$CRLF
LISTBOX ADD CBHNDL,301,txt$
'count&=count&+1
lResult$=DIR$
WEND
END SELECT
CASE %WM_SYSCOMMAND
CASE %WM_DESTROY
END SELECT
END FUNCTION
FUNCTION getItemNo(hTreeItem AS LONG) AS LONG
'get itemNo corresponding to item's handle
'hTreeItem = item handle
'numItems = number of items defined (nodes of treeview)
'===================================================================
LOCAL i, n AS LONG
FOR i = 1 TO numItems
IF itemRef(i).hItem = hTreeItem THEN n = i: EXIT FOR
NEXT i
FUNCTION = n
END FUNCTION
FUNCTION TVInsertItem(hTree AS LONG, hParent AS LONG, sTxt AS STRING, b AS BYTE) AS LONG
'insert item into treeview control
'--------------------------------------------------------------------------------
'hTree = handle of treeview control
'hParent = handle of parent to item
'sTxt = string label identifying item
'b = set if children exist for this item
'================================================================================
LOCAL tv_insert AS TV_INSERTSTRUCT
tv_insert.hParent = hParent
tv_insert.ITEM.ITEM.mask = %TVIF_TEXT OR %TVIF_CHILDREN
tv_insert.ITEM.ITEM.pszText = STRPTR(sTxt)
tv_insert.ITEM.ITEM.cchTextMax = LEN(sTxt)
IF b THEN tv_insert.ITEM.ITEM.cChildren = 1
FUNCTION = TreeView_InsertItem(hTree, tv_insert)
END FUNCTION
SUB getNextDirs(itemNo AS LONG)
'find next first level children of itemNo
'update global item(), itemRef(), and numItems
'-------------------------------------------------------------------
'item() = array of folder names
'itemRef() = array of folder info UDTs
'numItems = number of nodes identified so far
'===================================================================
LOCAL s, sParent AS STRING
LOCAL attr, i, k, n, nDim AS LONG
DIM sTemp(maxDim) AS STRING
itemRef(itemNo).expand = 1
sParent = RTRIM$(ITEM(itemNo), "\") + "\"
attr = %SUBDIR 'OR %READONLY OR %HIDDEN OR %SYSTEM
s = DIR$(sParent, attr)
IF LEN(s) THEN
k = GETATTR(sParent + s) AND %SUBDIR
IF k THEN INCR n: sTemp(n) = s
DO
s = DIR$: k = 0: IF LEN(s) = 0 THEN EXIT DO
k = GETATTR(sParent + s) AND %SUBDIR
IF k THEN INCR n: sTemp(n) = s
LOOP
END IF
'found n subdirectories of itemNo
'... now update numItems, item(), and itemRef()
IF n = 0 THEN EXIT SUB
numItems = numItems + n
nDim = UBOUND(ITEM)
IF nDim < numItems THEN 'redim arrays if necessary
nDim = numItems + 1000
REDIM PRESERVE ITEM(nDim)
REDIM PRESERVE itemRef(nDim)
END IF
FOR i = 1 TO n
s = sParent + sTemp(i)
ITEM(numItems - n + i) = s
itemRef(numItems - n + i).PARENT = itemNo
itemRef(numItems - n + i).subDirs = subDirsExist(s)
NEXT i
END SUB
FUNCTION subDirsExist(sItem AS STRING) AS BYTE
'return 1 if any children exist for this node
'this function is needed to determine if node needs a [+] button
'----------------------------------------------------------------
'sItem = name of node
'================================================================
LOCAL attr, k AS LONG
LOCAL s, sParent AS STRING
sParent = RTRIM$(sItem, "\") + "\"
attr = %SUBDIR 'OR %READONLY OR %HIDDEN OR %SYSTEM
s = DIR$(sParent, attr)
IF LEN(s) THEN
k = GETATTR(sParent + s) AND %SUBDIR
DO WHILE LEN(s) AND k = 0
s = DIR$: IF LEN(s) = 0 THEN EXIT DO
k = GETATTR(sParent + s) AND %SUBDIR
LOOP
END IF
FUNCTION = SGN(k)
END FUNCTION
#COMPILE EXE
#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "Commctrl.inc"
'Include file statements
'========================================================================
%ID_TREE = 100
TYPE itemRef_UDT
hItem AS LONG
parent AS LONG
subDirs AS BYTE
done AS BYTE
END TYPE
GLOBAL hTree AS LONG
GLOBAL numItems AS LONG
GLOBAL maxDim AS LONG
GLOBAL item() AS STRING
GLOBAL itemRef() AS itemRef_UDT
GLOBAL UserSelected$
DECLARE FUNCTION TVInsertItem(LONG, LONG, STRING, BYTE) AS LONG
DECLARE FUNCTION getItemNo(LONG) AS LONG
DECLARE FUNCTION subDirsExist(STRING) AS BYTE
DECLARE SUB getNextDirs(LONG)
'========================================================================
FUNCTION PBMAIN()
LOCAL hMain AS LONG
LOCAL dummy$()
DIM dummy$(0)
DIALOG NEW PIXELS, 0, "my TreeView", , , 500, 400,%WS_SYSMENU OR %WS_MINIMIZEBOX TO hMain
'add treeview common control
CONTROL ADD "SysTreeView32", hMain, %ID_TREE, "", 0, 0, 300, 300, _
%WS_CHILD OR %WS_VISIBLE OR %TVS_HASBUTTONS OR %TVS_HASLINES OR _
%TVS_LINESATROOT OR %TVS_SHOWSELALWAYS, %WS_EX_CLIENTEDGE
CONTROL ADD BUTTON, hMain,201,"&Close",100,320,80,30
CONTROL ADD BUTTON, hMain,202,"&OK",100,360,80,30
CONTROL ADD LISTBOX, hMain,301,dummy$(),310,0,170,300,%WS_VSCROLL 'OR %ES_MULTILINE
CONTROL ADD TEXTBOX, hMain,302,"",310,320,120,22',%ES_MULTILINE OR %WS_VSCROLL
DIALOG SHOW MODAL hMain CALL TreeViewProc
MSGBOX "File is "+userSelected$
END FUNCTION
CALLBACK FUNCTION TreeViewProc()
LOCAL i, m, n, hTreeItem, hItem, hParent, hChild AS LONG
LOCAL s AS STRING, szTxt AS ASCIIZ*64
LOCAL lpNmh AS NMHDR PTR
LOCAL lpTV AS NM_TREEVIEW PTR
LOCAL treeItem AS TV_ITEM
LOCAL TVdi AS TV_DISPINFO
LOCAL txt$,lResult$
LOCAL dirtosearch$
LOCAL dummy$()
LOCAL path$
DIM dummy$(0)
SELECT CASE CBMSG
CASE %WM_INITDIALOG
maxDim = 2000
DIM item(maxDim)
DIM itemRef(maxDim)
'find the first level children of C:\
item(0) = "C:": getNextDirs 0
'display the folders and files
CONTROL HANDLE CBHNDL, %ID_TREE TO hTree
itemRef(0).hItem = TVInsertItem(hTree, 0, "C:\", 1)
FOR i = 1 TO numItems
s = PARSE$(item(i), "\", -1)
hParent = itemRef(itemRef(i).parent).hItem
hChild = TVInsertItem(hTree, hParent, s, itemRef(i).subDirs)
itemRef(i).hItem = hChild
NEXT i
'open with first level folders... the children of C:\
SendMessage hTree, %TVM_EXPAND, %TVE_EXPAND, itemRef(0).hItem
CASE %WM_PAINT
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE 201 'close button
UserSelected$=""
DIALOG END CBHNDL,0
CASE 202 'ok
DIALOG END CBHNDL,1
CASE 301 'select a file from textbox
LISTBOX GET TEXT CBHNDL,301 TO UserSelected$
CONTROL SET TEXT CBHNDL,302,UserSelected$
CASE 302 'file name text box
CONTROL GET TEXT CBHNDL,302 TO UserSelected$
END SELECT
CASE %WM_NOTIFY
lpNmh = CBLPARAM
SELECT CASE @lpNmh.Code
CASE %TVN_ITEMEXPANDING
'expand or collapse the treeview node hTreeItem
lpTV = CBLPARAM
hTreeItem = @lpTV.ItemNew.hItem
m = numItems: n = getItemNo(hTreeItem)
IF itemRef(n).done THEN EXIT FUNCTION
getNextDirs n
FOR i = m + 1 TO numItems
s = PARSE$(item(i), "\", -1)
hParent = itemRef(itemRef(i).parent).hItem
hChild = TVInsertItem(hTree, hParent, s, itemRef(i).subDirs)
itemRef(i).hItem = hChild
NEXT i
'
txt$=""
LISTBOX RESET CBHNDL,301
dirtosearch$=item(n)
lResult$=DIR$(dirtosearch$+"\*.*",0)
WHILE lresult$<>""
txt$ =LResult$ 'txt$+lResult$+$CRLF
LISTBOX ADD CBHNDL,301,txt$
lResult$=DIR$
WEND
CASE %TVN_SELCHANGING 'LAST 'FIRST 'KEYDOWN
lpTV = CBLPARAM
hTreeItem = @lpTV.ItemNew.hItem
m = numItems: n = getItemNo(hTreeItem)
txt$=""
LISTBOX RESET CBHNDL,301
dirtosearch$=item(n)
lResult$=DIR$(dirtosearch$+"\*.*",0)
WHILE lresult$<>""
txt$ =lrEsult$ 'txt$+lResult$+$CRLF
LISTBOX ADD CBHNDL,301,txt$
'count&=count&+1
lResult$=DIR$
WEND
END SELECT
CASE %WM_SYSCOMMAND
CASE %WM_DESTROY
END SELECT
END FUNCTION
FUNCTION getItemNo(hTreeItem AS LONG) AS LONG
'get itemNo corresponding to item's handle
'hTreeItem = item handle
'numItems = number of items defined (nodes of treeview)
'===================================================================
LOCAL i, n AS LONG
FOR i = 1 TO numItems
IF itemRef(i).hItem = hTreeItem THEN n = i: EXIT FOR
NEXT i
FUNCTION = n
END FUNCTION
FUNCTION TVInsertItem(hTree AS LONG, hParent AS LONG, sTxt AS STRING, b AS BYTE) AS LONG
'insert item into treeview control
'--------------------------------------------------------------------------------
'hTree = handle of treeview control
'hParent = handle of parent to item
'sTxt = string label identifying item
'b = set if children exist for this item
'================================================================================
LOCAL tv_insert AS TV_INSERTSTRUCT
tv_insert.hParent = hParent
tv_insert.Item.Item.mask = %TVIF_TEXT OR %TVIF_CHILDREN
tv_insert.Item.Item.pszText = STRPTR(sTxt)
tv_insert.Item.Item.cchTextMax = LEN(sTxt)
IF b THEN tv_insert.Item.Item.cChildren = 1
FUNCTION = TreeView_InsertItem(hTree, tv_insert)
END FUNCTION
SUB getNextDirs(itemNo AS LONG)
'find next first level children of itemNo
'update global item(), itemRef(), and numItems
'-------------------------------------------------------------------
'item() = array of folder names
'itemRef() = array of folder info UDTs
'numItems = number of nodes identified so far
'===================================================================
LOCAL s, sParent AS STRING
LOCAL attr, i, k, n, nDim AS LONG
DIM sTemp(maxDim) AS STRING
sParent = RTRIM$(item(itemNo), "\") + "\"
attr = %SUBDIR 'OR %READONLY OR %HIDDEN OR %SYSTEM
s = DIR$(sParent, attr)
IF LEN(s) THEN
k = GETATTR(sParent + s) AND %SUBDIR
IF k THEN INCR n: sTemp(n) = s
DO
s = DIR$: k = 0: IF LEN(s) = 0 THEN EXIT DO
k = GETATTR(sParent + s) AND %SUBDIR
IF k THEN INCR n: sTemp(n) = s
LOOP
END IF
itemRef(numItems).done = 1
'found n subdirectories of itemNo
'... now update numItems, item(), and itemRef()
IF n = 0 THEN EXIT SUB
numItems = numItems + n
nDim = UBOUND(item)
IF nDim < numItems THEN 'redim arrays if necessary
nDim = numItems + 1000
REDIM PRESERVE item(nDim)
REDIM PRESERVE itemRef(nDim)
END IF
FOR i = 1 TO n
s = sParent + sTemp(i)
item(numItems - n + i) = s
itemRef(numItems - n + i).parent = itemNo
itemRef(numItems - n + i).subDirs = subDirsExist(s)
NEXT i
END SUB
FUNCTION subDirsExist(sItem AS STRING) AS BYTE
'return 1 if any children exist for this node
'this function is needed to determine if node needs a [+] button
'----------------------------------------------------------------
'sItem = name of node
'================================================================
LOCAL attr, k AS LONG
LOCAL s, sParent AS STRING
sParent = RTRIM$(sItem, "\") + "\"
attr = %SUBDIR 'OR %READONLY OR %HIDDEN OR %SYSTEM
s = DIR$(sParent, attr)
IF LEN(s) THEN
k = GETATTR(sParent + s) AND %SUBDIR
DO WHILE LEN(s) AND k = 0
s = DIR$: IF LEN(s) = 0 THEN EXIT DO
k = GETATTR(sParent + s) AND %SUBDIR
LOOP
END IF
FUNCTION = SGN(k)
END FUNCTION
'--------------------------------------------------------------------------------
Leave a comment: