playing with MSComctlLib.TreeCtrl.2 Treeviews
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+
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.
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.
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.
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
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
Important:All Codes above are tested on VFP9SP2 & windows 10 pro .