FiveTech Support Forums

#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 " + ::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

 @ 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

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