#Define tvwFirst 0
#Define tvwLast 1
#Define tvwNext 2
#Define tvwPrevious 3
#Define tvwChild 4
#Define cnLOG_PIXELS_X 88
#Define cnLOG_PIXELS_Y 90
#Define cnTWIPS_PER_INCH 1440
Text to myMenu noshow
Lparameters toNode,toForm
DEFINE POPUP shortcut SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF shortcut PROMPT "Key"
DEFINE BAR 2 OF shortcut PROMPT "Text"
DEFINE BAR 3 OF shortcut PROMPT "Fullpath"
DEFINE BAR 4 OF shortcut PROMPT "Index"
DEFINE BAR 5 OF shortcut PROMPT "New Item"
ON SELECTION BAR 1 OF shortcut ;
wait window toNode.Key timeout 2
ON SELECTION BAR 2 OF shortcut ;
wait window toNode.Text timeout 2
ON SELECTION BAR 3 OF shortcut ;
wait window toNode.Fullpath timeout 2
ON SELECTION BAR 4 OF shortcut ;
wait window Transform(toNode.Index) timeout 2
ON SELECTION BAR 5 OF shortcut toForm.ShowIt(toNode)
ACTIVATE POPUP shortcut
EndText
*StrToFile(m.myMenu,'myTVShcut.mpr')
oForm = createobject('myForm')
With oForm
.AddObject('Tree','myTreeView')
.Addobject('Lister','Lister')
With .Tree
.Left = 10
.Top = 10
.Width = 200
.Height = 200
.Nodes.add(,0,"root0",'Main node 1')
.Nodes.add(,0,"root1",'Main node 2')
.Nodes.add(,0,"root2",'Main node 3')
.Nodes.add('root1',4,"child11",'Child11')
.Nodes.add('root1',4,"child12",'Child12')
.Nodes.add('root2',4,"child21",'Child22')
.Nodes.add('child21',3,"child20",'Child21')
oNodx=.Nodes.add('child11',4,"child111",'child113')
oNodx.Bold=.t.
.Nodes.add('child111',3,"child112",'child112')
.Nodes.add('child112',3,"child113",'child111')
.Nodes.add('child12',4,"child121",'child121')
.Nodes.add('child12',4,"child122",'child122')
.Nodes.add('child112',4,"child1121",'child1121')
.Nodes.add('child112',4,"child1122",'child1122')
.Nodes.add('child112',4,"child1123",'child1123')
.Nodes.add('child112',4,"child1124",'child1124')
.Nodes.add('child112',4,"child1125",'child1125')
.Nodes.add('child1121',4,"child11211",'child11211')
.Nodes.add('child1121',4,"child11212",'child11212')
.Nodes.add('child11211',4,"child112111",'child112111')
.Nodes.add('child11212',4,"child112121",'child112121 last added')
.Visible = .t.
.Nodes(.Nodes.Count).Ensurevisible
with .Font
.Size = 12
.Name = 'Times New Roman'
.Bold = .f.
.Italic = .t.
endwith
Endwith
.Lister.Left = .Tree.Left + .Tree.Width + 5
.Lister.visible = .t.
.Show()
Endwith
Read events
Function TVLister
Lparameters toTV
Local lnIndex,lnLastIndex
With toTV
lnIndex = .Nodes(1).Root.FirstSibling.Index
lnLastIndex = .Nodes(1).Root.LastSibling.Index
_GetSubNodes(lnIndex,toTV,lnIndex)
Do While lnIndex # lnLastIndex
lnIndex = .Nodes(lnIndex).Next.Index
_GetSubNodes(lnIndex,toTV,lnIndex)
Enddo
Endwith
Function _GetSubNodes
Lparameters tnIndex, toTV, tnRootIndex
Local lnIndex, lnLastIndex
With toTV
WriteNode(tnIndex,toTV, tnRootIndex)
If .Nodes(tnIndex).Children > 0
lnIndex = .Nodes(tnIndex).Child.Index
lnLastIndex = .Nodes(tnIndex).Child.LastSibling.Index
_GetSubNodes(lnIndex,toTV,tnRootIndex)
Do While lnIndex # lnLastIndex
lnIndex = .Nodes(lnIndex).Next.Index
_GetSubNodes(lnIndex,toTV,tnRootIndex)
Enddo
Endif
Endwith
Function WriteNode
Lparameters tnCurIndex, toTV,tnRootIndex
Local lnRootIndex, lnIndex, lcPrefix, lcKey, lnLevel
lnIndex = tnCurIndex
With toTV
lcPrefix = '+-' + .Nodes(lnIndex).Text
lnLevel = 0
Do While lnIndex # tnRootIndex
lnIndex = .Nodes(lnIndex).Parent.Index
lcPrefix = Iif(.Nodes(lnIndex).LastSibling.Index = lnIndex,' ','|')+Space(3)+lcPrefix
lnLevel = lnLevel + 1
EndDo
? lcPrefix
Endwith
FUNCTION WalkTree
LPARAMETERS oNode,lnIndent,tlPlus
? Iif(tlPlus,'+','')+REPLICATE(CHR(9),lnIndent)+oNode.Text
IF !ISNULL(oNode.Child)
WalkTree(oNode.Child,lnIndent+1,.t.)
ENDIF
IF !ISNULL(oNode.Next)
WalkTree(oNode.Next,lnIndent,.f.)
ENDIF
RETURN
ENDFUNC
Define class myForm as Form
nxtwips = .F.
nytwips = .F.
Procedure queryunload
Clear events
EndProc
Procedure ShowIt
Lparameters toNode
MessageBox("Form method called with " + toNode.FullPath)
endproc
PROCEDURE Init
*-- Code for PixelToTwips method
Local liHWnd, liHDC, liPixelsPerInchX, liPixelsPerInchY
* Declare some Windows API functions.
Declare integer GetActiveWindow in WIN32API
Declare integer GetDC in WIN32API integer iHDC
Declare integer GetDeviceCaps in WIN32API integer iHDC, integer iIndex
* Get a device context for VFP.
liHWnd = GetActiveWindow()
liHDC = GetDC(liHWnd)
* Get the pixels per inch.
liPixelsPerInchX = GetDeviceCaps(liHDC, cnLOG_PIXELS_X)
liPixelsPerInchY = GetDeviceCaps(liHDC, cnLOG_PIXELS_Y)
* Get the twips per pixel.
This.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
This.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
Return
Endproc
PROCEDURE CheckRest
Lparameters tnIndex, tlCheck, toTreeView
Local lnIndex, lnLastIndex
With toTreeView
.Nodes(tnIndex).Checked = tlCheck
If .Nodes(tnIndex).Children > 0
lnIndex = .Nodes(tnIndex).Child.Index
lnLastIndex = .Nodes(tnIndex).Child.LastSibling.Index
This.CheckRest(lnIndex, tlCheck, toTreeView)
Do While lnIndex # lnLastIndex
lnIndex = .Nodes(lnIndex).Next.Index
This.CheckRest(lnIndex, tlCheck, toTreeView)
Enddo
Endif
Endwith
endProc
Enddefine
Define class myTreeView as olecontrol
OLEDragMode = 1
OLEDropMode = 1
Name = "OleTreeView"
OleClass = 'MSComCtlLib.TreeCtrl'
Procedure init
With this
.Object.CheckBoxes = .t.
.linestyle =1
.labeledit =1
.indentation = 5
.PathSeparator = '\'
Endwith
Endproc
Procedure NodeClick
*** ActiveX Control Event ***
Lparameters node
Node.ensurevisible
MessageBox(Node.Fullpath + Chr(13) +trans(Node.Index),0,"NodeClick",2000)
Endproc
Procedure MouseDown
LPARAMETERS button, shift, x, y
if button=2
lcWhere = ''
oNode = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
If type("oNode")= "O" AND !ISNULL(oNode)
* DO myTVShcut.mpr with oNode
ExecScript(m.MyMenu, oNode, thisform)
EndIf
endif
Endproc
Procedure MouseUp
LPARAMETERS button, shift, x, y
*!* if button=2
*!* nodefault
*!* Wait window 'Right click occured in Mup' timeout 2
*!* endif
if button=1
oNode = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
If type("oNode")= "O" AND !ISNULL(oNode)
IF oNode.Key # 'root1'
oNode.Checked = .F.
ELSE
thisform.CheckRest(oNode.Index,oNode.Checked,this)
endif
Endif
endif
Endproc
*!* Procedure NodeCheck
*!* *** ActiveX Control Event ***
*!* Lparameters node,dummy
*!* IF node.Key = 'root1'
*!* thisform.CheckRest(node.Index,node.Checked,this)
*!* endif
*!* endproc
Procedure _SubNodes
Lparameters tnIndex, tnLevel
Local lnIndex
lcFs = ''
With this
? iif(tnLevel=0,'',replicate(chr(9),tnLevel))+.Nodes(tnIndex).Text, "[Actual index :"+trans(tnIndex)+"]"
If .Nodes(tnIndex).Children > 0
lnIndex = .Nodes(tnIndex).Child.Index
._SubNodes(lnIndex,tnLevel+1)
Do while lnIndex # .Nodes(tnIndex).Child.LastSibling.Index
lnIndex = .Nodes(lnIndex).Next.Index
._SubNodes(lnIndex,tnLevel+1)
Enddo
Endif
Endwith
Endproc
Procedure ExpandAll
Lparameters tnIndex
Local lnIndex
With this
.Nodes(tnIndex).Expanded = .t.
If .Nodes(tnIndex).Children > 0
lnIndex = .Nodes(tnIndex).Child.Index
.ExpandAll(lnIndex)
Do while lnIndex # .Nodes(tnIndex).Child.LastSibling.Index
lnIndex = .Nodes(lnIndex).Next.Index
.ExpandAll(lnIndex)
Enddo
Endif
Endwith
Endproc
Enddefine
Define class Lister as commandbutton
Caption = 'List'
Procedure click
Activate Screen
TvLister(thisform.Tree)
With thisform.Tree
* WalkTree(.Nodes(1),0)
* .ExpandAll(.SelectedItem.Index)
Endwith
Endproc
Procedure click1
Activate screen
Clear
Local lnIndex
With thisform.Tree
lnIndex = .Nodes(1).Root.FirstSibling.Index
._SubNodes(lnIndex,0)
Do while lnIndex # .Nodes(1).Root.LastSibling.Index
lnIndex = .Nodes(lnIndex).Next.Index
._SubNodes(lnIndex,0)
Enddo
Endwith
Endproc
Enddefine