Searching a record on a Tree class

[Silvio.Falconi]

I wish search a record into tree class

@ 1,10 GET oGet VAR cGet OF oDlg SIZE 100, 10 PICTURE "@!"

....

if ! FR->(DbSeek( cGet, .t. ))
msgAlert( i18n( "Not found." ) )
FR->(DbGoTo(nRecno))
else
FR->( DbSetOrder(1) )
nIndex := FR->(OrdKeyNo())

On Tree of Goran I made in this mode:

oTree:SetCurSel( nIndex - 1 )
oTree:UpdateTV()
oLink := oTree:GetLinkAt( oTree:GetCursel() )
xFrCargo := oLink:Cargo
xFrTipo := oLink:TreeItem:cPrompt

How I can converte it on Fwh tree class ?

[Antonio Linares]

Silvio,

Try this:

oTree:Select( oTree:aItems[ 1 ] )
MsgInfo( oTree:GetSelected():cPrompt )

[Silvio.Falconi]

this give me the first item
I wish search a item
I have the number od record and the otree must go to this record then I can see the cprompt

[Antonio Linares]

Silvio,

I have modified FWH samples/classtree.prg to search for an item when you click on the window menu:

Code: Select all  Expand view  RUN

#include "FiveWin.ch"
#include "Splitter.ch"

static oTree, aClasses := {}, oSplit1, oSplit2, oLbxDatas, oLbxMethods

//----------------------------------------------------------------------------//

function Main()

   local oWnd, o := TDialog(), x := TObject()

   DEFINE WINDOW oWnd TITLE "Classes hierarchy" ;
      MENU BuildMenu()

   ACTIVATE WINDOW oWnd ;
      ON INIT BuildClassesTree( oWnd ) ;
      ON RESIZE ( If( oSplit1 != nil, oSplit1:AdjLeft(),),;
                  If( oSplit2 != nil, oSplit2:AdjRight(),) )

return nil

//----------------------------------------------------------------------------//

function BuildMenu()

   local oMenu

   MENU oMenu
      MENUITEM "About" ACTION SearchItem( oTree:aItems, "TWINDOW" )
   ENDMENU

return oMenu

//----------------------------------------------------------------------------//

function BuildClassesTree( oWnd )

   local oClass, cData, cMethod

   oTree = TTreeView():New( 0, 0, oWnd )
 
   oTree:nWidth = 180
   // oTree:SetImageList( oImageList )

   oTree:Expand()

   @ 0, 186 LISTBOX oLbxDatas VAR cData ITEMS { "one", "two", "three" } ;
      SIZE 200, 200 PIXEL OF oWnd

   @ 0, 391 LISTBOX oLbxMethods VAR cMethod ITEMS { "one", "two", "three" } ;
      SIZE 200, 200 PIXEL OF oWnd

   @ 0, 181 SPLITTER oSplit1 ;
      VERTICAL ;
      PREVIOUS CONTROLS oTree ;
      HINDS CONTROLS oLbxDatas ;
      LEFT MARGIN 150 ;  
      RIGHT MARGIN oSplit2:nLast + 100 ;
      SIZE 4, 300  PIXEL ;
      OF oWnd STYLE

   @ 0, 386 SPLITTER oSplit2 ;
      VERTICAL ;
      PREVIOUS CONTROLS oLbxDatas ;
      HINDS CONTROLS oLbxMethods ;
      LEFT MARGIN oSplit1:nFirst + 120 ;
      RIGHT MARGIN 80 ;
      SIZE 4, 300 PIXEL ;
      OF oWnd STYLE

   GetClasses()
 
   for each oClass in aClasses
     if Empty( oClass:cSuper )
        AddChilds( oTree:Add( oClass:cName ), oClass:aChilds )
     endif
   next

   oTree:bChanged = { || ShowClassInfo( oTree ) }

return nil

//----------------------------------------------------------------------------//

function ShowClassInfo( oTree )

   local oItem := oTree:GetSelected()

   if oItem != nil .and. oItem:Cargo != nil
      oLbxDatas:SetItems( oItem:Cargo:aDatas )
      oLbxMethods:SetItems( oItem:Cargo:aMethods )
   else
      oLbxDatas:SetItems( {} )
      oLbxMethods:SetItems( {} )
   endif

return nil

//----------------------------------------------------------------------------//

function AddChilds( oItem, aChilds )

   local oChild, oSubItem

   for each oChild in aChilds
      oSubItem = oItem:Add( oChild:cName )
      oSubItem:Cargo = oChild      
      AddChilds( oSubItem, oChild:aChilds )
   next

return nil

//----------------------------------------------------------------------------//

function GetClasses()

   local n := 1, oClass

   while ! Empty( __ClassName( n ) )
      AAdd( aClasses, TClass():New( __ClassName( n++ ) ) )
   end

   for each oClass in aClasses
      oClass:GetSuper()
   next

   for each oClass in aClasses
      oClass:GetChilds()
   next

return nil

//----------------------------------------------------------------------------//

CLASS TClass

   DATA   cName
   DATA   cSuper
   DATA   aChilds INIT {}
   DATA   aDatas
   DATA   aMethods

   METHOD New( cName )

   METHOD GetSuper()

   METHOD GetChilds()

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( cName ) CLASS TClass

   ::cName  = cName
   ::cSuper = ""

return Self

//----------------------------------------------------------------------------//

METHOD GetSuper() CLASS TClass

   local oClass, oInstance
     
   try
      oInstance := &( ::cName + "()" )
   end  
     
   if ! hb_IsObject( oInstance )
      return nil
   endif      
     
   if ::aDatas == nil
      ::aDatas   = __objGetMsgList( oInstance, .T. )
      ::aMethods = __objGetMsgList( oInstance, .F. )
   endif

   for each oClass in aClasses
      try
         if oInstance:IsDerivedFrom( oClass:cName ) .and. ::cName != oClass:cName
            ::cSuper = oClass:cName
         // else
         //    MsgInfo( oClass:cName + "is not child of " + ::Super:ClassName() )  
         endif
      end
   next

return nil

//----------------------------------------------------------------------------//

METHOD GetChilds() CLASS TClass

   local oClass

   for each oClass in aClasses
      if oClass:cSuper == ::cName
         AAdd( ::aChilds, oClass )
      endif
   next

return nil

//----------------------------------------------------------------------------//

function Error()

return ErrorNew()

//----------------------------------------------------------------------------//

CLASS TObject FROM HBObject  // To expose its datas and methods

ENDCLASS

//----------------------------------------------------------------------------//

function SearchItem( aItems, cClassName )

   local n
   
   for n = 1 to Len( aItems )
      if aItems[ n ]:cPrompt == cClassName
         oTree:Select( aItems[ n ] )
         oTree:SetFocus()
      else
         if ! Empty( aItems[ n ]:aItems )
            SearchItem( aItems[ n ]:aItems, cClassName )
         endif
      endif
   next
   
return nil              

[Silvio.Falconi]

C:\work\fwh\samples\classtree.prg(167) Error E0067 TRY section requires a CATCH or FINALLY handler
C:\work\fwh\samples\classtree.prg(185) Error E0067 TRY section requires a CATCH or FINALLY handler

[Silvio.Falconi]

On Goran tree there was a methos to go to position Getlinkat(npos)
But Ob fwh tree there is not this possibility ?
If I have a number of a record can go to a Item of Tree ?

[Antonio Linares]

Silvio,

C:\work\fwh\samples\classtree.prg(167) Error E0067 TRY section requires a CATCH or FINALLY handler
C:\work\fwh\samples\classtree.prg(185) Error E0067 TRY section requires a CATCH or FINALLY handler

With Harbour compiles fine. Anyhow, simply add a catch section on those lines.

[Antonio Linares]

Silvio,

On Goran tree there was a methos to go to position Getlinkat(npos)
But Ob fwh tree there is not this possibility ?
If I have a number of a record can go to a Item of Tree ?

In a Windows tree control the items are not stored all together. The tree has a DATA aItems where its items are placed, but each item also has a DATA aItems for subtrees. So you can not go to a "n" item unless you step through all of them as I do in the sample that I posted (function SearchItem())

[Silvio.Falconi]

ntonio,
Itried to use searchItem function But I not understood How

[Silvio.Falconi]

Any solution please ?

[Antonio Linares]

Silvio,

SearchItem() source code is quite easy. Please try to understand it

It searches for a text in all items, but the items are not all together. Each item has its own subitems. Thats why SearchItem() calls itself recursively.

[Silvio.Falconi]

Sorry Antonio,

FR->( DbSetOrder(2) )
FR->( DbGoTop() )
if ! FR->(DbSeek( cGet, .t. ))
msgAlert( i18n( "Non trovato." ) )
FR->(DbGoTo(nRecno))
else
? alltrim(FR->FrTipo) give me the text I'm searching
then I made
xprompt:=alltrim(FR->FrTipo)
SearchItem( oTree:aItems,xPrompt )

and here let me error on if aItems[ n ]:hItem == hItem

[Antonio Linares]

Silvio,

and here let me error on if aItems[ n ]:hItem == hItem

I don't use that code in my function SearchItem()

Please post your modified function SearchItem() source code

[Silvio.Falconi]

I not modified your function

the test.prg

Code: Select all  Expand view  RUN

 @ 50, 155 BUTTON oBBus PROMPT "&Cerca" ;
                                SIZE 48, 10 PIXEL OF oDlg ACTION FrBusca( oTree,,oDlg,, )



 function FrBusca( oTree, cChr,oParent, xFrCargo, xFrTipo )

   local nOrder   := FR->(OrdNumber())
   local nRecno   := FR->(Recno())
   local nIndex
   local oDlg, oGet, cPicture, oLink
   local aSay1    := { "Introdurre la categoria"   }
   local aSay2    := { "Categoria:" }
   local cGet     := space(30)
   local lSeek    := .f.
   local lFecha   := .f.

   Local  nBottom   := 7
   Local  nRight    := 50
   Local  nWidth :=  Max( nRight * DLG_CHARPIX_W, 180 )
   Local  nHeight := nBottom * DLG_CHARPIX_H


 DEFINE DIALOG oDlg OF oParent    ;
             TITLE i18n("Cerca una categoria") ;
             SIZE nWidth, nHeight PIXEL
             @ 0,10  SAY oSay1 PROMPT aSay1[nOrder]     OF oDlg
             @ 0.8,4 SAY oSay2 PROMPT aSay2[nOrder]     OF oDlg

      if cChr != nil

         cGet := cChr+SubStr(cGet,1,len(cGet)-1)

   endif

            @ 1,10 GET oGet VAR cGet   OF oDlg  SIZE 100, 10 PICTURE "@!"

    if cChr != nil
      oGet:bGotFocus := { || ( oGet:SetColor( CLR_BLACK, RGB(255,255,127) ), oGet:SetPos(2) ) }
   endif


       @ 1.8, 8 BUTTON oBtnYes PROMPT i18n( "&Conferma" ) ;
             SIZE 45, 10  OF oDlg ACTION (lSeek := .t., oDlg:End())
        @ 1.8, 19 BUTTON oBtnNo PROMPT i18n( "&Annulla" ) ;
             SIZE 45, 10  OF oDlg ACTION (lSeek := .f., oDlg:End())


         ACTIVATE DIALOG oDlg center


  if lSeek

         cGet := rtrim(Upper(cGet))


      FR->( DbSetOrder(2) )
      FR->( DbGoTop() )
      if ! FR->(DbSeek( cGet, .t. ))
         msgAlert( i18n( "Non trovato." ) )
         FR->(DbGoTo(nRecno))
      else
   xPrompt:= alltrim(FR->FrTipo)


  searchitem(oTree:aItems,xPrompt)





         endif
      FR->( DbSetOrder(1) )
   endif
   oTree:refresh()
 

return nil



   static function SearchItem( aItems, hItem )

       local n, oItem

       for n = 1 to Len( aItems )
          if Len( aItems[ n ]:aItems ) > 0
             if ( oItem := SearchItem( aItems[ n ]:aItems, hItem ) ) != nil
                return oItem
             endif
          endif
          if aItems[ n ]:hItem == hItem
             return aItems[ n ]
          endif
       next

    return nil



 

[Antonio Linares]

Silvio,

This is the right code for SearchItem():

Code: Select all  Expand view  RUN

function SearchItem( aItems, cClassName )

   local n
   
   for n = 1 to Len( aItems )
      if aItems[ n ]:cPrompt == cClassName
         oTree:Select( aItems[ n ] )
         oTree:SetFocus()
      else
         if ! Empty( aItems[ n ]:aItems )
            SearchItem( aItems[ n ]:aItems, cClassName )
         endif
      endif
   next
   
return nil