Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Lost child in Treeview
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Contrôles ActiveX en VFP
Divers
Thread ID:
00786300
Message ID:
00786301
Vues:
51
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
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform