Add a slider control to your TreeMap to vary how much detail is shown

Article
07/19/2006

I was running really low on disk space on one of my machines, so I ran my Treemap utility on it (see What is taking up the space on your hard disk? TreeMap it!). Then it occurred to me that I can improve the utility by adding a slider control to show how many levels deep in the hierarchy to show. Now it’s even more useful. Try running the code and moving the slider to control how much detail is shown.

#define CPICT "999,999,999,999"

*Program to Display tree map of folders. See https://blogs.msdn.com/calvin_hsia/archive/2005/06/17/430338.aspx

*7/19/06: added slider to select depth

CLEAR all

CLOSE DATABASES all

CLEAR

PUBLIC oForm

*oForm=CREATEOBJECT("TreeMapForm","*",.f.) && for Outlook Inbox

oForm=CREATEOBJECT("TreeMapForm",ADDBS(GETDIR("c:\program files")),.f.)

DEFINE CLASS TreeMapForm as Form

allowoutput=.f. && so '?' output goes to screen

BackColor = 0xffffff && white

Width=_screen.Width

Height=_screen.Height-50

width=1024

height=798

showtips=1 && show tooltips

datasession=2 && private data

nObjCnt=0 && # of rects added to form

cStartPath=""

PROCEDURE init(cPath as String, fSubDir as Boolean)

this.cStartPath=cPath

thisform.AddObject("oSlider","cSlider")

WITH thisform.oSlider

.width = 350

.visible=1

.min=0

.borderstyle=1

.largechange=1

ENDWITH

_tooltiptimeout=0 && don't timeout til user moves mouse

SET EXCLUSIVE OFF

SET SAFETY OFF

SET TALK off

SET EXACT OFF

IF !fSubDir

CREATE table dirs (path c(240),depth i,size n(13,0))

IF cPath="*"

loApp = GETOBJECT("","Outlook.application")

oSpace=loApp.GetNameSpace("MAPI")

oFolder=oSpace.Folders("MailBox - Calvin Hsia")

this.DoOutlook(cPath,1,oFolder)

ELSE

this.DoDir(cPath)

ENDIF

INDEX on path TAG path

use && close now so reopened shared

ENDIF

USE dirs

CALCULATE MAX(depth) TO nMaxDepth

SET ORDER TO 1

this.oSlider.Max=nMaxDepth

this.oSlider.value=nMaxDepth

this.StartMap()

PROCEDURE StartMap()

SELECT dirs

SEEK this.cStartPath

thisform.LockScreen= .T.

FOR i = 0 TO this.nObjcnt-1

thisform.RemoveObject("oR"+TRANSFORM(i))

ENDFOR

thisform.LockScreen= .f.

this.nObjcnt=0

this.Caption=TRANSFORM(this.cStartPath) + " Depth= "+TRANSFORM(thisform.oSlider.value) &&careful about changing this: see MyRect.Click

oRect=CREATEOBJECT("MyRect") && Create starting rectangle

oRect.Width=this.Width

oRect.Height=this.Height

oRect.top=15

this.Visible=1

this.DoMap(this.cStartPath,oRect,size)

PROCEDURE DoMap(cPath as String, oRect as myRect,nTot as Integer) && Recursive routine to draw folder rects

LOCAL cAlias,nDepth,nRuntot,cObjName

nDepth=OCCURS("\",cPath)+1 && 1 level deeper

cAlias="Temp"+TRANSFORM(nDepth) && make unique alias

SELECT * FROM dirs WHERE Path=cPath AND Depth=nDepth ORDER BY size DESC INTO CURSOR (cAlias)

IF _tally<1

USE IN (cAlias)

RETURN && none found. Leaf node.

ENDIF

nRuntot=0 && running total

SCAN && for each subrect in the rect

cObjName="oR"+TRANSFORM(this.nObjcnt) && create a new object

this.nObjcnt=this.nObjcnt+1

this.AddObject(cObjName,"MyRect") && add it to the form

WITH this.&cObjName as shape

IF MOD(nDepth,2)=1 && Odd number: multiple horizontal rects

.Top=oRect.top

.Height=oRect.Height

.Left = ROUND(oRect.Left + oRect.Width * nRuntot/nTot,0)

.Width = ROUND(oRect.Width * size / nTot,0)

ELSE && multiple vertical rects

.Top=ROUND(oRect.Top + oRect.Height * nRuntot/nTot,0)

.Height=ROUND(oRect.Height * size /nTot,0)

.Left = oRect.Left

.Width = oRect.Width

ENDIF

.ToolTipText=ALLTRIM(path) +" "+TRANSFORM(size,CPICT)

.BackColor=0xffffff-this.nObjcnt*100

.visible=1

IF .width>5 AND .height>5 AND nDepth < this.oSlider.Value && don't recur for small stuff

this.DoMap(RTRIM(Path),this.&cObjName,size) &&recur

ENDIF

SELECT (cAlias)

ENDWITH

nRuntot=nRuntot+size

ENDSCAN

USE IN (cAlias)

PROCEDURE DoDir(cPath as String) as Number && Recursive routine to get folders and their sizes

LOCAL n,i,aa[1],nTotal,nFileTotal

nTotal=0

nFileTotal=0

n=ADIR(aa,cPath+"*.*","HD",1)

FOR i = 1 TO n

IF "D"$aa[i,5]

IF aa[i,1] != '.'

nTotal= nTotal + this.DoDir(cPath+aa[i,1]+"\")

ENDIF

ELSE

IF aa[i,2]>0 && ADIR() bug > 2 gig files

nFileTotal = nFileTotal+aa[i,2]

ENDIF

ENDFOR

nTotal= nTotal+nFileTotal

INSERT INTO dirs (Path,Depth,size) VALUES (cPath,OCCURS("\",cpath),nTotal) && insert the total subfolder info

IF nFileTotal>0

INSERT INTO dirs (Path,Depth,size) VALUES (cPath+"*\",OCCURS("\",cpath)+1,nFileTotal) && for files within current folder

ENDIF

IF MOD(RECNO(),200)=0

?cPath

ENDIF

RETURN nTotal

PROCEDURE DoOutlook(cPath as String, nDepth as Integer, oFolder as Outlook.MAPIFolder) as Number && Recursive routine to get folders and their sizes

LOCAL oSubfolder as Outlook.MAPIFolder,oItem as Outlook.MailItem

LOCAL nTotal, nFileTotal

nFileTotal=0

nTotal=0

?cPath,oFolder.Items.Count

FOR EACH oSubfolder as Outlook.MAPIFolder IN oFolder.Folders

nTotal=nTotal+this.DoOutlook(cPath+"\"+oSubFolder.Name,nDepth+1,oSubFolder)

ENDFOR

FOR EACH oItem as Outlook.MailItem IN oFolder.Items

TRY

nFileTotal=nFileTotal+oItem.Size

CATCH

ENDTRY

ENDFOR

nTotal= nTotal+nFileTotal

INSERT INTO dirs (Path,Depth,size) VALUES (cPath+'\',nDepth,nTotal) && insert the total subfolder info

IF nFileTotal>0

INSERT INTO dirs (Path,Depth,size) VALUES (cPath+"*\",nDepth+1,nFileTotal) && for items within current folder

ENDIF

RETURN nTotal

PROCEDURE KeyPress(nKeyCode, nShiftAltCtrl)

thisform.release

ENDDEFINE

DEFINE CLASS MyRect AS Shape

oForm=0

PROCEDURE click(p1,p2,p3) && drill down one more level, regardless of depth of current folder

LOCAL cPath

cPath=LEFT(this.ToolTipText,AT("\",this.ToolTipText,OCCURS("\",thisform.caption)+1)) && 1 more '\' than the caption

this.oForm=CREATEOBJECT("TreeMapForm",cPath,.t.)

ENDDEFINE

DEFINE CLASS cSlider as olecontrol

oleclass="mscomctllib.slider.2"

PROCEDURE change

thisform.StartMap()

ENDDEFINE

Add a slider control to your TreeMap to vary how much detail is shown

Additional resources