* Define some constants. #Define tvwFirst 0 #Define tvwLast 1 #Define tvwNext 2 #Define tvwPrevious 3 #Define tvwChild 4 #Define cnLOG_PIXELS_X 88 #Define cnLOG_PIXELS_Y 90 #Define cnTWIPS_PER_INCH 1440 * 1440 twips per inch oForm = createobject('myForm') oForm.Show Read events Define CLASS myForm AS form Height = 300 Width = 600 DoCreate = .T. Caption = "TreeView - testpad" Name = "myForm" *-- Node object reference nodx = .F. nxtwips = .F. nytwips = .F. Add OBJECT oletreeview AS olecontrol WITH ; Top = 0, ; Left = 0, ; Height = 290, ; Width = 590, ; Name = "OleTreeView", ; OleClass = 'MSComCtlLib.TreeCtrl' Add OBJECT oleimageslist AS olecontrol WITH ; Top = 0, ; Left = 0, ; Height = 100, ; Width = 100, ; Name = "oleImagesList",; OleClass = 'MSComCtlLib.ImageListCtrl' *-- Fill the tree values Procedure filltree Lparameters tcDirectory, tcImage This.show Create cursor crsNodes (NodeKey c(15), ParentKey c(15), NodeText m, NewParent c(15)) Local oNode With THIS.oletreeview.nodes oNode=.add(,tvwFirst,"root"+padl(.count,3,'0'),tcDirectory,tcImage) Endwith Insert into crsNodes (NodeKey, ParentKey, NodeText) values (oNode.Key, '',oNode.Text) This._SubFolders(oNode) Endproc Procedure pixeltotwips *-- Code for PixelToTwips method Local liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY * Declare some Windows API functions. Declare integer GetActiveWindow in WIN32API Declare integer GetDC in WIN32API integer iHDC Declare integer GetDeviceCaps in WIN32API integer iHDC, integer iIndex * Get a device context for VFP. liHWnd = GetActiveWindow() liHDC = GetDC(liHWnd) * Get the pixels per inch. liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X) liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y) * Get the twips per pixel. Thisform.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX ) Thisform.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY ) Return Endproc *-- Collect subfolders Procedure _SubFolders Lparameters oNode Local nChild, oNodex lcFolder = oNode.Fullpath lcFolder = strtran(lcFolder,":\\",":\") oFS = CREATEOBJECT('Scripting.FileSystemObject') oFolder = oFS.GetFolder(lcFolder) With ThisForm.oletreeview lnIndent = 0 lnIndex = oNode.Index Do while lnIndex # oNode.Root.Index ; and type('.nodes(lnIndex).Parent')='O' ; and !isnull(.nodes(lnIndex).Parent) lnIndex = .nodes(lnIndex).Parent.Index lnIndent = lnIndent + 1 Enddo lcChildKeyPrefix = 'L'+padl(lnIndent,3,'0')+'_' Endwith With ThisForm.oletreeview.nodes If oNode.Children > 0 If oNode.Child.Key = oNode.Key+"dummy" .Remove(oNode.Child.Index) For each oSubFolder in oFolder.Subfolders Insert into crsNodes ; (NodeKey, ParentKey, NodeText) ; values ; (lcChildKeyPrefix+' '+padl(reccount('crsNodes')+1,5,'0'), ; oNode.Key, oSubFolder.Path) oNodex = .Add(oNode.Key, tvwChild, ; crsNodes.NodeKey, oSubFolder.name, "ClosedFolder","OpenFolder" ) oNodex.ExpandedImage = "OpenFolder" If oSubFolder.Name # "System Volume Information" and oSubFolder.Subfolders.Count > 0 oNodex = .Add(crsNodes.NodeKey, tvwChild, ; crsNodes.NodeKey+"dummy", "dummy", "ClosedFolder","OpenFolder" ) Endif Endfor Endif Else If oFolder.Subfolders.count > 0 oNodex = .Add(oNode.Key, tvwChild, ; oNode.Key+"dummy", "dummy", "ClosedFolder","OpenFolder" ) Endif Endif Endwith Endproc Procedure QueryUnload Thisform.nodx = .null. Clear events Endproc Procedure Init This.pixeltotwips() Set TALK OFF * Check to see if OCX installed and loaded. If TYPE("THIS.oleTreeView") # "O" OR ISNULL(THIS.oletreeview) Return .F. Endif If TYPE("THIS.oleImagesList") # "O" OR ISNULL(THIS.oleimageslist) Return .F. Endif lcIconPath = home(4)+'Icons\' With this.oleimageslist .ImageHeight = 16 .ImageWidth = 16 .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"Win95\openfold.ico")) .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"Win95\clsdfold.ico")) .ListImages.Add(,"Drive",LoadPicture(lcIconPath+"Win95\drivenet.ico")) .ListImages.Add(,"Floppy",LoadPicture(lcIconPath+"Win95\35floppy.ico")) .ListImages.Add(,"NetDrive",LoadPicture(lcIconPath+"Win95\drivenet.ico")) .ListImages.Add(,"CDDrive",LoadPicture(lcIconPath+"Win95\CDdrive.ico")) .ListImages.Add(,"RAMDrive",LoadPicture(lcIconPath+"Win95\desktop.ico")) .ListImages.Add(,"Unknown",LoadPicture(lcIconPath+"Misc\question.ico")) Endwith With THIS.oletreeview .linestyle =1 .labeledit =1 .indentation = 5 .imagelist = this.oleimageslist.object .PathSeparator = '\' .OleDragMode = 1 .OleDropMode = 1 Endwith oFS = createobject('Scripting.FileSystemObject') Local array aDrvTypes[7] aDrvTypes[1]="Unknown" aDrvTypes[2]="Floppy" aDrvTypes[3]="Drive" aDrvTypes[4]="NetDrive" aDrvTypes[5]="CDDrive" aDrvTypes[6]="RAMDrive" For each oDrive in oFS.Drives If oDrive.IsReady This.filltree(oDrive.Rootfolder.Path, aDrvTypes[oDrive.DriveType+1]) Endif Endfor Endproc Procedure oletreeview.Expand *** ActiveX Control Event *** Lparameters node Thisform._SubFolders(node) Node.ensurevisible Endproc Procedure oletreeview.NodeClick *** ActiveX Control Event *** Lparameters node Node.ensurevisible This.DropHighlight = .null. Endproc Procedure oletreeview.MouseDown *** ActiveX Control Event *** Lparameters button, shift, x, y With thisform oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips ) If type("oHitTest")= "O" and !isnull(oHitTest) This.SelectedItem = oHitTest Endif .nodx = this.SelectedItem Endwith oHitTest = .null. Endproc Procedure oletreeview.OLEDragOver *** ActiveX Control Event *** Lparameters data, effect, button, shift, x, y, state oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips ) If type("oHitTest")= "O" This.DropHighlight = oHitTest Endif Endproc Procedure oletreeview.OLEDragDrop *** ActiveX Control Event *** Lparameters data, effect, button, shift, x, y If Data.Getformat(1) &&CF_TEXT With this If !isnull(thisform.nodx) and type(".DropHighLight") = "O" and !isnull(.DropHighlight) loSource = thisform.nodx loTarget = .DropHighlight If loSource.Key # loTarget.key and type('loSource.Parent') = 'O' lcSourceParentKey = loSource.Parent.Key lcTargetParentKey = loTarget.Parent.Key If substr(lcSourceParentKey,1,at('_',lcSourceParentKey)-1) == ; substr(lcTargetParentKey,1,at('_',lcTargetParentKey)-1) lcSourceKey = iif(lcSourceParentKey == lcTargetParentKey,'',; iif(shift=1,'mv','cp'))+loSource.Key lcSourceText = loSource.Text llRemoveSource = (lcSourceParentKey == lcTargetParentKey or shift=1) * Check here for children repopulation since we're simulating with existing directories * llGetChildren should be false for copy-move from another parent dir llGetChildren = (lcSourceParentKey == lcTargetParentKey) If llRemoveSource .nodes.Remove(loSource.Index) Endif * Check if node exists already If type('.Nodes(lcSourceKey)') # 'O' oNode=.nodes.add(loTarget.Key,tvwPrevious,lcSourceKey,lcSourceText,; "ClosedFolder","OpenFolder") .SelectedItem = oNode If llGetChildren Thisform._SubFolders(oNode) Endif Endif Endif Endif Endif Endwith Endif This.DropHighlight = .null. Endproc EnddefineSobre esta base vc pode adicionar outros icones e fazer com que exiba os arquivos como o Windows Explorer...