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 http://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

                             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