************************************************** *-- Form: form1 (c:\ddrive\test\form\oletest2.scx) *-- ParentClass: form *-- BaseClass: form *-- Time Stamp: 01/22/00 02:51:00 PM * Define CLASS form1 AS form Top = 2 Left = 2 Height = 367 Width = 628 DoCreate = .T. Caption = "TreeView - Statusbar testpad" BackColor = RGB(192,192,192) Name = "Form1" lastrec = .F. *-- Node object reference nodx = .F. *-- Flag for drag operation lindrag = .F. indrag = .F. nxtwips = .F. nytwips = .F. originalhgt = .F. originalwdt = .F. *-- Fullpath of node clicked savenodevalue = .F. Add OBJECT oletreeview AS olecontrol WITH ; Top = 3, ; Left = 2, ; Height = 297, ; Width = 254, ; Name = "Oletreeview" Add OBJECT oleimageslist AS olecontrol WITH ; Top = 6, ; Left = 1, ; Height = 45, ; Width = 65, ; Name = "oleImagesList" Add OBJECT olecontrol2 AS olecontrol WITH ; Top = 349, ; Left = 0, ; Height = 18, ; Width = 628, ; Align = 2, ; Name = "Olecontrol2" Add OBJECT text1 AS textbox WITH ; OLEDragMode = 1, ; Height = 23, ; Left = 21, ; Top = 320, ; Width = 591, ; Name = "Text1" Add OBJECT edit1 AS editbox WITH ; Height = 296, ; Left = 285, ; Top = 6, ; Width = 326, ; Name = "Edit1" *-- Fill the tree values Procedure filltree Lparameters tcDirectory This.show #Define tvwFirst 0 #Define tvwLast 1 #Define tvwNext 2 #Define tvwPrevious 3 #Define tvwChild 4 *tcDirectory = iif(oFolder.IsRootFolder(), substr(tcDirectory,1,len(tcDirectory)-1), tcDirectory) oNode=THIS.oletreeview.nodes.add(,tvwFirst,"TopKey",tcDirectory,"Drive") This._SubFolders(oNode) This.olecontrol2.panels(1).text = "Ready" Endproc Procedure pixeltotwips *-- Code for PixelToTwips method Local liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY * Define some constants. #Define cnLOG_PIXELS_X 88 #Define cnLOG_PIXELS_Y 90 #Define cnTWIPS_PER_INCH 1440 * 1440 twips per inch * 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 #Define tvwFirst 0 #Define tvwLast 1 #Define tvwNext 2 #Define tvwPrevious 3 #Define tvwChild 4 lcFolder = oNode.Fullpath lcFolder = strtran(lcFolder,":\\",":\") oFS = CREATEOBJECT('Scripting.FileSystemObject') oFolder = oFS.GetFolder(lcFolder) With ThisForm.oletreeview.nodes If oNode.Children > 0 If oNode.Child.Key = oNode.Key+"dummy" .Remove(oNode.Child.Index) nChild = 1 For each oSubFolder in oFolder.Subfolders oNodex = .Add(oNode.Key, tvwChild, ; oNode.Key+padl(nChild,3,"0"), oSubFolder.name, "ClosedFolder" ) oNodex.ExpandedImage = "OpenFolder" If oSubFolder.Name # "System Volume Information" and oSubFolder.Subfolders.Count > 0 oNodex = .Add(oNode.Key+padl(nChild,3,"0"), tvwChild, ; oNode.Key+padl(nChild,3,"0")+"dummy", "dummy", "ClosedFolder" ) Endif nChild = nChild+1 Endfor Endif Else If oFolder.Subfolders.count > 0 oNodex = .Add(oNode.Key, tvwChild, ; oNode.Key+"dummy", "dummy", "ClosedFolder" ) Endif Endif Endwith Endproc Procedure QueryUnload Thisform.nodx = .null. Endproc Procedure Init This.originalhgt = this.Height This.originalwdt = this.Width Thisform.pixeltotwips() Set TALK OFF Wait WINDOW NOWAIT "Loading information. Please stand by..." * 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 This.oletreeview.linestyle =1 This.oletreeview.labeledit =1 This.oletreeview.indentation = 5 This.oletreeview.imagelist = this.oleimageslist.object This.filltree("c:\") Endproc Procedure Resize lnHgtRatio = this.Height / this.originalhgt lnWdtRatio = this.Width / this.originalwdt For each oControl in this.Controls With oControl .width = .width * lnWdtRatio .height = .height * lnHgtRatio Endwith Endfor This.originalhgt = this.Height This.originalwdt = this.Width Endproc Procedure addnode Endproc Procedure oletreeview.Expand *** ActiveX Control Event *** Lparameters node Thisform._SubFolders(node) Node.ensurevisible Endproc Procedure oletreeview.NodeClick *** OLE Control Event *** Lparameters node Thisform.text1.value = strtran(node.fullpath,":\\",":\") Thisform.savenodevalue = strtran(node.fullpath,":\\",":\") Node.ensurevisible Thisform.olecontrol2.panels(2).text = node.text * Show current children With this .DropHighlight = .null. If node.Children > 0 Thisform.edit1.Value = "Current childs of this node :" + chr(13) + ; "-----------------------------" + chr(13) + Node.Child.Text lnIndex = Node.Child.Index Do while lnIndex # Node.Child.LastSibling.Index Thisform.edit1.Value = thisform.edit1.Value + chr(13) + .nodes(lnIndex).Next.Text lnIndex = .nodes(lnIndex).Next.Index Enddo Endif lnIndent = 0 lnIndex = Node.Index Do while lnIndex # Node.Root.Index lnIndex = .nodes(lnIndex).Parent.Index lnIndent = lnIndent + 1 Enddo Endwith With thisform.olecontrol2 .panels(3).text = strtran(node.fullpath,":\\",":\") .panels(1).text = node.key +"-"+ltrim(str(lnIndex)) Endwith Endproc Procedure oletreeview.MouseDown *** OLE Control Event *** Lparameters button, shift, x, y Thisform.nodx = this.SelectedItem oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips ) If type("oHitTest")= "O" and !isnull(oHitTest) Thisform.savenodevalue = strtran(oHitTest.fullpath,":\\",":\") Endif oHitTest = .null. Endproc Procedure oletreeview.OLEDragOver *** OLE 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 If type("this.DropHighLight") = "O" and !isnull(this.DropHighlight) If type("thisform.SaveNodeValue") = "C" and ; Thisform.savenodevalue # strtran(this.DropHighlight.fullpath,":\\",":\") Thisform.edit1.Value = "Dropped "+thisform.savenodevalue+; " on "+strtran(this.DropHighlight.fullpath,":\\",":\") Else Thisform.edit1.Value = "Dropped "+Data.GetData(1)+" on "+this.DropHighlight.text Endif Endif Endif This.DropHighlight = .null. Endproc Procedure olecontrol2.Init This.panels(3).width = this.width - (this.panels(1).width+this.panels(2).width+5) Endproc Procedure text1.OLEDragDrop Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord If oDataObject.Getformat(1) &&CF_TEXT This.Value = oDataObject.GetData(1) Endif Endproc Enddefine * *-- EndDefine: form1 **************************************************Cetin