Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
MS Treeview
Message
From
06/05/2003 09:29:30
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
 
To
06/05/2003 09:09:37
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Miscellaneous
Thread ID:
00784606
Message ID:
00785322
Views:
48
Peter,
I think I found it. Data is not very good to show case but still hope understandable.
Create cursor Items (Desc c(10), ItemId i)
Insert into Items values ('CPU',1)
Insert into Items values ('VGAcard',2)
Insert into Items values ('NetCard',3)
Insert into Items values ('CPUFAN',4)
Insert into Items values ('FAN',5)
Insert into Items values ('MONITOR',6)
Insert into Items values ('KEYBOARD',7)
Insert into Items values ('MOUSE',8)
Insert into Items values ('RAM64',9)
Insert into Items values ('RAM128',10)
Insert into Items values ('CD',11)
Insert into Items values ('DVD',12)
Insert into Items values ('Case',13)
Insert into Items values ('Board',14)
Insert into Items values ('MP Board',15)
Insert into Items values ('DP Case',16)

Create cursor Packages (Desc c(10), PackageId i, ItemId i, Qty i)
For ix=1 to 8
  Insert into Packages values ('Basic', 1,ix,1)
Endfor
Insert into Packages values ('Standart', 2, 9,1)
Insert into Packages values ('Standart', 2, 13,1)
Insert into Packages values ('Standart', 2, 14,1)
Insert into Packages values ('MultiPro', 3, 15,1)
Insert into Packages values ('MultiPro', 3, 16,1)

Create cursor Products (Desc c(10), IngrType c(1), IngrId i, Qty i)
Insert into Products values ('Basic', 'P', 1,1)
Insert into Products values ('Basic', 'P', 2,1)
Insert into Products values ('BasicCD', 'P', 1,1)
Insert into Products values ('BasicCD', 'P', 2,1)
Insert into Products values ('BasicCD', 'I', 11,1)
Insert into Products values ('BasicDVD', 'P', 1,1)
Insert into Products values ('BasicDVD', 'P', 2,1)
Insert into Products values ('BasicDVD', 'I', 12,1)
Insert into Products values ('CPU2_128', 'P', 1,1) && Double CPU, 128
Insert into Products values ('CPU2_128', 'P', 3,1)
Insert into Products values ('CPU2_128', 'I', 10,1)
Insert into Products values ('CPU2_256', 'P', 1,1) && Double CPU, 256
Insert into Products values ('CPU2_256', 'P', 3,1)
Insert into Products values ('CPU2_256', 'I', 10,2)

Create cursor TreeView ;
  (NodeId c(10), ParentId c(10), NodeText c(10), NodeType c(10), Qty i, FromTable c(10), FromId i)
Select distinct Desc from Products into array arrProducts
For ix=1 to alen(arrProducts)
  Insert into TreeView values (sys(2015), '', arrProducts[ix],'Product',1,'Products',0)
Endfor

Select TreeView
Go top
Scan while NodeType = 'Product'
  lnRec = recno()
  GetChilds(TreeView.NodeText,TreeView.NodeId)
  Go lnRec
Endscan
Select TreeView
Index on NodeId tag NodeId
Index on ParentId tag ParentId

* 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
Select TreeView
Go top
GetBranch(TreeView.NodeId)
Select crsNodes
Brow

Function GetBranch
Lparameters tcNodeId
Select TreeView
=seek(tcNodeId,'TreeView','NodeId') && For first rec. get itself
Scatter memvar
Set order to tag ParentId
Local lnRec, lcNodeId
Afields(arrStruc)
Create cursor crsNodes from array arrStruc
Insert into crsNodes from memvar
Scan
  lnRec=recno('crsNodes')
  lcNodeId = crsNodes.NodeId
  Select TreeView
  Seek crsNodes.NodeId
  Scan while ParentId == lcNodeId
    Scatter memvar
    Insert into crsNodes from memvar
  Endscan
  Select crsNodes
  Go lnRec
Endscan


Function GetChilds
Lparameters tcProduct, tcParentId
Select * from Products where Desc == tcProduct into cursor crsProduct
Scan
  If crsProduct.IngrType = 'P'
    Select Packages.*, Items.Desc as ItemDesc from Packages ;
      left join Items on Packages.ItemId = Items.ItemId ;
      where PackageId = crsProduct.IngrId ;
      into cursor crsPackage nofilter
    Insert into TreeView values ;
      (sys(2015), tcParentId, crsPackage.Desc,'Package',crsProduct.Qty,'Packages',crsPackage.PackageId)
    lcPackageId = TreeView.NodeId
    Scan
      Insert into TreeView values ;
        (sys(2015), lcPackageId, crsPackage.ItemDesc,'Item',crsPackage.Qty,'Items',crsPackage.ItemId)
    Endscan
  Else
    Select * from Items ;
      where ItemId = crsProduct.IngrId ;
      into cursor crsItem
    Insert into TreeView values (sys(2015), tcParentId, crsItem.Desc,'Item',crsProduct.Qty,'Items',crsItem.ItemId)
  Endif
Endscan
Select TreeView




Define CLASS myForm AS form
  Top = 2
  Left = 2
  Height = 315
  Width = 628
  DoCreate = .T.
  Caption = "TreeView - testpad"
  BackColor = RGB(192,192,192)
  Name = "myForm"

  *-- Node object reference
  nodx = .F.
  nxtwips = .F.
  nytwips = .F.
  originalhgt = .F.
  originalwdt = .F.

  Add OBJECT oletreeview AS olecontrol WITH ;
    Top = 12, ;
    Left = 0, ;
    Height = 296, ;
    Width = 624, ;
    Name = "OleTreeView", ;
    OleClass = 'MSComCtlLib.TreeCtrl'

  Add OBJECT oleimageslist AS olecontrol WITH ;
    Top = 0, ;
    Left = 0, ;
    Height = 100, ;
    Width = 100, ;
    Name = "oleImagesList",;
    OleClass = 'MSComCtlLib.ImageListCtrl'

  *-- Fill the tree values
  Procedure filltree
  Lparameters tcDirectory
  This.show
  Select TreeView
  With THIS.oletreeview.nodes
    Scan
      If empty(ParentId)
        .add(,tvwFirst,NodeId,NodeText,"ClosedFolder","OpenFolder")
      Else
        .Add(ParentId, tvwChild, NodeId,NodeText,"ClosedFolder","OpenFolder")
      Endif
    Endscan
  Endwith
Endproc

  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.originalhgt = this.Height
  This.originalwdt = this.Width
  Thisform.pixeltotwips()
  Set TALK OFF
  * 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
  lcIconPath = home(3)+'Graphics\Icons\Win95'
  With this.oleimageslist
    .ImageHeight = 16
    .ImageWidth = 16
    .ListImages.Add(,"OpenFolder",LoadPicture(lcIconPath+"\openfold.ico"))
    .ListImages.Add(,"ClosedFolder",LoadPicture(lcIconPath+"\clsdfold.ico"))
  Endwith
  With THIS.oletreeview
    .linestyle =1
    .labeledit =1
    .indentation = 5
    .imagelist = this.oleimageslist.object
    .PathSeparator = '\'
    .OleDragMode = 1
    .OleDropMode = 1
  Endwith
  This.filltree()
Endproc

Enddefine
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform