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 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
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
Anonymous
July 31, 2006
I received a question from a customer:
&nbsp;
I am trying to find a way to display a grid of files...Anonymous
July 31, 2007
<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,Anonymous
July 31, 2007
<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,Anonymous
July 31, 2007
<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,Anonymous
August 01, 2007
<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,Anonymous
August 01, 2007
<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,Anonymous
January 20, 2009
PingBack from http://www.hilpers.com/1068453-verzeichnis-ubersicht