'=========================================================================== ' Subject: PBCC: X-TREE LIST Date: 10-26-98 (08:11) ' Author: Don Schullian Code: PBCC ' Origin: d83@ath.forthnet.gr Packet: PBCC.ABC '=========================================================================== $IF 0 ---------------------------- PowerBASIC/cc v1.0 ---| DASoft |------------------------------------------ ---------------------------- Public Domain DATE: 1998-10-25 | FILE NAME fDirTree.bas | code by | DIRECTORY NB1cc | Don Schullian, Jr ---------------------------- www.DASoftVSS.com PURPOSE: CREATE & maintain X-Tree list for a given drive PARMAS: Tree$() the array to hold the items Item& the element number TO be worked Indent& either 1 OR 2 spaces indentation for each level Drive$ the drive letter TO be X-Treed "C:\Whatever Is Fine" RETURNS: SEE: individual functions ------------------------------------------------------------------------- Hi, There are 4 functions in this set that you'll require and one that is for the exclusive use of fDirTree: fDirTree - creates the working string elements for the list RETURN: the number of items in the list fDirTreePath - create a full path given an element number RETURN: the full path name eg: "C:\MyDirectory\Data\" fDirTreeFind - find the element number given a full path RETURN: the element number for a path DirTreeExpand - expands and collapses the individual subs sets bytes 1 and 4 for each element DirTreeGet - this is a 'local' sub and can only be called by fDirTree PBMAIN is used as the menu function and shows how the tree can be displayed and manipulated. It is meant as a guide and not a final product. In fact, it's kind'a rough but it works (most of the time;) and it _IS_ test code. The following code will build an X-tree list FOR a given drive. The current drive is set to 'C' so if you don't want to do 'C' then change it in the call to fDirTree. Use this code as you will but I'd like to hear from you pro or con. C'ya, Don d83@DASoftVSS.com $ENDIF $INCLUDE "WIN32API.INC" TYPE DirTreeTYPE Visible AS BYTE ' T/F if the item is visible Level AS BYTE ' depth of directory 0 = root 1 = directory 2+ = sub dir Offset AS BYTE ' offsett to start of actual directory string Expanded AS BYTE ' T/F if item is expanded END TYPE DECLARE FUNCTION fDirTree (Tree() AS STRING,BYVAL Drive AS STRING,BYVAL Indent AS LONG) AS LONG DECLARE FUNCTION fDirTreePath (Tree() AS STRING,BYVAL Item AS LONG) AS STRING DECLARE SUB DirTreeExpand (Tree() AS STRING,BYVAL Item AS LONG,BYVAL LastItem AS LONG) DECLARE FUNCTION fDirTreeFind (Tree() AS STRING,BYVAL Path AS STRING) AS LONG DECLARE SUB DirTreeGet (Tree() AS STRING,tDT() AS DirTreeTYPE,DirCount AS LONG,MaxDirs AS LONG) ' '---------------------------------------------------------------------------------------- '------------ START OF TEST CODE ------------------------------------------------------ '---------------------------------------------------------------------------------------- ' FUNCTION PBMAIN () LOCAL Button AS LONG LOCAL Display AS STRING * 36 LOCAL FoS AS LONG LOCAL Item AS LONG LOCAL Last AS LONG LOCAL LastDir AS LONG LOCAL LoS AS LONG LOCAL OldFoS AS LONG LOCAL Row AS LONG LOCAL Temp AS STRING * 39 DIM Tree (100) AS STRING ' our list of dirs LastDir = fDirTree(Tree(),"C",2) ' you set the drive here DIM Menu(LastDir) AS LONG ' create a pointer array ' for visible items COLOR 15, 0 ' build the display screen LOCATE 1, 9 : PRINT "Click here to move list."; ' LOCATE 13, 42 : PRINT "Click out here to end"; ' LOCATE 25, 9 : PRINT "Click here to move list."; ' COLOR 1, 15 ' LOCATE 2, 1 ' PRINT CHR$(218) + STRING$(36,196) + CHR$(191) ' FOR Row = 1 TO 21 ' PRINT CHR$(179) & SPACE$(36) & CHR$(179) ' NEXT ' PRINT CHR$(192) + STRING$(36,196) + CHR$(217) ' ' MOUSE 3, UP ' ready the mouse MOUSE ON ' let the rodent run! FoS = 1 ' first item # visable LoS = 1 ' Last possible first item DO ' menu loop FoS = MIN(LoS,MAX(1,FoS)) ' keep FoS within bounds IF Last = 0 THEN ' if we need to recount FOR Item = 1 TO LastDir ' visible items IF ASC(Tree(Item)) THEN ' INCR Last ' Menu(Last) = Item ' END IF ' NEXT ' LoS = MAX(1,Last - 20) ' reset last-first item FoS = MIN(FoS,LoS) ' keep FoS in bounds OldFoS = 0 ' force a reprint END IF ' IF FoS <> OldFoS THEN ' if we need to reprint Item = FoS ' 1st visible item FOR Row = 3 TO 23 ' 21 rows all tolled IF Item =< Last THEN ' if still in the list Display = MID$(Tree(Menu(Item)),5) ' show only 'tree' stuff ELSE ' else Display = "" ' clear the line END IF ' INCR Item ' next item # LOCATE Row, 2 ' print the stuff PRINT Display ' NEXT ' INPUT FLUSH ' clear mouse END IF ' Button = ASC(WAITKEY$,4) ' get rodent stuff IF Button < 1 THEN ITERATE ' hay! no keyboard here! IF MOUSEY < 3 THEN ' scroll down IF Button = 2 THEN FoS = FoS + 20 ELSE INCR FoS ' ELSEIF MOUSEY > 23 THEN ' scroll up IF Button = 2 THEN FoS = FoS - 20 ELSE DECR FoS ' ELSEIF MOUSEX > 40 THEN ' all done! EXIT LOOP ' ELSEIF MOUSEX < 40 THEN ' expand/collapse item Item = Menu( MOUSEY + Fos - 3 ) ' get item number Temp = fDirTreePath(Tree(),Item) ' get whole path LOCATE 1, 41 : PRINT Temp; ' display most of it Last = fDirTreeFind(Tree(),Temp) ' test fDirTreeFind LOCATE 2, 41 : PRINT Last, Item ' the nbrs should be equal DirTreeExpand Tree(), Item, LastDir ' call routine Last = 0 ' force recount END IF ' LOOP ' MOUSE OFF ' bye Mick COLOR 7, 0 ' CLS ' END FUNCTION ' '---------------------------------------------------------------------------------------- '------------ END OF TEST CODE ------------------------------------------------------- '---------------------------------------------------------------------------------------- ' FUNCTION fDirTree ( Tree() AS STRING, _ BYVAL Drive AS STRING, _ BYVAL Indent AS LONG ) AS LONG DIM EndLevel AS STRING DIM L AS LONG DIM LastDir AS LONG DIM NextLevel AS LONG DIM NoKids AS STRING DIM P AS LONG DIM Spacer AS STRING DIM Spcr AS STRING DIM WithKids AS STRING DIM X AS LONG X = UBOUND(Tree(1)) ' DIM tDT(X) AS DirTreeTYPE ' ' tDT (1).Level = 0 'starting level tDT (1).Visible = 1 'always visable tDT (1).Offset = 5 ' tDT (1).Expanded = 1 ' always expanded Tree(1) = UCASE$(RIGHT$(Drive,1)) + ":\" 'root directory LastDir = 1 'gotta start somewhere Indent = MAX(2,MIN(1,Indent)) '1 or 2 no less, no more WithKids = LEFT$(CHR$(043,196),Indent) 'plus sign NoKids = LEFT$(CHR$(195,196),Indent) 'left bottom corner Spacer = LEFT$(CHR$(179,032),Indent) 'vertical line EndLevel = LEFT$(CHR$(192,196),Indent) 'left cross member ' DirTreeGet Tree(), tDT(), LastDir, X 'load the directories ARRAY SORT Tree(1) FOR LastDir, COLLATE UCASE, TAGARRAY tDT() 'sort the whole thing ' FOR X = LastDir TO 2 STEP -1 'add tree stuff Spcr = REPEAT$(tDT(X).Level,Spacer) ' create spacer to length P = ( ( tDT(X).Level - 1 ) * Indent ) + 1 ' where to put other goodies NextLevel = tDT(X+1).Level ' level of next dir item SELECT CASE tDT(X).Level ' put other goodies CASE = NextLevel ' MID$(Spcr,P,Indent) = NoKids ' no sub dirs under here CASE > NextLevel ' MID$(Spcr,P,Indent) = EndLevel ' no sub dirs this level CASE ELSE ' MID$(Spcr,P,Indent) = WithKids ' this one has sub dirs NextLevel = LastDir ' set flag to last dir item FOR L = X+1 TO LastDir ' check if this is last sub IF tDT(L).Level = tDT(X).Level THEN EXIT SELECT ' another sub in this level IF tDT(L).Level < tDT(X).Level THEN ' last sub in this level NextLevel = L - 1 ' EXIT FOR ' END IF ' NEXT ' FOR L = X + 1 TO NextLevel ' replace all vert lines down ASC(Tree(L),P+4) = 32 ' to next prev level NEXT ' END SELECT ' tDT(X).Visible = CBYT(tDT(X).Level = 1 ) ' tDT(X).Offset = LEN(Spcr) + 5 ' Tree(X) = PARSE$(Tree(X),"\",tDT(X).Level+1) ' cut out last dir item Tree(X) = tDT(X) & Spcr & Tree(X) ' create dir item package NEXT ' Tree(1) = tDT(1) & Tree(1) ' ' FUNCTION = LastDir 'RETURN item count END FUNCTION ' '---------------------------------------------------------------------------------------- ' FUNCTION fDirTreeFind( Tree() AS STRING,BYVAL Path AS STRING ) AS LONG LOCAL tDT AS DirTreeTYPE LOCAL Delim AS STRING LOCAL Found AS LONG LOCAL LastDir AS LONG LOCAL Pce AS LONG LOCAL Pieces AS LONG LOCAL Start AS LONG LOCAL SubDir AS STRING LastDir = UBOUND(Tree(1)) 'end of the road Delim = CHR$(92) 'lookin' for "\" Path = RTRIM$(Path,ANY CHR$(32,92)) 'trim things down to size Path = UCASE$(Path) 'ucase it Pieces = PARSECOUNT(Path,Delim) 'number of depths Start = 2 'start here (assume drive ok) ' IF Pieces < 2 THEN EXIT FUNCTION ' oops! drive only ' FOR Pce = 2 TO Pieces ' start lookin' SubDir = PARSE$(Path,Delim,Pce) ' cut out this directory LSET tDT = Tree(Start) ' load goodies ARRAY SCAN Tree(Start), FROM tDT.Offset TO 256, _ ' find a match COLLATE UCASE, = SubDir, TO Found ' IF Found = 0 THEN EXIT FUNCTION ' nope... no match, bye! Start = Start + Found - 1 ' new element number IF Pce = Pieces THEN EXIT FOR ' all done! DO ' look for next level INCR Start ' start with next item IF Start => LastDir THEN EXIT FUNCTION ' past the end of the array SELECT CASE ASC(Tree(Start),2) ' next element's level CASE < tDT.Level : EXIT FUNCTION ' went back up a level CASE > tDT.Level : EXIT LOOP ' went down a level END SELECT ' LOOP ' NEXT ' ' FUNCTION = Start 'RETURN element number END FUNCTION ' '---------------------------------------------------------------------------------------- ' FUNCTION fDirTreePath (Tree() AS STRING,BYVAL Item AS LONG) AS STRING LOCAL tDT AS DirTreeTYPE LOCAL Ofs AS LONG LOCAL Path AS STRING LSET tDT = Tree(Item) ' get the goodies IF tDT.Level > 0 THEN ' if not root directory Path = MID$(Tree(Item),tDT.Offset) & "\" ' start building path WHILE tDT.Level > 1 ' while a sub dir DECR Item ' previous item # IF ASC(Tree(Item),2) < tDT.Level THEN ' if not next level up Ofs = ASC(Tree(Item),3) ' offset to path info Path = MID$(Tree(Item),Ofs) & "\" & Path ' add new dir to Path DECR tDT.Level ' previous level END IF ' WEND ' END IF ' ' FUNCTION = MID$(Tree(1),5) & Path ' add the root & RETURN END FUNCTION ' '---------------------------------------------------------------------------------------- ' SUB DirTreeExpand ( Tree() AS STRING, BYVAL Item AS LONG, BYVAL LastItem AS LONG ) LOCAL tDT AS DirTreeTYPE LOCAL NextItem AS LONG LOCAL P AS LONG IF ( Item = 1 ) OR _ 'can't do anything with these 2 ( Item = LastItem ) THEN EXIT SUB ' ' LSET tDT = Tree(Item) 'load the starting goodies NextItem = (Item + 1) ' IF ASC(Tree(NextItem),2) =< tDT.Level THEN EXIT SUB 'this sub has no kid! P = INSTR(Tree(Item),ANY CHR$(43,195,192)) 'position of + or corner ' BIT TOGGLE tDT.Expanded, 0 'switch the expanded state ASC(Tree(Item),4) = tDT.Expanded 'set expanded state ' IF ISTRUE tDT.Expanded THEN 'expand IF ASC(Tree(NextItem),P) = 32 THEN ' last item of level ASC(Tree(Item),P) = 192 ' put the bottom left corner ELSE ' else ASC(Tree(Item),P) = 195 ' put the left cross END IF ' INCR tDT.Level ' testing for next level FOR Item = NextItem TO LastItem ' start testing SELECT CASE ASC(Tree(Item),2) ' CASE < tDT.Level : EXIT FOR ' all done CASE = tDT.Level : ASC(Tree(Item),1) = 1 ' set 'seen' flag END SELECT ' NEXT ' ELSE 'collapse ASC(Tree(Item),P) = 43 ' put the + sign again FOR Item = NextItem TO LastItem ' start testing SELECT CASE ASC(Tree(Item),2) ' test level of this sub CASE = tDT.Level ' we're all done EXIT FOR ' CASE > tDT.Level ' ASC(Tree(Item),1) = 0 ' reset 'seen' flag IF ASC(Tree(Item),4) THEN ' if this sub is expanded DirTreeExpand Tree(), Item, LastItem ' then collapse it END IF ' END SELECT ' NEXT ' END IF ' END SUB ' '---------------------------------------------------------------------------------------- ' SUB DirTreeGet (Tree() AS STRING , _ tDT () AS DirTreeTYPE, _ LastDir AS LONG , _ MaxDirs AS LONG ) LOCAL tDTA AS WIN32_FIND_DATA LOCAL Hndl AS LONG LOCAL Level AS LONG LOCAL Mom AS LONG LOCAL zPath AS ASCIIZ * 256 zPath = Tree(LastDir) & "*.*" ' new directory mask Hndl = FindFirstFile( zPath, tDTA ) ' object handle IF ISFALSE Hndl THEN EXIT SUB ' nothing this directory ' ----------------------- Mom = LastDir ' incoming directory item Level = tDT(LastDir).Level + 1 ' this level ' DO ' IF ISFALSE BIT(tDTA.dwFileAttributes, 4) THEN ITERATE ' if it's not a directory IF ASC(tDTA.cFileName) = 46 THEN ITERATE ' if it's ".." or "." '-----------------------------------------------------------' INCR LastDir ' next array element IF LastDir > MaxDirs THEN ' if past end of array MaxDirs = MaxDirs + 50 ' add 50 new elements REDIM PRESERVE Tree (MaxDirs) ' REDIM PRESERVE tDT (MaxDirs) ' END IF ' tDT (LastDir).Level = Level ' store the depth level Tree(LastDir) = Tree(Mom) & tDTA.cFileName & "\" ' store d:\path\path DirTreeGet Tree(), tDT(), LastDir, MaxDirs ' see if there are any kids '-----------------------------------------------------------' LOOP UNTIL ISFALSE FindNextFile(Hndl,tDTA) ' get next item ' FindClose Hndl ' close object END SUB