* 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 Top = 2 Left = 2 Height = 315 Width = 628 DoCreate = .T. Caption = "TreeView - testpad" BackColor = RGB(192,192,192) Name = "myForm" *-- Node object reference nodx = .F. nxtwips = .F. nytwips = .F. originalhgt = .F. originalwdt = .F. Add OBJECT oletreeview AS olecontrol WITH ; Top = 12, ; Left = 0, ; Height = 296, ; Width = 624, ; 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 This.show Create cursor crsNodes (NodeKey c(15), ParentKey c(15), NodeText m, NewParent c(15)) With THIS.oletreeview.nodes oNode=.add(,tvwFirst,"root"+padl(.count,3,'0'),tcDirectory,"Drive") 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 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.originalhgt = this.Height This.originalwdt = this.Width Thisform.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(3)+'Graphics\Icons\Win95' With this.oleimageslist .ImageHeight = 16 .ImageWidth = 16 .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"\openfold.ico")) .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"\clsdfold.ico")) .ListImages.Add(,"Drive",LoadPicture(lcIconPath+"\drive.ico")) .ListImages.Add(,"Floppy",LoadPicture(lcIconPath+"\35floppy.ico")) .ListImages.Add(,"NetDrive",LoadPicture(lcIconPath+"\drivenet.ico")) .ListImages.Add(,"CDDrive",LoadPicture(lcIconPath+"\CDdrive.ico")) Endwith With THIS.oletreeview .linestyle =1 .labeledit =1 .indentation = 5 .imagelist = this.oleimageslist.object .PathSeparator = '\' .OleDragMode = 1 .OleDropMode = 1 Endwith This.filltree("c:\") 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 EnddefineCetin