General information
Category:
ActiveX controls in VFP
Here is the Treeview.prg I'm trying with...
some ideas?
* Define some constants.
#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
* 1440 twips per inch
oForm = createobject('myForm')
oForm.Show
Read events
Define CLASS myForm AS form
Height = 600
Width = 800
DoCreate = .T.
Caption = "TreeView - testpad"
Name = "myForm"
*-- Node object reference
nodx = .F.
nxtwips = .F.
nytwips = .F.
Add OBJECT oletreeview AS olecontrol WITH ;
Top = 0, ;
Left = 0, ;
Height = 590, ;
Width = 400, ;
Name = "OleTreeView", ;
OleClass = 'MSComCtlLib.TreeCtrl'
Add OBJECT oletreeview2 AS olecontrol WITH ;
Top = 0, ;
Left = 410, ;
Height = 590, ;
Width = 400, ;
Name = "OleTreeView2", ;
OleClass = 'MSComCtlLib.TreeCtrl'
Add OBJECT oleimageslist AS olecontrol WITH ;
Top = 0, ;
Left = 0, ;
Height = 100, ;
Width = 100, ;
Name = "oleImagesList",;
OleClass = 'MSComCtlLib.ImageListCtrl'
Procedure pixeltotwips
*-- 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.
Thisform.nxtwips = ( cnTWIPS_PER_INCH / liPixelsPerInchX )
Thisform.nytwips = ( cnTWIPS_PER_INCH / liPixelsPerInchY )
Return
Endproc
Procedure QueryUnload
Thisform.nodx = .null.
Clear events
Endproc
Procedure Init
This.pixeltotwips()
Set TALK OFF
Set exact ON
* Check to see if OCX installed and loaded.
If TYPE("THIS.oleTreeView") # "O" OR ISNULL(THIS.oletreeview)
Return .F.
Endif
If TYPE("THIS.oleImagesList") # "O" OR ISNULL(THIS.oleimageslist)
Return .F.
Endif
DIMENSION arrayHijos(999)
With this.oleimageslist
.ImageHeight = 16
.ImageWidth = 16
.ListImages.Add(,"menu",LoadPicture("mnu.ico"))
.ListImages.Add(,"proc",LoadPicture("proc.ico"))
.ListImages.Add(,"rpt",LoadPicture("rpt.ico"))
.ListImages.Add(,"trn",LoadPicture("trn.ico"))
.ListImages.Add(,"wkp",LoadPicture("wkp.ico"))
Endwith
With THIS.oletreeview
.linestyle =1
.labeledit =1
.indentation = 5
.imagelist = this.oleimageslist.object
.PathSeparator = '\'
.OleDragMode = 1
.OleDropMode = 1
Endwith
With THIS.oletreeview2
.linestyle =1
.labeledit =1
.indentation = 5
.imagelist = this.oleimageslist.object
.PathSeparator = '\'
.OleDragMode = 1
.OleDropMode = 1
Endwith
* Metodo nodes.add( nodo, relacion con ese nodo, clave del nuevo nodo, texto del nuevo nodo, im1, im2)
With THIS.oletreeview.nodes
clave = 'root_1'
oNode=.add(,tvwFirst,clave,clave,"menu")
claveb1 = clave + '_1'
oNode=.add(clave,tvwchild,claveb1 ,claveb1,"wkp")
claveb2 = clave + '_2'
oNode=.add(clave,tvwchild,claveb2 ,claveb2,"wkp")
claveb11 = claveb1 + '_1'
oNode=.add(claveb1,tvwchild,claveb11 ,claveb11,"proc")
claveb12 = claveb1 + '_2'
oNode=.add(claveb1,tvwchild,claveb12,claveb12,"proc")
claveb13 = claveb1 + '_3'
oNode=.add(claveb1,tvwchild,claveb13,claveb13,"proc")
claveb21 = claveb2 + '_1'
oNode=.add(claveb2,tvwchild,claveb21,claveb21,"proc")
claveb22 = claveb2 + '_2'
oNode=.add(claveb2,tvwchild,claveb22 ,claveb22,"proc")
claveb211 = claveb21 + '_1'
oNode=.add(claveb21,tvwchild,claveb211 ,claveb211,"proc")
Endwith
With THIS.oletreeview2.nodes
clave = 'root_2'
oNode=.add(,tvwFirst,clave,clave,"menu")
claveb1 = clave + '_1'
oNode=.add(clave,tvwchild,claveb1 ,claveb1,"wkp")
claveb11 = claveb1 + '_1'
oNode=.add(claveb1,tvwchild,claveb11,claveb11,"proc")
Endwith
Endproc
Procedure oletreeview.Expand
*** ActiveX Control Event ***
Lparameters node
* Thisform._SubFolders(node)
Node.ensurevisible
Endproc
Procedure oletreeview2.Expand
*** ActiveX Control Event ***
Lparameters node
* Thisform._SubFolders(node)
Node.ensurevisible
Endproc
Procedure oletreeview.NodeClick
*** ActiveX Control Event ***
Lparameters node
Node.ensurevisible
This.DropHighlight = .null.
Endproc
Procedure oletreeview2.NodeClick
*** ActiveX Control Event ***
Lparameters node
Node.ensurevisible
This.DropHighlight = .null.
Endproc
Procedure oletreeview.MouseDown
*** ActiveX Control Event ***
Lparameters button, shift, x, y
With thisform
oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips )
If type("oHitTest")= "O" and !isnull(oHitTest)
This.SelectedItem = oHitTest
Endif
.nodx = this.SelectedItem
Endwith
oHitTest = .null.
Endproc
Procedure oletreeview2.MouseDown
*** ActiveX Control Event ***
Lparameters button, shift, x, y
With thisform
oHitTest = THIS.HitTest( x * .nxtwips, Y * .nytwips )
If type("oHitTest")= "O" and !isnull(oHitTest)
This.SelectedItem = oHitTest
Endif
.nodx = this.SelectedItem
Endwith
oHitTest = .null.
Endproc
Procedure oletreeview.OLEDragOver
*** ActiveX Control Event ***
Lparameters data, effect, button, shift, x, y, state
oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
If type("oHitTest")= "O"
This.DropHighlight = oHitTest
Endif
Endproc
Procedure oletreeview2.OLEDragOver
*** ActiveX Control Event ***
Lparameters data, effect, button, shift, x, y, state
oHitTest = THIS.HitTest( x * THISFORM.nxtwips, Y * THISFORM.nytwips )
If type("oHitTest")= "O"
This.DropHighlight = oHitTest
Endif
Endproc
Procedure oletreeview.OLEDragDrop
*** ActiveX Control Event ***
Lparameters data, effect, button, shift, x, y
If Data.Getformat(1) &&CF_TEXT
With this
If !isnull(thisform.nodx) and type(".DropHighLight") = "O" and !isnull(.DropHighlight)
loSource = thisform.nodx
loTarget = .DropHighlight
If loSource.Key # loTarget.key
if loSource.Parent.Key # loTarget.key
lcSourceKey = loSource.Key
lcSourceText = loSource.Text
* no es una copia... esta moviendo
* decision: si es dentro del mismo objeto, solo puede mover.
if loSource.root.key # loTarget.Root.key
llRemoveSource = .F.
else
llRemoveSource = .T.
endif
* (shift<>2)
* hijos = losource.children
* do GetChilds with losource, ArrayHijos()
If llRemoveSource
.nodes.Remove(loSource.Index)
endif
if type('.Nodes(lcSourceKey)') # 'O'
oNode=.nodes.add(loTarget.Key,tvwchild,lcSourceKey,lcSourceText,"proc","proc")
.SelectedItem = oNode
else
messagebox('ya existe '+lcsourcekey)
endif
else
messagebox('No se puede. Tienen el mismo padre '+loSource.Parent.Key+' '+loTarget.key)
Endif
else
messagebox('No se puede. Son la misma clave '+loSource.key+' '+loTarget.Key)
Endif
Endif
Endwith
Endif
This.DropHighlight = .null.
messagebox('cant nodos: '+str(this.Nodes.Count))
Endproc
Procedure oletreeview2.OLEDragDrop
*** ActiveX Control Event ***
Lparameters data, effect, button, shift, x, y
If Data.Getformat(1) &&CF_TEXT
With this
If !isnull(thisform.nodx) and type(".DropHighLight") = "O" and !isnull(.DropHighlight)
loSource = thisform.nodx
loTarget = .DropHighlight
If loSource.Key # loTarget.key
if loSource.Parent.Key # loTarget.key
lcSourceKey = loSource.Key
lcSourceText = loSource.Text
* no es una copia... esta moviendo
* decision: si es dentro del mismo objeto, solo puede mover.
if loSource.root.key # loTarget.Root.key
llRemoveSource = .F.
else
llRemoveSource = .T.
endif
* (shift<>2)
* hijos = losource.children
If llRemoveSource
.nodes.Remove(loSource.Index)
endif
if type('.Nodes(lcSourceKey)') # 'O'
oNode=.nodes.add(loTarget.Key,tvwchild,lcSourceKey,lcSourceText,"proc","proc")
.SelectedItem = oNode
else
messagebox('ya existe '+lcsourcekey)
endif
else
messagebox('No se puede. Tienen el mismo padre '+loSource.Parent.Key+' '+loTarget.key)
Endif
else
messagebox('No se puede. Son la misma clave '+loSource.key+' '+loTarget.Key)
Endif
Endif
Endwith
Endif
This.DropHighlight = .null.
Endproc
proc GetChilds
LPARAMETERS Nodo, Arrayhijos()
endproc
Enddefine
Previous
Reply
View the map of this thread
View the map of this thread starting from this message only
View all messages of this thread
View all messages of this thread starting from this message only