Code: Select all
#include "fivewin.ch"
#include "xbrowse.ch"
REQUEST DBFCDX
function main()
local oDlg, oFont, oBrw
local oTree
CreateTestDBF()
oTree := MakeTree()
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 350,500 PIXEL FONT oFont
@ 10,10 XBROWSE oBrw SIZE -10,-10 PIXEL OF oDlg ;
DATASOURCE oTree CELL LINES NOBORDER
oBrw:aCols[ 1 ]:AddBitmap( { FWDArrow(), FwRArrow(), "c:\fwh\bitmaps\16x16\new2.bmp" } )
oBrw:nStretchCol := 1
oBrw:CreateFromCode()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
oTree:End()
return nil
static function MakeTree
field ID,PARENT,BEZ
local oTree, n
USE CATG NEW SHARED
INDEX ON STR(PARENT,1)+STR(ID,2) TAG PARID TO TMP MEMORY
GO TOP
TREE oTree
do while ! eof()
n := PARENT
TREEITEM "Parent - " + Str( n, 1 )
TREE
do while PARENT == n .and. ! eof()
TREEITEM BEZ
SKIP
enddo
ENDTREE
enddo
ENDTREE
oTree:OpenAll()
return oTree
static function CreateTestDBF
local aCols := { { "ID", 'N', 3, 0 }, { "Parent", 'N', 3, 0 }, { "Bez", 'C', 30, 0 } }
local aData := { ;
{ 1,0 , "Neu" }, ;
{ 2,0 , "OK Kat1"}, ;
{ 3,0 , "OK Marken"}, ;
{ 4,0 , "OK Kat3"}, ;
{ 5,3 , "UK Ford"}, ;
{ 6,3 , "UK Opel"}, ;
{ 7,3 , "UK VW"}, ;
{ 8,3 , "UK Porsche"}, ;
{ 9,3 , "OUK Gel„ndewagen"}, ;
{ 10,9, "UUK Q7"}, ;
{ 11,9, "UUK Kuga" }, ;
{ 12,9, "UUK Tucson"}, ;
{ 13,9, "UUK Sorento"}, ;
{ 14,0, "OK Kat4"} }
DBCREATE( "CATG", aCols, "DBFCDX", .t., "CTG" )
FW_ArrayToDBF( aData )
CLOSE CTG
return nil
AntoninoP wrote:This is cool!
If someone want show 2 columns, ID and Bez,
how the code becomes ?
Regards,
Perry
Code: Select all
#include "fivewin.ch"
#include "xbrowse.ch"
REQUEST DBFCDX
function main()
local oDlg, oFont, oBrw
local oTree
CreateTestDBF()
oTree := MakeTree()
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 350,500 PIXEL FONT oFont
@ 10,10 XBROWSE oBrw SIZE -10,-10 PIXEL OF oDlg ;
DATASOURCE oTree COLUMNS 1 ;
HEADERS "ID", "BEZ" ;
COLSIZES 100 ;
CELL LINES NOBORDER
oBrw:aCols[ 1 ]:AddBitmap( { FWDArrow(), FwRArrow(), "c:\fwh\bitmaps\16x16\new2.bmp" } )
oBrw:nStretchCol := 2
oBrw:bClrStd := { || { CLR_BLACK, If( oBrw:oTreeItem:nLevel == 1, CLR_YELLOW, CLR_WHITE ) } }
oBrw:CreateFromCode()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
oTree:End()
return nil
static function MakeTree
field ID,PARENT,BEZ
local oTree, n
USE CATG NEW SHARED
INDEX ON STR(PARENT,1)+STR(ID,2) TAG PARID TO TMP MEMORY
GO TOP
TREE oTree
do while ! eof()
n := PARENT
TREEITEM Str( n, 1 ) CARGO { "Parent - " + Str( n, 1 ) }
TREE
do while PARENT == n .and. ! eof()
TREEITEM STR(ID,2) CARGO { BEZ }
SKIP
enddo
ENDTREE
enddo
ENDTREE
oTree:OpenAll()
return oTree
static function CreateTestDBF
local aCols := { { "ID", 'N', 3, 0 }, { "Parent", 'N', 3, 0 }, { "Bez", 'C', 30, 0 } }
local aData := { ;
{ 1,0 , "Neu" }, ;
{ 2,0 , "OK Kat1"}, ;
{ 3,0 , "OK Marken"}, ;
{ 4,0 , "OK Kat3"}, ;
{ 5,3 , "UK Ford"}, ;
{ 6,3 , "UK Opel"}, ;
{ 7,3 , "UK VW"}, ;
{ 8,3 , "UK Porsche"}, ;
{ 9,3 , "OUK Gel„ndewagen"}, ;
{ 10,9, "UUK Q7"}, ;
{ 11,9, "UUK Kuga" }, ;
{ 12,9, "UUK Tucson"}, ;
{ 13,9, "UUK Sorento"}, ;
{ 14,0, "OK Kat4"} }
DBCREATE( "CATG", aCols, "DBFCDX", .t., "CTG" )
FW_ArrayToDBF( aData )
CLOSE CTG
return nil
Code: Select all
// -----------------------------------------------------------------------------------------------
FUNCTION BuildXbTree( oCon)
// -----------------------------------------------------------------------------------------------
LOCAL oTree := NIL
LOCAL aRows := NIL
LOCAL oRs
LOCAL cSql := 'SELECT * FROM OSKAT'
oRs := TRecSet():New()
oRs :Open( cSql, oCon )
if oRs :Used()
IF oRs:RecordCount() > 0
aRows := oRs:GetRows()
//oTree := GenSubTree(aRows,0,0,-1)
oTree := GenSubTree(aRows,NIL,0,-1)
ENDIF
endif
return oTree
// -----------------------------------------------------------------------------------------------
STATIC FUNCTION GenSubTree( aRows, cSuchId, nAktLevel, nLastLevel)
// -----------------------------------------------------------------------------------------------
local oTree, oItem
LOCAL cBez := ""
LOCAL aRow := NIL
LOCAL nItems := 0
//altd()
IF len(aRows )> 0
FOR each aRow in aRows
cBez := aRow[5]
if aRow[2] == cSuchId
if nAktLevel > nLastLevel
TREE oTree
ENDIF
TREEITEM oItem PROMPT aRow[5]
oItem:Cargo := { space(30) , space(30), space(30) }
if nAktLevel > nLastLevel
nLastLevel := nAktLevel
endif
nAktLevel++
GenSubTree( aRows, aRow[1], nAktLevel, nLastLevel )
nAktLevel--
endif
NEXT
if nAktLevel == nLastLevel
ENDTREE
ENDIF
endif
return oTree