playing with MSComctlLib.TreeCtrl.2 Treeviews

Published on by Yousfi Benameur


Most of vfp developpers dont use the treeview olecontrol microsoft MSComctlLib.TreeCtrl.2 (SP6) shipped with vfp.
maybe its hard to set ... its also fast forgetting...
in this demo can set a treeview as a navigation bar (menu,sidebar,...and whatever).
the treeview is first populated with nodes,parents, childs...
to populate treeview icons must have an imageList olecontrol ,fill it with valid icons and refer them by index or name.
-each treeview item can be binded to fire a custom code (run a custom program).this is done in treeview.nodeclick event.
 each node can return the node object(text,index,...)
-the treeview can be expanded/collapsed as well
-can set nodes bold,italic,underline for global treeview
-can set the treeview forecolor  (i avoid backcolor because there is a bug and the treeview backcolor dont rendered as well)
-can set the treeview fontname+fontsize with the common dialog.
-can set checkBoxes for all nodes.
-can also edit each item (and modify its text).
all these controls are embed in one container as left side of a form (top level here).
can read this usefull MSDN article on treeview:https://msdn.microsoft.com/en-us/library/aa733703(v=vs.60).aspx

[Post 235]


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



*1* created on 27 of may 2017
*demonstrates how to use the treeview olecontrol as (menu,sidebar,navigation bar,..)
*demonstrates how to populate it with icons (imageList olecontrol) and how to use bindevent to trap events.
*updated with a shape button for random nodes forecolor (backcolor is not set because not beautiful)


Clea All

Declare Integer Sleep In kernel32 Integer

Public yForm
* Create a form with a treeview on it
yForm = Createobject( "TRForm" )
yForm.Show()
Read Events
Return


Define Class TrForm As Form
	Height=500
	Width=800
	ShowTips=.T.
	ShowWindow=2

	Add Object ybkg As Image With ;
		anchor=15,;
		left=0,;
		top=0,;
		width=800,;
		height=600,;
		stretch=2,;
		name="ybkg"

	Add Object yshp As Shape With ;
		Top=4+10,;
		Left=4+10,;
		Width=250 ,;
		Height=450,;
		ANCHOR=0,;
		backcolor=Rgb(145,145,145),;
		name="yshp"

	Add Object ycont As ycont0 With ;
		left=4,;
		top=4,;
		width=250+5,;
		height=450,;
		borderwidth=1,;
		backstyle=1,;
		name ="ycont"

	Procedure Init
	Local m.myvar
	TEXT to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAK4AAAAZCAYAAACowxUjAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAACWSURBVHhe7dnRCcJAFETR6b+xKKKgoqgf0UAIagmSt+O2MXA/zlRweSyszt+fgTTavcpAGsJFJO2nMpBGx7kMpNFlKQNpdHs3A2n0+DQDaXTvA6ThqYBIui7NQBqd5jKQRoepDKThyxeRtH2WgTTajGUgjYY+QJp+cddeMJCFcBGJcBGJcBGJcBGJcBFJQx8gDeEi0Oo/HkFbYWyH7UYAAAAASUVORK5CYII=
	ENDTEXT
	With Thisform.ybkg    && background image stretched t the form surface
		.Width=Thisform.Width
		.Height=Thisform.Height
		.PictureVal=Strconv(m.myvar,14)
		.ZOrder(1)

		With This.yshp
			.Left=.Parent.ycont.Left+10
			.Top =.Parent.ycont.Top+5
		Endwith

	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc
Enddefine
*EndDefine TrForm
*

Define Class ycont0 As Container
	BackStyle=1
	BorderWidth=0
	Top=4
	Left=4
	Width=250
	Height=450
	Name="ycont"
	lexpanded=.F.

	Add Object ytree As OleControl With ;
		oleclass="MSComctlLib.TreeCtrl.2" ,;
		style=7,;
		scroll=.T.,;
		CheckBoxes=.F. , ;
		height = 320,;
		width = 250,;
		left=2,;
		width=248,;
		ANCHOR=0,;
		name="ytree"


	Add Object oleimageslist As OleControl With ;
		oleclass="MSComctlLib.ImageListCtrl.2",;
		Top = 0, ;
		Left = 372, ;
		Height = 100, ;
		Width = 100, ;
		Name = "oleImagesList"

	Add Object yforec As CommandButton With ;
		caption="Forecolor",;
		width= 60,;
		height=25,;
		backcolor=Rgb(0,255,0),;
		mousepointer=15,;
		left=10,;
		top=400-35,;
		anchor=0,;
		name="yforec"



	Add Object yfont As CommandButton With ;
		caption="Font",;
		width= 60,;
		height=25,;
		backcolor=Rgb(0,255,0),;
		mousepointer=15,;
		left=10,;
		top=400-5,;
		anchor=0,;
		name="yfont"

	Add Object yforecR As Shape With ;
		width= 10,;
		height=10,;
		backcolor=Rgb(255,0,0),;
		mousepointer=15,;
		left=10,;
		top=427,;
		anchor=0,;
		tooltiptext="random forecolor",;
		curvature=99,;
		name="yforecR"

	Add Object ybold As Checkbox With ;
		caption="B",;
		fontbold=.T.,;
		autosize=.T.,;
		backstyle=0,;
		mousepointer=15,;
		left=87,;
		top=400-30,;
		anchor=0,;
		name="ybold"

	Add Object yital As Checkbox With ;
		caption="I ",;
		fontbold=.T.,;
		autosize=.T.,;
		backstyle=0,;
		mousepointer=15,;
		left=87+30,;
		top=400-30,;
		anchor=0,;
		name="yItal"

	Add Object yunderl As Checkbox With ;
		caption="U ",;
		fontbold=.T.,;
		autosize=.T.,;
		backstyle=0,;
		mousepointer=15,;
		left=87+30+30,;
		top=400-30,;
		anchor=0,;
		name="yunderL"

	Add Object ycheckb As Checkbox With ;
		caption="Ch ",;
		fontbold=.T.,;
		autosize=.T.,;
		backstyle=0,;
		mousepointer=15,;
		left=87+30+30+30,;
		top=400-30,;
		anchor=0,;
		name="ycheckB"

	Add Object yce As CommandButton With ;
		Top = 330, ;
		Left = 10, ;
		Height = 25, ;
		Width = 110, ;
		Anchor = 0, ;
		backcolor=255,;
		mousepointer=15,;
		Caption = "Expand All Nodes", ;
		Name = "yce"

	Procedure yforecR.Click
	*can make each node with a custom color as forecolor or backcolor
	*this is the relative code to apply (here its a random color)
	If This.Parent.ytree.Nodes.Count > 0
		i=0
		For Each loNode In This.Parent.ytree.Nodes
			i=i+1
			This.Parent.ytree.Nodes(i).ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
			*This.Parent.ytree.Nodes(i).BackColor=rgb(255*rand(),255*rand(),255*rand())   &&
		Endfor
		This.Parent.ytree.Refresh
	Endif
	Endproc


	Add Object ycheckedt As Checkbox With ;
		caption="label edit ",;
		fontbold=.T.,;
		autosize=.T.,;
		backstyle=0,;
		mousepointer=15,;
		left=125,;
		top=330,;
		anchor=0,;
		value=0,;
		name="ycheckedt"

	Procedure yfont.Click
	Local m.xfont
	m.xfont=Getfont()
	If Empty(m.xfont)
		Return .F.
	Endi
	Local m.xfontname,m.xfontsize
	m.xfontname=Getwordnum(m.xfont,1,",")
	m.xfontsize=Getwordnum(m.xfont,2,',')
	With  This.Parent.ytree
		.Font.Name=m.xfontname
		.Font.Size=Int(Val(m.xfontsize))
	Endwith
	Endproc

	Procedure ycheckedt.InteractiveChange
	Nodefault
	With    This.Parent.ytree     &&.Object
		.labelEdit=Iif(.labelEdit=1,0,1)
	Endwith
	Endproc

	Procedure ycheckb.InteractiveChange
	This.Parent.ytree.Object.CheckBoxes=!This.Parent.ytree.Object.CheckBoxes
	Endproc

	Procedure ybold.InteractiveChange
	This.Parent.ytree.Font.bold=!This.Parent.ytree.Font.bold
	Endproc

	Procedure yital.InteractiveChange
	This.Parent.ytree.Font.italic=!This.Parent.ytree.Font.italic
	Endproc

	Procedure yunderl.InteractiveChange
	This.Parent.ytree.Font.Underline=!This.Parent.ytree.Font.Underline
	Endproc

	Procedure oleimageslist.Init
	Local m.yfolderIcons
	m.yfolderIcons=Home(1)+"graphics\icons\win95\"
	With This
		.ImageHeight = 16
		.ImageWidth =  16
		gnbre=Adir(gabase,m.yfolderIcons+"*.ico")
		xx=""
		For i=1 To gnbre
			.ListImages.Add(,"openfolder"+Trans(i),LoadPicture(m.yfolderIcons+gabase(i,1)) ) &&populate the imagelist object with desired icons
			Sleep(10)
		Endfor
	Endwith
	Sleep(100)
	Endproc

	Procedure Init
	* Check to see if OCX installed and loaded.
	If Type("THIS.ytree") # "O" Or Isnull(This.ytree)
		Return .F.
	Endif
	* Check to see if OCX installed and loaded.
	If Type("THIS.oleImagesList") # "O" Or Isnull(This.oleimageslist)
		Return .F.
	Endif
	This.ytree.ImageList = This.oleimageslist


	With This.ytree
		*populate treeview with custom nodes
		.Nodes.Add( , , "P1", "Hello" ,1)
		* Add a child, under the Root (4)
		loNode = .Nodes.Item["P1"]
		.Nodes.Add( loNode, 4, "P2", "World",2 )
		* Make the A2 node visible
		.Nodes.Item["P2"].EnsureVisible()
		* Add 20 more nodes under A2
		loNode = .Nodes.Item["P2"]
		For lnI = 1 To 10
			lcKey = "B" + Transform(lnI)
			.Nodes.Add( loNode, 4, lcKey, "Country " + Transform(lnI),lnI+2 )
		Endfor

		*Add the bb2 child under B1
		loNode = .Nodes.Item["B1"]
		lcKey = "BB1"
		.Nodes.Add( loNode, 4, lcKey, "DEPARTMENT1 " ,10)

		.Nodes.Add( , , "X1", "FOXPRO" ,8)
		* Add a child, under the Root (4)
		loNode = .Nodes.Item["X1"]
		.Nodes.Add( loNode, 4, "X2", "ROCK",11 )
		* Make the A2 node visible
		.Nodes.Item["X2"].EnsureVisible()
		* Add 20 more nodes under A2
		loNode = .Nodes.Item["X2"]
		For lnI = 1 To 5
			lcKey = "C" + Transform(lnI)
			.Nodes.Add( loNode, 4, lcKey, "LOVER " + Transform(lnI),lnI )
		Endfor

		* Expand the A2 subtree (scrools the A1 off the top)
		.Nodes.Item["P2"].Expanded = .T.
		.Nodes.Item["X2"].Expanded = .T.

		* Make the A1 node visible again
		loNode =.Nodes.Item["P1"].EnsureVisible()
		*messagebox(yform.ytree.nodes.count)
		.hotTracking=.T.
		.singleSel=.T.  &&default
		.Indentation = 20
		.labelEdit = 1  		&& no edit
		.lineStyle=1
		.Style=7
		.Scroll = .T.
	Endwith

	Bindevent(This.ytree,"NodeClick",This,"my")  &&this makes programmatic actions possible from the treeview
	Endproc

	Procedure my
	Lparameters Node

	This.yactions(Node)      &&,No de.Index)
	Endproc

	Procedure yactions
	Lparameters  xnode
	m.xindex=xnode.Index

	If m.xindex=1
		Return .F.
	Endi

	DoDefault()
	Messagebox(xnode.Text+"  index="+Trans(m.xindex)+"  key= "+xnode.Key+"  clicked !",0+32+4096,'',1300)
	Do Case
	Case m.xindex=2
		Run/N notepad

	Case m.xindex=3
		Modify File ? Nowait  &&		*!*	open file

	Case m.xindex=4
		Activate Window calculator In  Window (Thisform.Name  )
	Case m.xindex=5
		Activate Window calendar In  Window (Thisform.Name  )
		*case m.xindex=6
		*case m.xindex=7
		*case m.xindex=8
		**********
		*case xindex=this.ytree.nodes.count
	Otherwise
		Messagebox(xnode.Text+"  index="+Trans(m.xindex)+"  key= "+xnode.Key+"  clicked ! Can run any code from method yactions!",0+32+4096,'',1200)

	Endcase
	Endproc

	Procedure yforec.Click
	xcolor=Getcolor()
	If Empty(xcolor) And m.xcolor#-1
		Return .F.
	Endi

	If This.Parent.ytree.Nodes.Count > 0
		i=0
		For Each loNode In This.Parent.ytree.Nodes
			i=i+1
			This.Parent.ytree.Nodes(i).ForeColor=m.xcolor
		Endfor
		This.Parent.ytree.Refresh
	Endif
	Endproc

	Procedure yce.Init
	With This
		.FontBold = .T.
		.Caption = "Expand All Nodes"
		.ToolTipText = "Expands all nodes (Expanded property set to .T.)"
		.Name = "cmdExpandCollapse"
	Endwith
	Endproc

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

Enddefine
*EndDefine Ycont0



treeview Add method with its parameters explained in image (from https://www.levelextreme.com/ShowHeaderArticleOneItem.aspx?ID=39020).click to zoom+

treeview Add method with its parameters explained in image (from https://www.levelextreme.com/ShowHeaderArticleOneItem.aspx?ID=39020).click to zoom+

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

 
*can make each node with a custom color as forecolor or backcolor
*this is the relative code to apply (here its a random color)

If This.Parent.ytree.Nodes.Count > 0
i=0
For Each loNode In This.Parent.ytree.Nodes
i=i+1
This.Parent.ytree.Nodes(i).ForeColor=rgb(255*rand(),255*rand(),255*rand())
 This.Parent.ytree.Nodes(i).BackColor=rgb(255*rand(),255*rand(),255*rand())
Endfor
This.Parent.ytree.Refresh
Endif


note: Modern web CSS3 treeview are very simple to set.it recquires only tag style and no refer to any library. vfp can work as well with them with trapping the url in beforeNevigate method.i used this trick many  times , as can see in previous posts.
note: Modern web CSS3 treeview are very simple to set.it recquires only tag style and no refer to any library. vfp can work as well with them with trapping the url in beforeNevigate method.i used this trick many  times , as can see in previous posts.
note: Modern web CSS3 treeview are very simple to set.it recquires only tag style and no refer to any library. vfp can work as well with them with trapping the url in beforeNevigate method.i used this trick many  times , as can see in previous posts.
note: Modern web CSS3 treeview are very simple to set.it recquires only tag style and no refer to any library. vfp can work as well with them with trapping the url in beforeNevigate method.i used this trick many  times , as can see in previous posts.

note: Modern web CSS3 treeview are very simple to set.it recquires only tag style and no refer to any library. vfp can work as well with them with trapping the url in beforeNevigate method.i used this trick many times , as can see in previous posts.

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


*2* created on 28 of may 2017
*this code returns PEM of the treeview (oleClass MSCOMctlLIB.TreeCTRL.2) in a cursor.

local m.o
m.o = CREATEOBJECT("MSComctlLib.TreeCtrl.2")
m.n= AMEMBERS(gaPropArray, o, 3)
Create Cursor ycurs ( col1 c(50),col2 c(8),col3 c(30),col4 M)
		For i=1 To m.n
			Insert Into ycurs Values (gaPropArray(i,1),gaPropArray(i,2),gaPropArray(i,3),gaPropArray(i,4))
		Endfor
    o=null
sele ycurs

Browse  Name ybrow   Title "Treevie PEM: "+Trans(Reccount())  Nowait    &&window as oop object
With ybrow
    .DeleteMark=.F.
    .GridLines=0
    .RecordMark=.F.
    .Width=740
    .Left=100
    .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255)  , RGB(190,235,200))", "Column")
    .FontBold=.T.
Endwith
locate

*can run the object browser( vfp menu/tools/browser object) and embed the MSCOMCTLLib library
*can see all PEM here for treeview (1,2,3 version)
*can drag the constants into vfp command window or a txt file (rename it mscomCtlLib.h for future use).see all properties/methods/events.
*Note : all these PEM are in the vfp PEM Sheet (rightclick on treeview)
* there is also a treeview builder (rightclick and select builder) where can set many properties.


playing with MSComctlLib.TreeCtrl.2 Treeviews
playing with MSComctlLib.TreeCtrl.2 Treeviews

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

*3* created on 28 of may 2017 
*!*	The Treeview Control Is Used To Display an Explorer-Like interface.  Is commanded By a contextuel Menu.
*!*Select New Child To Add a Child Item To The Selected Node.
*!*can Select Save Dbf To Save The nodes.To a Dbf File Or Restore Data stored In a Valid Dbf(respectfully With its Std Structure).
*!*can expand/collapse The Treeview nodes.
*!*This interface can Build a Custom Treeview And stores it In a Dbf.Then can At Any Time,Restore The Treeview From The stored Dbf.
*!*its usefull And simplifies operations.
*!*code adapted from vfp solutions/ole.

clea all

Publi oform
oform=Newobject("ytreeview")
oform.Show
Read Events
Retu
*
Define Class ytreeview As Form
	DataSession = 2
	Top = 3
	Left = 6
	Height = 329
	Width = 563
	ShowWindow = 2
	AutoCenter=.T.
	Caption = "Treeview builder"
	cnextkey = "1_"
	cdbfname = Chr(13) + Chr(13) + [Name = "Form1"]
	lexpanded = .F.
	Scroll=.T.
	Name = "Form"
	*-- Set to .F. if a dbf couldn't be opened
	openedsuccessfully = .F.


	Add Object cboparent As ComboBox With ;
		FontBold = .F., ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Anchor = 768, ;
		RowSource = "", ;
		Value = 0, ;
		ControlSource = "", ;
		Height = 23, ;
		Left = 88, ;
		Style = 2, ;
		TabIndex = 10, ;
		Top = 301, ;
		Width = 242, ;
		Name = "cboParent"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .F., ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "Select n\<ode:", ;
		Height = 15, ;
		Left = 22, ;
		Top = 305, ;
		Width = 62, ;
		TabIndex = 9, ;
		Name = "Label1"

	Add Object oletreeview As OleControl With ;
		oleclass="MSComctlLib.TreeCtrl.2",;
		Top = 12, ;
		Left = 12, ;
		Height = 242, ;
		Width = 540, ;
		TabIndex = 1, ;
		Anchor = 15, ;
		Name = "oleTreeView"

	Add Object yhelp As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontName = "Arial", ;
		FontSize = 14, ;
		Anchor = 768, ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "?", ;
		Height = 25, ;
		Left = 497, ;
		MousePointer = 15, ;
		Top = 297, ;
		Width = 14, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "yhelp"

	Add Object command2 As CommandButton With ;
		Top = 298, ;
		Left = 338, ;
		Height = 25, ;
		Width = 144, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Menu", ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command2"

	*-- Returns a new key for the new node.
	Procedure newkey
	cKey = This.cnextkey
	This.cnextkey = Alltrim(Str(Val(This.cnextkey) + 1) + "_")
	Return cKey
	Endproc

	Procedure refreshcombo
	This.cboparent.Clear
	For i = 1 To This.oletreeview.Nodes.Count
		This.cboparent.AddListItem(This.oletreeview.Nodes.Item(i).Fullpath, i, 1)
	Endfor
	Endproc

	*-- checks to make sure the table has the necessary fields for storing or restoring an outline.
	Procedure verifytablestructure
	Local laFields[1,11], lnPos, laNeeded[3], lnCnt

	#Define FIELD1_LOC "KEY"
	#Define FIELD2_LOC "PARENT"
	#Define FIELD3_LOC "TEXT"

	* Make sure the table contains the right fields.
	*-----------------------------------------------
	laNeeded[1] = FIELD1_LOC
	laNeeded[2] = FIELD2_LOC
	laNeeded[3] = FIELD3_LOC

	=Afields(laFields,Alias())

	For lnCnt = 1 To Alen(laNeeded)
		lnPos = Ascan(laFields, laNeeded[lnCnt])
		If lnPos = 0 Or laFields[lnPos+ 1] != 'C'
			#Define TITLE_LOC "Invalid Table Structure"
			#Define MSG_LOC "The table must contain 3 character fields:" + Chr(13) + ;
				CHR(13) + FIELD1_LOC + ;
				CHR(13) + FIELD2_LOC + ;
				CHR(13) + FIELD3_LOC
			=Messagebox(MSG_LOC,48+0+0,TITLE_LOC)
			Return .F.
		Endif
	Endfor

	Return .T.
	Endproc

	Procedure opendbf
	Lparameters lcDBFName, llExclusive
	* assume success.  If there is an error, THISFORM.OpenedSuccessfully
	* will be set to .F. in the Error event
	Thisform.openedsuccessfully = .T.

	#Define ERR_LOC "Error"
	If !File(lcDBFName)
		#Define ERR1_LOC "Cannot find the specified file."
		=Messagebox(ERR1_LOC,48+0+0,ERR_LOC)
		Return .F.
	Endif

	lcAlias = Substr(lcDBFName, Rat("\",lcDBFName) + 1)
	lcAlias = Substr(lcAlias, 1, At(".", lcAlias) - 1)

	If llExclusive
		Use (lcDBFName) In 0 Exclusive
	Endif

	If !Used(lcAlias)
		Use (lcDBFName) In 0 Shared
	Endif
	Select (lcAlias)
	Return Thisform.openedsuccessfully
	Endproc

	Procedure newroot
	#Define TXT_LOC "Click to edit text"
	o = Thisform.oletreeview
	x=o.Nodes.Add(,1,Thisform.newkey(),TXT_LOC,0)
	x.EnsureVisible()
	Endproc

	Procedure newchild
	#Define TXT_LOC "Click to edit text"
	o = Thisform.oletreeview
	Try
		If !Isnull(o.SelectedItem) Then
			x=o.Nodes.Add(o.SelectedItem.Key, 4, Thisform.newkey(), TXT_LOC,0)
			x.EnsureVisible()
		Endif
	Catch
	Endtry

	Endproc

	*-- Supprimer l'événement.
	Procedure Delete
	Try
		o = Thisform.oletreeview
		If !Isnull(o.SelectedItem)
			o.Nodes.Remove(o.SelectedItem.Key)
		Endif

	Catch
	Endtry
	Endproc

	*-- Efface le contenu d'un contrôle ComboBox ou ListBox.
	Procedure Clear
	Thisform.oletreeview.Nodes.Clear
	Endproc


	Procedure saveAsdbf
	Local loNodes, lcParent, lcDBFName, lcOldAlias, lcOldSafety
	#Define WARNING_LOC "Continuing will destroy all data in the table and create a new table with three fields." + Chr(13) + "Do you want to continue?"
	#Define WARN_LOC "Warning"
	lcOldAlias = Alias()
	lcOldSafety = Set("SAFETY")
	lcDBFName = Getfile('dbf')

	If Empty(lcDBFName) && User chose Cancel
		Return
	Endif

	If File(lcDBFName)
		If Thisform.opendbf(lcDBFName, .T.) And ;
				THISFORM.verifytablestructure() And ;
				MESSAGEBOX(WARNING_LOC,48+256+4,WARN_LOC) = 6
			Set Safety Off
			Zap
			Set Safety &lcOldSafety
		Else
			Return
		Endif
	Else
		Create Table (lcDBFName) ;
			(Key c(4), ;
			Parent c(4), ;
			Text c(60))
	Endif

	loNodes = Thisform.oletreeview.Nodes

	For i = 1 To loNodes.Count
		If Isnull(loNodes.Item(i).Parent)
			lcParent = "0_" && Root
		Else
			lcParent = loNodes.Item(i).Parent.Key
		Endif
		Insert Into (lcDBFName) Values ;
			(loNodes.Item(i).Key, ;
			lcParent, ;
			loNodes.Item(i).Text)
	Endfor
	Use
	If !Empty(lcOldAlias)
		Select (lcOldAlias)
	Endif
	Endproc

	Procedure loaddbf
	Local lcOldAlias, laFields

	lcOldAlias = Alias()
	lcDBFName = Getfile('dbf')
	If Empty(m.lcDBFName)
		Return
	Endif
	If Thisform.opendbf(lcDBFName)
		If !Thisform.verifytablestructure()
			Return
		Endif

		* Fill the TreeView control with values in the table.
		*----------------------------------------------------
		o = Thisform.oletreeview.Nodes
		o.Clear

		Scan
			If Alltrim(Parent) = '0_'
				o.Add(,1,Alltrim(Key),Alltrim(Text),0)
			Else
				o.Add(Alltrim(Parent),4,Alltrim(Key), Alltrim(Text),0)

			Endif
			Thisform.cnextkey = Alltrim(Str(Val(Key) + 1) + "_")

		Endscan
		Use
		If !Empty(lcOldAlias)
			Select (lcOldAlias)
		Endif
	Endif

	Thisform.yexpCol()
	Endproc

	Procedure yexpCol
	With Thisform.oletreeview
		If .Nodes.Count > 0
			* only do this if we have nodes in the treeview
			For Each loNode In .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
		Endif
	Endwith
	Endproc

	Procedure Error
	Lparameters nError, cMethod, nLine
	#Define ERRMSG_LOC "Error"
	#Define ERR3_LOC "The table is in use and could not be opened exclusively."
	Do Case
	Case nError = 1426
		*!* Ignore error 1426
	Case nError = 3  && File in use
		Messagebox (ERR3_LOC, 0, ERRMSG_LOC)
		Thisform.openedsuccessfully = .F.
	Otherwise
		Messagebox (Alltrim(Str(nError)) + Space(5) + Message(), 0, ERRMSG_LOC)
		Thisform.openedsuccessfully = .F.
	Endcase
	Endproc

	Procedure Init
	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
	This.yhelp.FontSize=24

	* Fill the TreeView control with values in the table.
	*----------------------------------------------------
	o = Thisform.oletreeview.Nodes
	o.Clear
	Sele ycurs
	Scan
		If Alltrim(Parent) = '0_'
			o.Add(,1,Alltrim(Key),Alltrim(Text),0)
		Else
			o.Add(Alltrim(Parent),4,Alltrim(Key), Alltrim(Text),0)

		Endif
		Thisform.cnextkey = Alltrim(Str(Val(Key) + 1) + "_")
	Endscan

	*IF !EMPTY(lcOldAlias)
	*	SELECT (lcOldAlias)
	*ENDIF
	*ENDIF

	Thisform.yexpCol()


	Endproc

	Procedure Load
	Close Data All
	Local m.myvar
	TEXT to m.myvar noshow
1_, 0_,  Click to edit text
2_ , 0_,  Click to edit text
3_ , 0_,  Click to edit text
4_ , 0_ , Click to edit text
5_ , 0_,  Click to edit text
6_ , 1_ , Click to edit text
7_ , 1_,  Click to edit text
8_ , 1_,  Click to edit text
9_ , 1_ , Click to edit text
10_, 6_,  Click to edit text
11_, 6_ , Click to edit text
12_, 11_, Click to edit text
	ENDTEXT
	Crea Cursor ycurs (Key c(4),Parent c(4), Text c(60))
	For i=1 To Memlines(m.myvar)
		u=Mline(m.myvar,i)
		u1=Getwordnum(u,1,",")
		u2=Getwordnum(u,2,",")
		u3=Getwordnum(u,3,",")
		Insert Into ycurs Values ( u1,u2,u3)
	Endfor
	Sele ycurs
	*brow

	Endproc

	Procedure Destroy
	Clea Events
	Endproc

	Procedure cboparent.GotFocus
	Thisform.refreshcombo
	Endproc

	Procedure cboparent.InteractiveChange
	Thisform.oletreeview.Nodes(This.Value).Selected = .T.
	Endproc

	Procedure oletreeview.AfterLabelEdit
	*** OLE Control Event ***
	Lparameters Cancel, newstring
	If !Isnull(newstring)
		This.SelectedItem.Text = newstring
		Thisform.refreshcombo
		Thisform.cboparent.Value = This.SelectedItem.Index
	Endif
	Endproc

	Procedure oletreeview.NodeClick
	*** OLE Control Event ***
	Lparameters Node
	Thisform.refreshcombo
	Thisform.cboparent.Value = Node.Index
	Endproc

	Procedure oletreeview.GotFocus
	On Key Label F1 Help Id _Screen.ActiveForm.HelpContextID
	Endproc

	Procedure oletreeview.LostFocus
	On Key Label F1
	Endproc

	Procedure yhelp.Click
	Local m.myvar
	TEXT to m.myvar pretext 7  noshow
		The Treeview control is used to display an Explorer-like interface.  Is commanded by a contextuel menu.
		Select New Child to add a child item to the selected node.
		can select Save DBF to save the nodes.to a DBF file or restore data stored in a valid dbf(respectfully with its std structure).
		can expand/collapse the treeview nodes.
		this interface can build a custom treeview and stores it in a dbf.then can at any time,restore the treeview from the stored dbf.
		its usefull and simplifies operations.
	ENDTEXT
	Messagebox(m.myvar,0+32+4096)
	Endproc

	Procedure command2.Click
	Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
	Define Bar 1 Of raccourci Prompt "New Root"
	Define Bar 2 Of raccourci Prompt "New Child"
	Define Bar 3 Of raccourci Prompt "Delete node"
	Define Bar 4 Of raccourci Prompt "clear Treeview"
	Define Bar 5 Of raccourci Prompt "Save DBF"
	Define Bar 6 Of raccourci Prompt "Load DBF"
	Define Bar 7 Of raccourci Prompt "Expand/Collapse"
	On Selection Bar 1 Of raccourci _Screen.ActiveForm.newroot()
	On Selection Bar 2 Of raccourci _Screen.ActiveForm.newchild()
	On Selection Bar 3 Of raccourci _Screen.ActiveForm.Delete()
	On Selection Bar 4 Of raccourci _Screen.ActiveForm.Clear()
	On Selection Bar 5 Of raccourci _Screen.ActiveForm.saveasDBF()
	On Selection Bar 6 Of raccourci _Screen.ActiveForm.loaddbf()
	On Selection Bar 7 Of raccourci _Screen.ActiveForm.yexpCol()
	Activate Popup raccourci
	Endproc

Enddefine
*
*-- EndDefine: ytreeview



the treeview builder and saved as dbf and restored nextly from this dbf is very usefull to build applications.

the treeview builder and saved as dbf and restored nextly from this dbf is very usefull to build applications.

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


*4*this code builds a treeview as explorer interface from any folder
*!* it uses the standard filltree method to populate the treeview with recursive folders.
*!*	any treeview item clicked fires some node informations and change node icons
*!*	can search in the golbal treeview for strings with navigation on searched colored strings found (red)  (next,previous,.)
*!* search tool in treeview not mine...Adapted (i ignore the author.all credits for him).


Clea All

Publi yform
yform=Newobject("ytreeview")
yform.Show
Read Events
Retu
*
Define Class ytreeview As Form
	DataSession = 2
	BorderStyle = 0
	Height = 488
	Width = 546
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Recurse folder to treeview"
	MaxButton = .F.
	lexpanded = .F.
	Name = "form1"

	Add Object shape1 As Shape With ;
		Top = 393, ;
		Left = 12, ;
		Height = 87, ;
		Width = 385, ;
		BorderWidth = 1, ;
		Curvature = 15, ;
		BorderColor = Rgb(255,255,255), ;
		Name = "Shape1"

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

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

	Add Object oletreeview As OleControl With ;
		oleclass="MSComctlLib.TreeCtrl.2" ,;
		Top = 0, ;
		Left = 12, ;
		Height = 312, ;
		Width = 528, ;
		Name = "oleTreeview"

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

	Add Object command1 As CommandButton With ;
		Top = 324, ;
		Left = 432, ;
		Height = 25, ;
		Width = 97, ;
		Caption = "Expand", ;
		Name = "Command1"

	Add Object txtsearch As TextBox With ;
		Height = 23, ;
		Left = 70, ;
		SelectOnEntry = .T., ;
		Top = 401, ;
		Width = 144, ;
		Name = "txtsearch"

	Add Object cmdsearch As CommandButton With ;
		Top = 399, ;
		Left = 216, ;
		Height = 27, ;
		Width = 55, ;
		FontBold = .T., ;
		FontSize = 8, ;
		Caption = "Sear\<ch", ;
		Visible = .T., ;
		Name = "cmdsearch"

	Add Object cmdnext As CommandButton With ;
		Top = 399, ;
		Left = 273, ;
		Height = 26, ;
		Width = 55, ;
		FontBold = .T., ;
		FontSize = 8, ;
		Caption = "\<Next", ;
		Enabled = .F., ;
		Visible = .T., ;
		Name = "cmdnext"

	Add Object cmdback As CommandButton With ;
		Top = 399, ;
		Left = 330, ;
		Height = 26, ;
		Width = 59, ;
		FontBold = .T., ;
		FontSize = 8, ;
		Caption = "\<Previous", ;
		Enabled = .F., ;
		Visible = .T., ;
		Name = "cmdback"

	Add Object label1 As Label With ;
		AutoSize = .F., ;
		FontBold = .T., ;
		FontSize = 8, ;
		BackStyle = 0, ;
		Caption = "Search", ;
		Height = 17, ;
		Left = 28, ;
		Top = 405, ;
		Width = 41, ;
		Name = "Label1"

	Add Object optsrch As OptionGroup With ;
		ButtonCount = 2, ;
		BackStyle = 0, ;
		Value = 1, ;
		Height = 46, ;
		Left = 28, ;
		Top = 426, ;
		Width = 135, ;
		Name = "optSrch", ;
		Option1.FontBold = .T., ;
		Option1.FontSize = 8, ;
		Option1.BackStyle = 0, ;
		Option1.Caption = "Search match case", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Top = 5, ;
		Option1.Width = 139, ;
		Option1.Name = "Option1", ;
		Option2.FontBold = .T., ;
		Option2.FontSize = 8, ;
		Option2.BackStyle = 0, ;
		Option2.Caption = "Search exact match", ;
		Option2.Height = 17, ;
		Option2.Left = 5, ;
		Option2.Top = 24, ;
		Option2.Width = 139, ;
		Option2.Name = "Option2"

	Add Object chkall As Checkbox With ;
		Top = 431, ;
		Left = 171, ;
		Height = 17, ;
		Width = 77, ;
		FontBold = .T., ;
		FontSize = 8, ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "Search all", ;
		value=1,;
		Name = "chkAll"

	Procedure filltree
	Parameters m.path, m.nlevel, m.nCount
	Local DirArr,i,nTotDir,lvl,pkey
	m.path=Allt(m.path)
	m.path1 = Substr(m.path,1,Len(m.path)-1)
	N=Getwordcount(m.path,"\")
	m.path2=Getwordnum(m.path,N,"\")

	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.path1),,)
		oNode.Image = "pc"

	Else
		oNode = o.nodes.Add(m.pkey,4,Lower(m.path)+"_",Lower(m.path2),,)
		oNode.Image="fc"
	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 Destroy
	Clea Events
	Endproc

	Procedure Init
	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
	Endproc

	Procedure oleimageslist.Init
	Local m.yfolderIcons
	m.yfolderIcons=Home(1)+"graphics\icons\win95\"
	With This
		.ImageHeight = 16
		.ImageWidth =  16
		gnbre=Adir(gabase,m.yfolderIcons+"*.ico")
		xx=""

		.ListImages.Add(,"pc",LoadPicture(m.yfolderIcons+"driveNet.ico" ) ) &&populate the imagelist object with desired icons
		.ListImages.Add(,"fc",LoadPicture(m.yfolderIcons+"clsdfold.ico" ) ) &&populate the imagelist object with desired icons
		.ListImages.Add(,"fo",LoadPicture(m.yfolderIcons+"openFold.ico" ) ) &&populate the imagelist object with desired icons
	Endwith

	Endproc

	Procedure cmdgetdir.Click
	Local cDir

	cDir = Getdir()
	If Empty(m.cDir)
		Return
	Endif

	With Thisform
		.text1.Value = m.cDir
		.oletreeview.nodes.Clear
		.filltree(m.cDir)
		.command1.Click()
	Endwith
	Endproc

	Procedure oletreeview.NodeClick
	*** Événement de contrôle ActiveX  ***
	Lparameters Node
	For Each loNode In This.nodes
		If loNode.Index>1
			If loNode.Image="fo"
				loNode.Image="fc"
			Endi
		Endi
	Endfor

	If Node.Index>1
		Node.Image=Iif(Node.Image="fc","fo","fc")


		TEXT to m.myvar textmerge noshow
		node.bold=<<node.bold>>
		node.checked=<< Node.Checked>>
		node expanded=<<Node.Expanded>>
		node.selected=<<Node.Selected>>
		Node.sorted=<<Node.Sorted>>
		Node.text=<< Node.text>>

		Node.parent.text = <<IIF(ISNULL(node.parent),"No Parent" ,Node.Parent.text)>>
		Node.Child.text =<< IIF(ISNULL(Node.Child),"No Child" ,Node.Child.text)>>
		Node.Next.Text =<<  IIF(ISNULL(Node.Next),"No Next Node" ,Node.Next.text)>>
		Node.Previous.Text=<< IIF(ISNULL(Node.Previous),"No Previous Node" ,Node.Previous.text)>>
		Node.FirstSibling.Value =<< Node.FirstSibling.text>>
		Node.LastSibling.Text=<< Node.LastSibling.text>>
		ENDTEXT
		Messagebox(m.myvar,0+32+4096,"Some selected node properties")

	Endi
	Endproc


	Procedure oletreeview.LostFocus
	On Key Label F1
	Endproc

	Procedure oletreeview.GotFocus
	On Key Label F1 Help Id _Screen.ActiveForm.HelpContextID
	Endproc

	Procedure oletreeview.Init
	This.HideSelection=.F.
	Endproc

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

	Procedure txtsearch.InteractiveChange
	Thisform.cmdnext.Enabled = .F.
	Thisform.cmdback.Enabled = .F.
	Endproc

	Procedure cmdsearch.Click
	Local llFound,liSelNode , lcCond
	If Thisform.oletreeview.nodes.Count <= 0
		Return
	Endif
	If Not Empty(Thisform.txtsearch.Value )

		For i = 1 To Thisform.oletreeview.nodes.Count
			Thisform.oletreeview.nodes(i).ForeColor =0   &&default  RGB(255,0,0)
		Endfor
		= .F.
		Try
			liSelNode = Thisform.oletreeview.SelectedItem.Index
		Catch
			liSelNode =1
		Endtry
		j=0
		For i = 1 To Thisform.oletreeview.nodes.Count
			If Thisform.optsrch.Value = 1 && match case
				lcCond = "upper(ALLTRIM(thisform.txtsearch.Value))$UPPER(ALLTRIM(thisform.oletreeview.Nodes(i).Text))"
			Else
				lcCond = "UPPER(ALLTRIM(thisform.oletreeview.Nodes(i).Text)) == UPPER(ALLTRIM(thisform.txtsearch.Value))"
			Endif
			If &lcCond
				llFound = .T.
				j=j+1
				Thisform.oletreeview.nodes(i).Selected = .T.
				Thisform.cmdnext.Enabled = .T.
				Thisform.cmdback.Enabled = .T.
				If Thisform.chkall.Value = 0
					Exit
				Else
					Thisform.oletreeview.nodes(i).ForeColor = Rgb(255,0,0)
				Endif
			Endif
		Endfor

		If Not llFound
			Messagebox("Not Found.",0+32+4096,'',1200)
			Thisform.oletreeview.SetFocus

			Thisform.oletreeview.nodes(liSelNode).Selected = .T.

			Thisform.oletreeview.MouseDown(1)    &&click
		Else
			Messagebox(Trans(j)+" found",0+32+4096,'',1200)

		Endif
	Endif
	Endproc

	Procedure cmdnext.Click
	Local llFound,liSelNode , lcCond
	If Not Empty(Thisform.txtsearch.Value )
		llFound = .F.
		liSelNode = Thisform.oletreeview.SelectedItem.Index
		For i = liSelNode + 1 To Thisform.oletreeview.nodes.Count
			If Thisform.optsrch.Value = 1 && match case
				lcCond = "upper(ALLTRIM(thisform.txtsearch.Value))$UPPER(ALLTRIM(thisform.oletreeView.Nodes(i).Text))"
			Else
				lcCond = "UPPER(ALLTRIM(thisform.oletreeView.Nodes(i).Text)) == UPPER(ALLTRIM(thisform.txtsearch.Value))"
			Endif
			If &lcCond
				llFound = .T.
				Thisform.oletreeview.nodes(i).Selected = .T.
				Exit
			Endif
		Endfor
		If Not llFound
			Messagebox("Not Found.",0+32+4096,'',1200)
			Thisform.oletreeview.SetFocus
			Thisform.oletreeview.nodes(liSelNode).Selected = .T.
			Thisform.oletreeview.MouseDown(1)    &&click
		Endif

	Endif
	Endproc

	Procedure cmdback.Click
	Local llFound,liSelNode , lcCond
	If Not Empty(Thisform.txtsearch.Value )
		llFound = .F.
		liSelNode = Thisform.oletreeview.SelectedItem.Index
		For i = liSelNode - 1 To 1 Step -1
			If i > 0
				If Thisform.optsrch.Value = 1 && match case
					lcCond = "upper(ALLTRIM(thisform.txtsearch.Value))$UPPER(ALLTRIM(thisform.oletreeView.Nodes(i).Text))"
				Else
					lcCond = "UPPER(ALLTRIM(thisform.oletreeView.Nodes(i).Text)) == UPPER(ALLTRIM(thisform.txtsearch.Value))"
				Endif
				If &lcCond
					llFound = .T.
					Thisform.oletreeview.nodes(i).Selected = .T.
					Exit
				Endif
			Endif
		Endfor
		If Not llFound
			Messagebox("Not Found.",0+32+4096,'',1200)
			Thisform.oletreeview.SetFocus
			Thisform.oletreeview.nodes(liSelNode).Selected = .T.
			Thisform.oletreeview.MouseDown(1)     &&click

		Endif
	Endif
	Endproc

Enddefine
*
*-- EndDefine: ytreeview


playing with MSComctlLib.TreeCtrl.2 Treeviews

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


*5* created on 30 of may 2017
*this code shows with a simplified maner the one used in vfp solution.app
*for demo , nodes icons are random bmps found in solution folder (exercice:try to correspond bmp icon to form,report,ole...).
*can expand/collapse treeview with buttons (+-)
*in nodeclick can write actions to run.
*pre require: table solution.dbf

Declare Integer Sleep In kernel32 Integer

Publi yform
yform=Newobject("ysolution")
yform.Show
Read Events
Retu
*
Define Class ysolution As Form
	DataSession = 2
	BorderStyle = 3
	autocenter=.t.
	Top = -1
	Left = 1
	Height = 408
	Width = 438
	ShowWindow = 2
	ShowTips = .T.
	Caption = "Visual FoxPro Solutions"
	MaxButton = .F.
	Name = "solutions"
	*-- Specifies whether to return to FoxHelp on deactive or not.
	keephelp = .F.
	Dimension asamples[1,2]

	Add Object shape1 As Shape With ;
		Top = 350, ;
		Left = 4, ;
		Height = 56, ;
		Width = 429, ;
		SpecialEffect = 0, ;
		Name = "Shape1"

	Add Object edtdescription As EditBox With ;
		FontBold = .F., ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		BorderStyle = 0, ;
		Height = 42, ;
		Left = 10, ;
		ReadOnly = .T., ;
		ScrollBars = 0, ;
		TabIndex = 0, ;
		TabStop = .F., ;
		Top = 360, ;
		Width = 416, ;
		ControlSource = "ycurs.descript", ;
		IntegralHeight = .F., ;
		Name = "edtDescription"

	Add Object shape2 As Shape With ;
		Top = 12, ;
		Left = 9, ;
		Height = 324, ;
		Width = 429, ;
		SpecialEffect = 0, ;
		Name = "Shape2"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .F., ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Caption = " Solution Samples ", ;
		Height = 15, ;
		Left = 16, ;
		MousePointer = 7, ;
		Top = 7, ;
		Width = 89, ;
		TabIndex = 1, ;
		Name = "Label2"

	Add Object lbldescription As Label With ;
		AutoSize = .T., ;
		FontBold = .F., ;
		FontName = "MS Sans Serif", ;
		FontSize = 8, ;
		Caption = " Description ", ;
		Height = 15, ;
		Left = 12, ;
		MousePointer = 7, ;
		Top = 342, ;
		Width = 61, ;
		TabIndex = 0, ;
		Name = "lblDescription"

	Add Object oletree As OleControl With ;
		oleclass="MSComctlLib.TreeCtrl.2",;
		Top = 47, ;
		Left = 22, ;
		Height = 277, ;
		Width = 396, ;
		TabIndex = 1, ;
		Name = "oleTree"

	Add Object oleimages As OleControl With ;
		oleclass="MSComctlLib.ImageListCtrl.2",;
		Top = 155, ;
		Left = 362, ;
		Height = 100, ;
		Width = 100, ;
		Name = "oleImages"

	Add Object cmdcollapseall As CommandButton With ;
		Top = 28, ;
		Left = 414, ;
		Height = 18, ;
		Width = 15, ;
		FontBold = .F., ;
		FontName = "Courier New", ;
		FontSize = 11, ;
		Caption = "-", ;
		TabIndex = 3, ;
		ToolTipText = "Collapse All", ;
		Name = "cmdCollapseAll"

	Add Object cmdexpandall As CommandButton With ;
		Top = 28, ;
		Left = 397, ;
		Height = 18, ;
		Width = 15, ;
		FontBold = .F., ;
		FontName = "Courier New", ;
		FontSize = 11, ;
		Caption = "+", ;
		TabIndex = 2, ;
		ToolTipText = "Expand All", ;
		Name = "cmdExpandAll"

	*-- fill the oletree tree view control
	Procedure filltree
	o = Thisform.oletree
	o.ImageList = Thisform.oleimages
	Sele ycurs
	Scan For Inlist(Alltrim(Upper(Type)),"N","F","R","Q","V","D")
		If Alltrim(Parent) = '0'
			oNode = o.nodes.Add(,1,Alltrim(Key),Alltrim(Text),,)
		Else
			oNode = o.nodes.Add(Alltrim(Parent),4,Alltrim(Key), Alltrim(Text),,)
		Endif
		* add images to the treeview
		If !Empty(Image)
			oNode.Image = Int((29) * Rand( ) + 1)       &&random images 1-29 bmps n solution folder        &&ALLTRIM(image)
		Endif
	Endscan
	o.Sorted = .T.
	this.cmdexpandall.click()
	Endproc

	Procedure Load
	Close Data All
	Sele * From Home(1)+"samples\solution\solution.dbf" Into Cursor ycurs
	*Brow
	Endproc

	Procedure oleimages.Init
	Local m.yfolderIcons
	m.yfolderIcons=Home(1)+"samples\solution\"
	With This
		.ImageHeight = 15
		.ImageWidth =  17
		gnbre=Adir(gabase,m.yfolderIcons+"*.bmp")

		For i=1 To gnbre
			m.x=m.yfolderIcons+gabase(i,1)
			.ListImages.Add(,Juststem(m.x),LoadPicture(m.x) ) &&populate the imagelist object with desired  bmps
			Sleep(10)
		Endfor

	Endwith
	Endproc

	Procedure Init
	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)

	#Define NOLOADOCX_LOC	"Visual FoxPro could not load ActiveX controls used by this form. Try reinstalling sample applications."

	* Check to see if OCX installed and loaded.
	If Type("THIS.oleImages") # "O" Or Isnull(This.oleimages)
		Messagebox(NOLOADOCX_LOC)
		Return .F.
	Endif
	If Type("THIS.oleTree") # "O" Or Isnull(This.oletree)
		Messagebox(NOLOADOCX_LOC)
		Return .F.
	Endif

	This.filltree
	Endproc

	Procedure Destroy
	Clear Events
	Endproc

	Procedure oletree.NodeClick
	*** ActiveX Control Event ***
	Lparameters Node
	Select ycurs
	Locate For Key = Node.Key

	If !Empty(File)
		Messagebox(File,0+32+4096,"",1200)
	Endif
	Thisform.Refresh
	Endproc

	Procedure cmdcollapseall.Click
	o = Thisform.oletree
	Thisform.LockScreen = .T.
	o.Visible = .F.
	For i = 1 To o.nodes.Count
		o.nodes(i).Expanded = .F.
	Endfor
	o.Visible = .T.
	Thisform.LockScreen = .F.
	Endproc

	Procedure cmdexpandall.Click
	Local lnIndex
	o = Thisform.oletree
	Thisform.LockScreen = .T.
	o.Visible = .F.
	For i = 1 To o.nodes.Count
		o.nodes(i).Expanded = .T.
	Endfor
	o.Visible = .T.
	Thisform.LockScreen = .F.
	lnIndex=1
	If Type("THISFORM.oleTree.SelectedItem.Index")="N"
		lnIndex = Thisform.oletree.SelectedItem.Index
		Thisform.oletree.SelectedItem =;
			THISFORM.oletree.nodes(1)
	Endif
	Thisform.oletree.SelectedItem =;
		THISFORM.oletree.nodes(lnIndex)
	Endproc

Enddefine
*
*-- EndDefine: ysolution


playing with MSComctlLib.TreeCtrl.2 Treeviews

Important:All Codes above are tested on VFP9SP2 & windows 10 pro .

To be informed of the latest articles, subscribe:

Comment on this post