> ADD OBJECT otree AS olecontrol WITH ; > Top = 35, ; > Left = 0, ; > Height = 213, ; > Width = 144, ; > Name = "oTree" >>
* 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 = 380 Width = 628 DoCreate = .T. Caption = "TreeView - testpad" BackColor = Rgb(192,192,192) Name = "myForm" ShowWindow=2 *-- Node object reference nodx = .F. nxtwips = .F. nytwips = .F. originalhgt = .F. originalwdt = .F. Add Object cp As CommandButton With Caption='Copy to clipboard' Add Object myTree As OleControl With ; Top = 92, ; Left = 0, ; Height = 286, ; 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' Procedure cp.Click Tvlister(Thisform.oletreeview) Endproc Procedure oleimageslist.Init lcIconPath = Home(4)+'Icons\Win95' With This .ImageHeight = 16 .ImageWidth = 16 .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"\openfold.ico")) .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"\clsdfold.ico")) .ListImages.Add(,"Drive",LoadPicture(lcIconPath+"\525flop1.ico")) .ListImages.Add(,"Floppy",LoadPicture(lcIconPath+"\35floppy.ico")) .ListImages.Add(,"NetDrive",LoadPicture(lcIconPath+"\drivenet.ico")) .ListImages.Add(,"CDDrive",LoadPicture(lcIconPath+"\CDdrive.ico")) Endwith Endproc *-- 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 With This.oletreeview .Object.CheckBoxes = .T. .linestyle =1 .labeledit =1 .indentation = 5 .imagelist = This.oleimageslist.Object .PathSeparator = '\' .Scroll = .T. .OLEDragMode = 0 .OLEDropMode = 0 Endwith This.filltree("c:\") Endproc Procedure CheckRest Lparameters tnIndex, tlCheck Local lnIndex, lnLastIndex With This.oletreeview .nodes(tnIndex).Checked = tlCheck If .nodes(tnIndex).Children > 0 lnIndex = .nodes(tnIndex).Child.Index lnLastIndex = .nodes(tnIndex).Child.LastSibling.Index This.CheckRest(lnIndex, tlCheck) Do While lnIndex # lnLastIndex lnIndex = .nodes(lnIndex).Next.Index This.CheckRest(lnIndex, tlCheck) Enddo Endif Endwith Endproc Procedure oletreeview.Expand *** ActiveX Control Event *** Lparameters Node If Node.Key='L003' Node.expanded = .F. Return Endif Thisform._SubFolders(Node) Node.ensurevisible Endproc Procedure oletreeview.NodeClick *** ActiveX Control Event *** Lparameters Node Node.ensurevisible This.DropHighlight = .Null. Endproc Procedure oletreeview.KeyUp Lparameters nKeyCode,Shift * Wait window Transform(nKeyCode)+'_'+Transform(shift) TIMEOUT 2 If nKeyCode = 32 And Shift=0 oNode=This.SelectedItem If Type("oNode")= "O" And !Isnull(oNode) If Type('oNode.parent')='O' And !Isnull(oNode.Parent) llChecked = oNode.Parent.Checked oNode.Checked = m.llChecked Else *oNode.Checked = !oNode.Checked Thisform.CheckRest(oNode.Index,oNode.Checked) Endif Endif Endif Endproc Procedure oletreeview.MouseUp Lparameters Button, Shift, x, Y If Button=1 oNode = This.HitTest( x * Thisform.nxtwips, Y * Thisform.nytwips ) If Type("oNode")= "O" And !Isnull(oNode) If Type('oNode.parent')='O' And !Isnull(oNode.Parent) llChecked = oNode.Parent.Checked oNode.Checked = m.llChecked Else Thisform.CheckRest(oNode.Index,oNode.Checked) Endif Endif Endif Endproc *!* Procedure oletreeview.NodeCHeck *!* *** ActiveX Control Event *** *!* Lparameters node *!* LOCAL lnIndex, llChecked *!* llChecked = node.Checked *!* If Type('node.parent')='O' and !IsNull(node.parent) *!* nodefault *!* llChecked = node.parent.checked *!* EndIf *!* node.Checked = llChecked *!* thisform.CheckRest(Node.Index,llChecked) *!* return *!* If node.Children > 0 *!* Node.Child.Checked = llChecked *!* thisform.CheckRest(Node.Child.Index,llChecked) *!* lnIndex = Node.Child.Index *!* Do while lnIndex # Node.Child.LastSibling.Index *!* this.Nodes(lnIndex).Next.Checked = llChecked *!* thisform.CheckRest(lnIndex,llChecked) *!* lnIndex = this.Nodes(lnIndex).Next.Index *!* Enddo *!* Endif *!* Endproc Procedure oletreeview.LostFocus With This.SelectedItem .BackColor = Rgb(49,106,197) .ForeColor = Rgb(255,255,255) Endwith Endproc Procedure oletreeview.GotFocus This.SelectedItem.BackColor = Rgb(255,255,255) 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 If !Isnull(oHitTest) If Y <= This.Top + 150 And Type('oHitTest.Previous')='O' And !Isnull(oHitTest.Previous) oHitTest.Previous.ensurevisible Endif If Y >= This.Top + This.Height - 150 And Type('oHitTest.Next')='O' And !Isnull(oHitTest.Next) oHitTest.Next.ensurevisible Endif Endif 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 Procedure ProcessNodes Lparameters toNode Local loChildNode ? toNode.Text If toNode.Children > 0 loChildNode = toNode.Child Do While Vartype( loChildNode ) = [O] Thisform.ProcessNodes( loChildNode ) loChildNode = loChildNode.Next Enddo Endif Endproc EnddefineAlso check UT magazine June 2001 issue.