Treeview MSComctlLib.TreeCtrl.2 used as explorer interface

Published on by Yousfi Benameur

              

[Post 273]

this code builds a treeview interface with populated imagelist and with any directory of disc.
the treeview and imagelist activeX are shipped with vfp and used communly.
in treeview can:
-show/hide checkBoxes
- expand-collapse  nodes
-go top-gobottom
-search for any string in treeview (with red coloring)
-change fontname/fontsize-fontstyle(bold-italic-underline-node forecolor-backcolor)
-can search any string contained in node.text.any found is colored with red.
to reset color to black(originl) simply search an empty string with combo.search.
any command in combo is switched to its contrary with "!"(ex: fontbold----!fontbold).this set a property or reset it to initial value.
any node clicked fires a second interface as vfp grid fill with all files of the source folder(not recursively).
files are listed with filename,size,date modified-time modified, attribute

files of grid are sum in bottom of grid.can also use dynamicBackcolor for beautifying grid.
can execute any file selected in grid with shellexecute API (fires the associated application otherwise ask what app open the file otherwise error (result<=32)).
can learn many things on treeview here( see previous post in same subject also).
*in code 2 i present the same activeX (treeview+imagelist) controls embed on a web page (in IE11 emulated).


Click on code to select [then copy] -click outside to deselect

                    

*1* created on wednesday 18 of april 2018
*a treeview+imagelist controls on a vfp form as explorer interface.

Public oform1
oform1=Newobject("ytree")
oform1.Show
Read Events
Return
*
Define Class ytree As Form
	DataSession = 2
	BorderStyle = 3
	Height = 515
	Width = 1110
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Custom VFP explorer"
	lexpanded = .F.
	ycl = .F.
	Name = "form1"

	Add Object cmdgetdir As CommandButton With ;
		Top = 453, ;
		Left = 319, ;
		Height = 23, ;
		Width = 72, ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Anchor = 768, ;
		Caption = "\<Directory...", ;
		TabIndex = 4, ;
		Name = "cmdGetDir"

	Add Object text1 As TextBox With ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Anchor = 768, ;
		Enabled = .F., ;
		Height = 23, ;
		Left = 11, ;
		TabIndex = 3, ;
		Top = 453, ;
		Width = 301, ;
		DisabledForeColor = Rgb(0,0,0), ;
		Name = "Text1"

	Add Object shape2 As Shape With ;
		Top = 13, ;
		Left = 11, ;
		Height = 33, ;
		Width = 445, ;
		BackStyle = 0, ;
		SpecialEffect = 0, ;
		Name = "Shape2"

	Add Object label4 As Label With ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		WordWrap = .T., ;
		Caption = "Click on Directory to choose a directory and create an outline of its subdirectories.", ;
		Height = 16, ;
		Left = 20, ;
		Top = 24, ;
		Width = 502, ;
		autosize=.t., ;
		Name = "Label4"

	Add Object oleimageslist As OleControl With ;
		oleclass="MSComctlLib.ImageListCtrl.2",;
		Top = 12, ;
		Left = 486, ;
		Height = 45, ;
		Width = 65, ;
		Name = "oleImagesList"

	Add Object oletreeview As OleControl With ;
		oleclass="MSComctlLib.TreeCtrl.2",;
		Top = 60, ;
		Left = 12, ;
		Height = 360, ;
		Width = 456, ;
		Anchor = 135, ;
		Name = "oleTreeview"

	Add Object grid1 As Grid With ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Anchor = 45, ;
		HeaderHeight = 25, ;
		Height = 420, ;
		Left = 535, ;
		ReadOnly = .T., ;
		RowHeight = 16, ;
		Top = 12, ;
		Width = 572, ;
		HighLightStyle=2,;
		Name = "Grid1"

	Add Object cmdexpandcollapse As CommandButton With ;
		Top = 453, ;
		Left = 405, ;
		Height = 24, ;
		Width = 108, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Expand/Collapse", ;
		Name = "cmdExpandCollapse"

	Add Object ysum As TextBox With ;
		Anchor = 768, ;
		Format = "9999999999.99", ;
		Height = 24, ;
		Left = 840, ;
		ReadOnly = .T., ;
		Top = 484, ;
		Width = 85, ;
		Name = "ySum"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		Anchor = 768, ;
		Caption = "KOctets", ;
		Height = 17, ;
		Left = 792, ;
		Top = 487, ;
		Width = 45, ;
		Name = "Label1"

	Add Object shape1 As Shape With ;
		Top = 487, ;
		Left = 600, ;
		Height = 13, ;
		Width = 13, ;
		Anchor = 768, ;
		Curvature = 99, ;
		MousePointer = 15, ;
		ToolTipText = "dynamicbackcolor", ;
		BackColor = Rgb(128,128,128), ;
		BorderColor = Rgb(255,0,0), ;
		Name = "Shape1"

	Add Object check1 As Checkbox With ;
		Top = 480, ;
		Left = 420, ;
		Height = 17, ;
		Width = 87, ;
		Anchor = 768, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		Caption = "CheckBoxes", ;
		Name = "Check1"

	Add Object ylbl As Label With ;
		AutoSize = .T., ;
		Anchor = 768, ;
		Caption = "", ;
		Height = 17, ;
		Left = 677, ;
		Top = 463, ;
		Width = 2, ;
		Name = "ylbl"

	Add Object ylbl1 As Label With ;
		Anchor = 768, ;
		WordWrap = .T., ;
		Caption = "", ;
		Height = 13, ;
		Left = 534, ;
		Top = 463, ;
		Width = 576, ;
		Name = "ylbl1"

	Add Object combo1 As ComboBox With ;
		Anchor = 768, ;
		Height = 24, ;
		Left = 22, ;
		Top = 482, ;
		Width = 172, ;
		Name = "Combo1"
    
    Add Object tsearch As textbox with ;
	Anchor=768,;
	left=196 ,;
	width=60 ,;
	height=24,;
	top=482,;
	name="tsearch"
		
	ADD OBJECT  YCOM AS commandbutton WITH ;
  Anchor=768,;
	Top = 484,;
	Left = 984,;
	Height = 27,;
	Width = 108,;
	FontBold = .T.,;
	Caption = "Run file selected",;
	MousePointer = 15,;
	SpecialEffect = 2,;
	Name = "ycom"


	PROCEDURE ycom.MouseLeave
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		this.backcolor=rgb(240,240,240)
	ENDPROC


	PROCEDURE ycom.MouseEnter
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		this.backcolor=255
	ENDPROC


	PROCEDURE ycom.Click	
	if !used("ycurs") or reccount()=0
    return .f.
    endi

		sele ycurs
        wait window allt(thisform.ylbl1.caption)+xfilename		 nowait
		local result
		result = ShellExecute(0, "open", allt(thisform.ylbl1.caption)+xfilename,"","",1)
		if result<=32
		messagebox("An error was occured!",16+4096,'',1300)
		endi
	ENDPROC
	

	Procedure filltree
	Parameters m.path, m.nlevel, m.nCount
	Local DirArr,i,nTotDir,lvl,pkey
	m.path = Alltrim(m.path)
	If Parameters()<2 Or Type("m.nlevel") #"N"
		lvl = 0
	Else
		lvl = m.nlevel
	Endif

	If Parameters()<2 Or Type("m.nCount") #"N"
		Cnt = 0
	Else
		Cnt = m.nCount
	Endif

	lvl = lvl + 1
	Cnt = Cnt + 1

	pkey = Lower(Substr(m.path,1,Rat("\",m.path,2)))+"_"

* Add items to treeview control
	o = This.oletreeview
	If Cnt = 1
		oNode = o.nodes.Add(,1,Lower(m.path)+"_",Lower(m.path),,)
* object.Add(relative, relationship, key, text, image, selectedimage)
		oNode.Image = "clsdFold"
	Else
		x=Lower(m.path)
		N=Getwordcount(m.x,"\")
		Y=Getwordnum(m.x,N,"\")
		oNode = o.nodes.Add(m.pkey,4,Lower(m.path)+"_",m.y,,)
		oNode.Image = "clsdFold"
	Endif

	Dimension DirArr[1,1]
	nTotDir=Adir(DirArr,m.path+"*.","D")
	Asort(DirArr)

	For i = 1 To m.nTotDir
		If DirArr[m.i,1] != '.' And Atc('D',DirArr[m.i,5])#0
			This.filltree(m.path+DirArr[m.i,1]+'\', m.lvl, m.cnt)
		Endif
	Endfor
	Endproc

	Procedure Init
	_Screen.WindowState=1
	Set Talk Off
	Set Date short
	If  Fontmetric(1, 'MS Sans Serif', 8, '') # 13 Or ;
			fontmetric(4, 'MS Sans Serif', 8, '') # 2 Or ;
			fontmetric(6, 'MS Sans Serif', 8, '') # 5 Or ;
			fontmetric(7, 'MS Sans Serif', 8, '') # 11
		This.SetAll('fontname', 'Tahoma')
	Else
		This.SetAll('fontname','MS Sans Serif')
	Endif
	This.SetAll('fontsize',8)

* Check to see if OCX installed and loaded.
	If Type("THIS.oleTreeview") # "O" Or Isnull(This.oletreeview)
		Return .F.
	Endif
* Check to see if OCX installed and loaded.
	If Type("THIS.oleImagesList") # "O" Or Isnull(This.oleimageslist)
		Return .F.
	Endif

	This.oletreeview.ImageList = This.oleimageslist

	Local m.cDir
	m.cDir=Home(1)
	Thisform.text1.Value = m.cDir
	Thisform.oletreeview.nodes.Clear
	Thisform.filltree(m.cDir)
	Thisform.cmdexpandcollapse.Click
	thisform.combo1.setfocus
	thisform.combo1.click
	Endproc

	Procedure Resize
	With Thisform.grid1
		Try
			Local m.w
			m.w=.Width
			.column1.Width=0.58*w
			.column2.Width=0.1*w
			.column3.Width=0.1*w
			.column4.Width=0.1*w
			.column5.Width=0.1*w
			Locate
			.Refresh
		Catch
		Endtry
	Endwith
	Endproc

	Procedure Destroy
	Close Data All
	Clea Events
	Endproc

	Procedure cmdgetdir.Click
	Local cDir
	cDir = Getdir()
	If Empty(m.cDir)
		Return
	Endif

	Thisform.text1.Value = m.cDir
	Thisform.oletreeview.nodes.Clear
	Thisform.filltree(m.cDir)
	Endproc

	Procedure oleimageslist.Init
* always populate before use otheriwse error
	With This
		.ImageHeight = 16
		.ImageWidth =  16
		.ListImages.Add(,"clsdFold",LoadPicture(Home(1)+"graphics\icons\win95\clsdfold.ico" ))
		.ListImages.Add(,"openFold",LoadPicture(Home(1)+"graphics\icons\win95\openfold.ico" ))
		.ListImages.Add(,"misc",LoadPicture(Home(1)+"graphics\icons\misc\misc15.ico" ))
	Endwith
	Endproc

   Procedure load
   Declare Integer SetCursorPos In WIN32API Integer, Integer
   Declare integer mouse_event In WIN32API Integer,Integer,Integer,Integer,Integer
   	&&shellexecute
  DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,;
  STRING cOperation,   STRING cFileName, STRING cParameters, STRING cDirectory, INTEGER nShowWindow
   endproc

	Procedure oletreeview.NodeClick
	Lparameters Node
	u=Addbs(Substr(Allt(Node.Key),1,Len(Allt(Node.Key))-1))
	gnbre=Adir(gabase,m.u+"*.*")
	Thisform.ylbl1.Caption=m.u

	If Used("ycurs")
		Use In Select("ycurs")
	Endi
	Crea Cursor ycurs (xfilename c(40),xsize i,lmodif d ,tmodif c(12),Attr c(5))
	For i=1 To gnbre
		Insert Into ycurs Values (Justfname(Proper(gabase(i,1))),gabase(i,2),gabase(i,3),gabase(i,4),gabase(i,5))
	Endfor

	With Thisform.oletreeview
		For Each xnode In  .nodes
			xnode.Image="clsdFold"
		Next
		Node.Image="openFold"  &&warning : sensitive
	Endwith
*Note: The Nodes collection is a 1-based collection.

	Local m.x
	Sum xsize/1024 To m.x
	Thisform.ysum.Value=Trans(m.x,"9999999999.99")
	Thisform.ylbl.Caption=Trans(gnbre)+" files"
	With Thisform.grid1
		.RecordSource=""
		.RecordSource="ycurs"
		.RecordSourceType=1
		.GridLines=0
		.DeleteMark=.F.
		.HeaderHeight=25
		.SetAll("fontbold",.T.,'header')
		.SetAll("fontsize",10,"header")
		Local m.w
		m.w=.Width
		.column1.Width=0.58*w
		.column2.Width=0.1*w
		.column3.Width=0.1*w
		.column4.Width=0.1*w
		.column5.Width=0.1*w
		Locate
		.Refresh
	Endwith
	Endproc

	Procedure cmdexpandcollapse.Click
	If Thisform.oletreeview.nodes.Count > 0
* only do this if we have nodes in the treeview
		For Each loNode In Thisform.oletreeview.nodes
			If loNode.Children > 0
* only do this if this node has child nodes
				loNode.Expanded = !Thisform.lexpanded
			Endif
		Endfor
* set form's Expanded property to new value
		Thisform.lexpanded = !Thisform.lexpanded
* update Caption for this command button
		This.Caption = Iif(Thisform.lexpanded,"Collapse","Expand") + " All Nodes"
	Endif
	Endproc

	Procedure shape1.Click
	Thisform.ycl=Iif(Thisform.ycl=.F.,.T.,.F.)
	With Thisform.grid1
		If .Parent.ycl=.T.
			.SetAll("DynamicBackColor","IIF(MOD(RECNO(), 2)=0, rgb(220,220,220)  , rgb(255,255,255))", "Column")
		Else
			.SetAll("DynamicBackColor","IIF(MOD(RECNO(), 2)=0, rgb(255,255,255)  , rgb(255,255,255))", "Column")
		Endi
		.Refresh
	Endwith
	Endproc

	Procedure check1.InteractiveChange
	With Thisform.oletreeview
		.CheckBoxes = Iif(.CheckBoxes=.F.,.T.,.F.)
	Endwith
	Endproc

	Procedure combo1.Init
	With This
		.AddItem("go top")
		.AddItem("go bottom")
		.AddItem("expand/collapse")
		.AddItem("search")
		.AddItem("change fontname/size")
		.AddItem("change font bold")
		.AddItem("change font Italic")
		.AddItem("change font underline")
		.AddItem("change nodes backcolor")
		.AddItem("change nodes forecolor")
		.AddItem("Checkboxes")
		.ListIndex=1
		.Style=2
		.Value=1
	Endwith
	Endproc

	Procedure combo1.Click
*this gives the real focus to the treeview by clicking on.i used mouse_event API
	#Define MOUSEEVENTF_LEFTDOWN     0x0002  &&The left button is down.
	#Define MOUSEEVENTF_LEFTUP       0x0004  &&The left button is up.
	x=Thisform.Left+Thisform.oletreeview.Left+Thisform.oletreeview.Width-40
	Y=Thisform.Top+Thisform.oletreeview.Top+40
	=SetCursorPos(x,Y)
	=Inkey(0.2)
	mouse_event(MOUSEEVENTF_LEFTDOWN +MOUSEEVENTF_LEFTUP,x,Y,0,0) && left mouse down+up


	Try
		treeview1=Thisform.oletreeview

		If Between(This.Value,1,4)
			treeview1.nodes(1).Selected=.T.
			Keyboard "{CTRL+A}"
		Endi

		Local oshell
		oshell=Newobject("wscript.shell")

		Do Case
		Case This.Value=1
			oshell.senDKeys("{HOME}")

		Case This.Value=2
			oshell.senDKeys("{END}")

		Case This.Value=3
			oshell.senDKeys("{HOME}{ENTER}")

		Case This.Value=4
i=0
for each node in treeview1.nodes
if   allt(lower(thisform.tsearch.value)) $ allt(lower(node.text) )  &&cab be =or ==
node.forecolor=255
i=i+1
else
node.forecolor=0
endi
next
messagebox( trans(i)+" found" ,0+32+4096,"",1300)

		Case This.Value=5
			Local m.x,m.xfontnam,m.xfontsize
			m.x=Getfont()
			If Empty(m.x)
				Return .F.
			Endi

			m.xfontname=Getwordnum(m.x,1,',')
			m.xfontsize=Int(Val(Getwordnum(m.x,2,',')))
			treeview1.Font.Name=m.xfontname
			treeview1.Font.Size=m.xfontsize


		Case This.Value=6
			treeview1.Font.bold=!treeview1.Font.bold

		Case This.Value=7
			treeview1.Font.italic=!treeview1.Font.italic

		Case This.Value=8
			treeview1.Font.underline=!treeview1.Font.underline


		Case This.Value=9
			Local m.cas
			m.cas =Inputbox("random color (1)-initial color(2)","","1")
			If m.cas=="1"
				With treeview1
					Rand(-1)
					For Each xnode In .nodes
						xnode.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
					Next
				Endwith
			Else
				With treeview1
					For Each xnode In .nodes
						xnode.BackColor=Rgb(255,255,255)
					Next
				Endwith
			Endi

		Case This.Value=10
			Local m.cas
			m.cas =Inputbox("random color (1)-initial color(2)","","1")
			If m.cas=="1"
				With treeview1
					For Each xnode In .nodes
						xnode.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
					Next
				Endwith
			Else
				With treeview1
					For Each xnode In .nodes
						xnode.ForeColor=0
					Next
				Endwith
			Endi

		Case This.Value=11
			treeview1.CheckBoxes=!treeview1.CheckBoxes

		Endcase

		DoEvent
		oshell=Null

	Catch
	Endtry
	Endproc

Enddefine
*
*-- EndDefine:ytree


Treeview MSComctlLib.TreeCtrl.2 used as explorer interface
Treeview MSComctlLib.TreeCtrl.2 used as explorer interface
Treeview MSComctlLib.TreeCtrl.2 used as explorer interface

Click on code to select [then copy] -click outside to deselect


*2* created on thursday 19 of april 2018
*the same treeview activex can be embed in internet explorer (browser or internetexplorer.application) as well.
*it is acompagned also ith the same imageList activeX to store icons(these are always sensitive names).
*IE must be emulated (here as Edge).
*can use the beforenavigate browser method to make actions user wants inside vfp namespace by redirection of any web url.

Public oform
oform=Newobject("yWebTree")
oform.Show
Read Events
Return

*
Define Class yWebTree As Form
	Height = 691
	Width = 779
	ShowWindow = 2
	DoCreate = .T.
	AutoCenter = .T.
	Caption = "IE11 web tree from vfp"
	Name = "form1"

	Add Object olecontrol1 As OleControl With ;
		oleclass="shell.explorer.2",;
		Top = 0, ;
		Left = 0, ;
		Height = 648, ;
		Width = 780, ;
		Anchor = 15, ;
		Name = "Olecontrol1"

	Add Object command1 As CommandButton With ;
		Top = 660, ;
		Left = 309, ;
		Height = 27, ;
		Width = 84, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Build tree", ;
		Name = "Command1"

	Add Object combo1 As ComboBox With ;
		Anchor = 320, ;
		Height = 24, ;
		Left = 512, ;
		Top = 660, ;
		Width = 172, ;
		Name = "Combo1"

	Add Object timer1 As Timer With ;
		Top = 672, ;
		Left = 12, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Interval = 2000, ;
		Name = "Timer1"

	Add Object command2 As CommandButton With ;
		Top = 658, ;
		Left = 418, ;
		Height = 27, ;
		Width = 84, ;
		Caption = "Command2", ;
		Style = 1, ;
		Name = "Command2"

	Add Object tsearch As TextBox With ;
		Height = 25, ;
		Left = 696, ;
		Top = 660, ;
		Width = 73, ;
		Name = "tSearch"

	Procedure filltree
	Parameters Path, m.nlevel, m.nCount
	Local DirArr,i,nTotDir,lvl,pkey
	m.path = Alltrim(Path)
	If Parameters()<2 Or Type("m.nlevel") #"N"
		lvl = 0
	Else
		lvl = m.nlevel
	Endif

	If Parameters()<2 Or Type("m.nCount") #"N"
		Cnt = 0
	Else
		Cnt = m.nCount
	Endif

	lvl = lvl + 1
	Cnt = Cnt + 1
	pkey = Lower(Substr(m.path,1,Rat("\",m.path,2)))+"_"

* Add items to treeview control
	o = Treeview1
	If Cnt = 1
		oNode = o.nodes.Add(,1,Lower(m.path)+"_",Lower(m.path),,)
		oNode.Image="openFold"
	Else
*	oNode = o.nodes.add(m.pkey,4,LOWER(m.path)+"_",LOWER(m.path),,)
		x=Lower(m.path)
		N=Getwordcount(m.x,"\")
		Y=Getwordnum(m.x,N,"\")
		oNode = o.nodes.Add(m.pkey,4,Lower(m.path)+"_",m.y,,)
		oNode.Image = "clsdFold"
	Endif

	Dimension DirArr[1,1]
	nTotDir=Adir(DirArr,m.path+"*.","D")
	Asort(DirArr)

	For i = 1 To m.nTotDir
		If DirArr[m.i,1] != '.' And Atc('D',DirArr[m.i,5])#0
			Thisform.filltree(m.path+DirArr[m.i,1]+'\', m.lvl, m.cnt)
		Endif
	Endfor

	Endproc


	Procedure ybuild
	Lparameters cDir
	Local m.myvar
	TEXT to m.myvar textmerge noshow
		<meta http-equiv="X-UA-Compatible" content="IE=edge">
		<body oncontextmenu="returnfalse;" bgcolor=bisque>

		<OBJECT id="IML" width="0" height="0" style="visibility: hidden" classid="clsid:2C247F23-8591-11D1-B16A-00C0F0283628" VIEWASTEXT>
		<PARAM NAME="_ExtentX" VALUE="1005">
		<PARAM NAME="_ExtentY" VALUE="1005">
		<PARAM NAME="BackColor" VALUE="8454143">
		<PARAM NAME="ImageWidth" VALUE="16">
		<PARAM NAME="ImageHeight" VALUE="16">
		<PARAM NAME="MaskColor" VALUE="12632256">
		<PARAM NAME="UseMaskColor" VALUE="-1">
		<PARAM NAME="_Version" VALUE="393216">
		</OBJECT>

		<P>
		<OBJECT id=TreeCtrl1 style="WIDTH: <<thisform.width-20>>px; HEIGHT: <<thisform.height-140>>px"
		classid=clsid:C74190B6-8589-11D1-B16A-00C0F0283628 VIEWASTEXT>
		<PARAM NAME="_ExtentX" VALUE="2646">
		<PARAM NAME="_ExtentY" VALUE="1323">
		<PARAM NAME="_Version" VALUE="393217">
		<PARAM NAME="HideSelection" VALUE="1">
		<PARAM NAME="Indentation" VALUE="1000">
		<PARAM NAME="LabelEdit" VALUE="0">
		<PARAM NAME="LineStyle" VALUE="0">
		<PARAM NAME="PathSeparator" VALUE="\">
		<PARAM NAME="Sorted" VALUE="0">
		<PARAM NAME="Style" VALUE="7">
		<PARAM NAME="Checkboxes" VALUE="0">
		<PARAM NAME="FullRowSelect" VALUE="0">
		<PARAM NAME="HotTracking" VALUE="0">
		<PARAM NAME="Scroll" VALUE="1">
		<PARAM NAME="SingleSel" VALUE="0">
		<PARAM NAME="ImageList" VALUE="">
		<PARAM NAME="BorderStyle" VALUE="0">
		<PARAM NAME="Appearance" VALUE="1">
		<PARAM NAME="MousePointer" VALUE="0">
		<PARAM NAME="Enabled" VALUE="1">
		<PARAM NAME="OLEDragMode" VALUE="0">
		<PARAM NAME="OLEDropMode" VALUE="0">
		</OBJECT>
		</P>
		<table><tr>

		<td><input type="button"  id="yb1" value="       "></td>
		<td> <textarea readonly rows="4" cols="70" style="font-size:11;color:maroon;">
		dblclick on first node (or click any node) to exapand/collapse.
		for treeview can set: fontname,fontsize,styles(fontbold,fontitalic,fontunderline...),treeview linestyle,checkbox,imagelist(icons)...
		for any node can set: forecolor,backcolor ,fontname,fontsize,style...
		can sort,edit text node,indent,make incremental search...
		</textarea></td>
		</tr></table>
		</body>
		<script>
	ENDTEXT
*
	Local apie
	apie=Thisform.olecontrol1
	With apie
		.silent=.T.
		.Navigate("about:blank")
		Inke(2)
		With .Document
			.Open()
			.Write(m.myvar)
			.Close()
		Endwith
	Endwith
	apie.Document.body.Scroll="no"
	apie.Document.Title="Playing with the treeview-activeX in html page-Yousfi Benameur"

&& populate
	Publi Treeview1
	Treeview1 =apie.Document.getElementbyID('TreeCtrl1')

*imagelist object init
	Publi oleImageList
	oleImageList=Thisform.olecontrol1.Document.getElementbyID("IML")
	With oleImageList
		.ImageHeight = 16
		.ImageWidth =  16
		.ListImages.Add(,"openFold",LoadPicture(Home(1)+"graphics\icons\win95\openfold.ico" ))
		.ListImages.Add(,"clsdFold",LoadPicture(Home(1)+"graphics\icons\win95\clsdfold.ico" ))
		.ListImages.Add(,"misc"    ,LoadPicture(Home(1)+"graphics\icons\misc\misc15.ico"    ))
	Endwith
	Treeview1.ImageList =oleImageList

	Treeview1.nodes.Clear

	=Thisform.filltree(cDir)
&&expand all nodes
	N=Treeview1.nodes.Count
	apie.Document.getElementbyID("yb1").Value=Trans(N)+" nodes"

	If N>0
		For i=1 To N
			Treeview1.nodes(i).expanded=.T.
		Endfor
		With   Treeview1
			.Font.Name="courier new"
			.Font.bold=.T.
			.Font.Size=11

			For i=1 To .nodes.Count
				.nodes(i).ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
				.nodes(i).BackColor=Rgb(255,255,217)
			Endfor
			.Refresh
		Endwith
	Endi
	Endproc

	Procedure Destroy
	Treeview1=Null
	Release Treeview1
	Clea Events
	Endproc

	Procedure Load
	Declare Integer SetCursorPos In WIN32API Integer, Integer
	Declare Integer mouse_event In WIN32API Integer,Integer,Integer,Integer,Integer
	_Screen.WindowState=1
	Endproc

	Procedure Init
	Thisform.timer1.Enabled=.T.
	Endproc

	Procedure command1.Click
	Local m.cDir
	Set Defa To Home(1)
	m.cDir = Getdir()
	If Empty(m.cDir)
		Return .F.
	Endif
	Thisform.ybuild(m.cDir)
	Endproc

	Procedure combo1.Click
*wait window "Select a node first" nowait
	Thisform.olecontrol1.SetFocus
	DoEvent
	Inke(.3)
*
	#Define MOUSEEVENTF_LEFTDOWN     0x0002  &&The left button is down.
	#Define MOUSEEVENTF_LEFTUP       0x0004  &&The left button is up.
	x=Thisform.Left+Thisform.olecontrol1.Left+Thisform.olecontrol1.Width-40
	Y=Thisform.Top+Thisform.olecontrol1.Top+120
	=SetCursorPos(x,Y)
	=Inkey(0.2)
	mouse_event(MOUSEEVENTF_LEFTDOWN +MOUSEEVENTF_LEFTUP,x,Y,0,0) && left mouse down+up

	Try
		Treeview1=Thisform.olecontrol1.Document.getElementbyID("TreeCtrl1")

		If Between(This.Value,1,4)
			Treeview1.nodes(1).Selected=.T.
			Keyboard "{CTRL+A}"
		Endi

		Local oshell
		oshell=Newobject("wscript.shell")

		Do Case
		Case This.Value=1
			oshell.senDKeys("{HOME}")

		Case This.Value=2
			oshell.senDKeys("{END}")

		Case This.Value=3
			oshell.senDKeys("{HOME}{ENTER}")

		Case This.Value=4
			i=0
			For Each Node In Treeview1.nodes
				If   Allt(Lower(Thisform.tsearch.Value)) $ Allt(Lower(Node.Text) )  &&cab be =or ==
					Node.ForeColor=255
					i=i+1
				Else
					Node.ForeColor=0
				Endi
			Next
			Messagebox( Trans(i)+" found" ,0+32+4096,"",1300)

		Case This.Value=5
			Thisform.command2.Click  &&problem focus

		Case This.Value=6
			Treeview1.Font.bold=!Treeview1.Font.bold

		Case This.Value=7
			Treeview1.Font.italic=!Treeview1.Font.italic

		Case This.Value=8
			Treeview1.Font.underline=!Treeview1.Font.underline

		Case This.Value=9
			Local m.cas
			m.cas =Inputbox("random color (1)-initial color(2)","","1")
			If m.cas=="1"
				With Treeview1
					Rand(-1)
					For Each xnode In .nodes
						xnode.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
					Next
				Endwith
			Else
				With Treeview1
					For Each xnode In .nodes
						xnode.BackColor=Rgb(255,255,255)
					Next
				Endwith
			Endi

		Case This.Value=10
			Local m.cas
			m.cas =Inputbox("random color (1)-initial color(2)","","1")
			If m.cas=="1"
				With Treeview1
					For Each xnode In .nodes
						xnode.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
					Next
				Endwith
			Else
				With Treeview1
					For Each xnode In .nodes
						xnode.ForeColor=0
					Next
				Endwith
			Endi
		Case This.Value=11
			Treeview1.checkBoxes=!Treeview1.checkBoxes
		Endcase

		DoEvent
		oshell=Null
	Catch
	Endtry
	Endproc

	Procedure combo1.Init
	With This
		.AddItem("go top")
		.AddItem("go bottom")
		.AddItem("expand/collapse")
		.AddItem("search ")
		.AddItem("change fontname/size")
		.AddItem("change font bold")
		.AddItem("change font Italic")
		.AddItem("change font underline")
		.AddItem("change nodes backcolor")
		.AddItem("change nodes forecolor")
		.AddItem("Checkboxes")
		.ListIndex=1
		.Style=2
		.Value=1
	Endwith
	Endproc

	Procedure timer1.Timer
	This.Enabled=.F.
	Local m.cDir

	m.cDir =Home(1)
	If Empty(m.cDir)
		Return .F.
	Endif
	Thisform.ybuild(m.cDir)
	Endproc

	Procedure command2.Init
	This.Left=-200  &&to avoid some gargabes
	Endproc

	Procedure command2.Click
	Local m.x,m.xfontnam,m.xfontsize
	m.x=Getfont()
	If Empty(m.x)
		Return .F.
	Endi
	m.xfontname=Getwordnum(m.x,1,',')
	m.xfontsize=Int(Val(Getwordnum(m.x,2,',')))
	Treeview1.Font.Name=m.xfontname
	Treeview1.Font.Size=m.xfontsize
	Endproc

Enddefine
*
*-- EndDefine: ywebTree


Treeview MSComctlLib.TreeCtrl.2 used as explorer interface
Treeview MSComctlLib.TreeCtrl.2 used as explorer interface
Treeview MSComctlLib.TreeCtrl.2 used as explorer interface
Treeview MSComctlLib.TreeCtrl.2 used as explorer interface

                     

Yousfi Benameur

Nouredine Mekelchi

Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation. Navigator: firefox - screen:32 pouces.

To be informed of the latest articles, subscribe:
Comment on this post