* 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 public oForm oForm = Createobject('myForm') oForm.Show Define Class myForm As Form Height = 300 Width = 400 Caption = "TreeView - testpad" *-- Node object reference nodx = .F. nxtwips = .F. nytwips = .F. Add Object oletreeview As OleControl With ; Top = 10, ; Left = 10, ; Height = 280, ; Width = 380, ; Name = "OleTreeView", ; OleClass = 'MSComCtlLib.TreeCtrl' *-- Fill the tree values Procedure filltree Lparameters tcDirectory 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) Endwith Insert Into crsNodes (NodeKey, ParentKey, NodeText) Values (oNode.Key, '',oNode.Text) This._SubFolders(oNode) Endproc Procedure pixeltotwips *-- Code for PixelToTwips method Local liHDC * 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 liHDC = GetDC(GetActiveWindow()) * Get the twips per pixel. Thisform.nxtwips = ( cnTWIPS_PER_INCH / GetDeviceCaps(liHDC, cnLOG_PIXELS_X) ) Thisform.nytwips = ( cnTWIPS_PER_INCH / GetDeviceCaps(liHDC, cnLOG_PIXELS_Y) ) 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) If oSubFolder.Name # "System Volume Information" And oSubFolder.Subfolders.Count > 0 oNodex = .Add(crsNodes.NodeKey, tvwChild, ; crsNodes.NodeKey+"dummy", "dummy" ) Endif Endfor Endif Else If oFolder.Subfolders.Count > 0 oNodex = .Add(oNode.Key, tvwChild, ; oNode.Key+"dummy", "dummy" ) Endif Endif Endwith Endproc Procedure QueryUnload Thisform.nodx = .Null. Endproc Procedure Init This.pixeltotwips() Set Talk Off If Type("THIS.oleTreeView") # "O" Or Isnull(This.oletreeview) Return .F. Endif With This.oletreeview .linestyle =1 .labeledit =1 .indentation = 5 .PathSeparator = '\' .OLEDragMode = 1 .OLEDropMode = 1 Endwith oFS = Createobject('Scripting.FileSystemObject') For Each oDrive In oFS.Drives If oDrive.IsReady This.filltree(oDrive.Rootfolder.Path) 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)) For ix = 1 To Objtoclient(This, 3) - 1 oHitTest = This.HitTest( m.ix * .nxtwips, Y * .nytwips ) If Type("oHitTest")= "O" And !Isnull(oHitTest) Exit Endif Endfor Endif 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 EnddefineCetin