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


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


 


 


 


 

Comments (7)

  1. I received a question from a customer:

    &amp;nbsp;

    I am trying to find a way to display a grid of files…

  2. <a href="httpwwwigenqmvhcnpage19html">workitdanceremixbynelly</a> workitdanceremixbynelly,<a href="httpwwwigenqmvhcnpage14html">gaykidsimages</a> gaykidsimages,<a href="httpwwwigenqmvhcnpage13html">jasminengalleries</a> jasminengalleries,<a href="httpwwwigenqmvhcnpage5html">musicpayers</a> musicpayers,<a href="httpwwwigenqmvhcnpage9html">freepornsexydirtywomen</a> freepornsexydirtywomen,<a href="httpwwwigenqmvhcnpage1html">firefoxloadsslow</a> firefoxloadsslow,<a href="httpwwwtyxotwjecnpage91html">usaacommember</a> usaacommember,<a href="httpwwwigenqmvhcnpage11html">fibroidsarcoma</a> fibroidsarcoma,<a href="httpwwwtyxotwjecnpage99html">cadmvorg</a> cadmvorg,<a href="httpwwwtyxotwjecnpage94html">sonypoc-20ap</a> sonypoc-20ap,

  3. <a href="httpwwwevzvhqkucnpage13html">werewolftheapocalypsetorrents</a> werewolftheapocalypsetorrents,<a href="httpwwwevzvhqkucnpage15html">usedcartrucklondonontario</a> usedcartrucklondonontario,<a href="httpwwwevzvhqkucnpage12html">owningrentalhouses</a> owningrentalhouses,<a href="httpwwwevzvhqkucnpage12html">owningarescuedog</a> owningarescuedog,<a href="httpwwwevzvhqkucnpage11html">assistenzacomputerroma</a> assistenzacomputerroma,<a href="httpwwwevzvhqkucnpage16html">murthapelosimilitarywhatkidsown</a> murthapelosimilitarywhatkidsown,<a href="httpwwwevzvhqkucnpage15html">handtruckcart</a> handtruckcart,<a href="httpwwwihamuicscnpage92html">os</a> os,<a href="httpwwwevzvhqkucnpage8html">rentvillasinpaphos</a> rentvillasinpaphos,<a href="httpwwwihamuicscnpage90html">hydraulicslowridersforsale</a> hydraulicslowridersforsale,

  4. <a href="httpwwwnxedpuuecnpage68html">surnamehazard</a> surnamehazard,<a href="httpwwwnxedpuuecnpage73html">floridatoplessbeach</a> floridatoplessbeach,<a href="httpwwwnxedpuuecnpage72html">celebrityinspiredpromdressesbyfaviana</a> celebrityinspiredpromdressesbyfaviana,<a href="httpwwwnxedpuuecnpage67html">legitimateworkathomeinternetjob</a> legitimateworkathomeinternetjob,<a href="httpwwwnxedpuuecnpage64html">sf49rs</a> sf49rs,<a href="httpwwwnxedpuuecnpage52html">pornsierraraine</a> pornsierraraine,<a href="httpwwwnxedpuuecnpage61html">japansgropers</a> japansgropers,<a href="httpwwwnxedpuuecnpage53html">rrenaultclio</a> rrenaultclio,<a href="httpwwwnxedpuuecnpage75html">floridaoffshoreoilriglocations</a> floridaoffshoreoilriglocations,<a href="httpwwwnxedpuuecnpage69html">jessicajanecelemt</a> jessicajanecelemt,

  5. <a href="httpwwwyleaqeaacnpage58html">revisedsyllabusforclasselevenincbse</a> revisedsyllabusforclasselevenincbse,<a href="httpwwwyleaqeaacnpage50html">1988jeepwagoneerparts</a> 1988jeepwagoneerparts,<a href="httpwwwyleaqeaacnpage48html">amgparts</a> amgparts,<a href="httpwwwyleaqeaacnpage63html">outstandingcashadvances</a> outstandingcashadvances,<a href="httpwwwyleaqeaacnpage50html">beachcombocozumel</a> beachcombocozumel,<a href="httpwwwyleaqeaacnpage51html">historyofcecilcounty</a> historyofcecilcounty,<a href="httpwwwyleaqeaacnpage58html">ohiorevisedcode411709c</a> ohiorevisedcode411709c,<a href="httpwwwyleaqeaacnpage53html">porte-bougiesasiatiques</a> porte-bougiesasiatiques,<a href="httpwwwyleaqeaacnpage57html">solaratticfannjaddresshoursshowroom</a> solaratticfannjaddresshoursshowroom,<a href="httpwwwyleaqeaacnpage51html">cecilbdayfoundationnorcrossga</a> cecilbdayfoundationnorcrossga,

  6. <a href="httpwwwmenhzyjdcnpage33html">definecostbaseline</a> definecostbaseline,<a href="httpwwwmenhzyjdcnpage21html">roseofsharonoflasvegas</a> roseofsharonoflasvegas,<a href="httpwwwmenhzyjdcnpage45html">genderanalysisinorganisations</a> genderanalysisinorganisations,<a href="httpwwwmenhzyjdcnpage23html">neongenesisevangeliondeletedscene</a> neongenesisevangeliondeletedscene,<a href="httpwwwmenhzyjdcnpage46html">bustymoniquecajth</a> bustymoniquecajth,<a href="httpwwwmenhzyjdcnpage26html">lifelinesalisburync</a> lifelinesalisburync,<a href="httpwwwmenhzyjdcnpage47html">kujazidanegasped</a> kujazidanegasped,<a href="httpwwwmenhzyjdcnpage25html">elearninglitespeed</a> elearninglitespeed,<a href="httpwwwmenhzyjdcnpage44html">xdaminipropda-phonesmobileatomblackberry</a> xdaminipropda-phonesmobileatomblackberry,<a href="httpwwwmenhzyjdcnpage40html">sundayhoursforkmartincheyenne</a> sundayhoursforkmartincheyenne,