Construyendo dinamicamente árbol con la jerarquía de Clases

[Antonio Linares]

Un primer intento de construir dinamicamente un árbol con la jerarquia de Classes usadas en una aplicación

classtree.prg

Code: Select all  Expand view

#include "FiveWin.ch"

static aClasses := {}

function Main()

   local oWnd

   DEFINE WINDOW oWnd TITLE "Classes hierarchy"

   ACTIVATE WINDOW oWnd ;
      ON INIT BuildClassesTree( oWnd )

return nil

function BuildClassesTree( oWnd )

   local n := 1, oClass, oTree, oItem, oChild

   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

   oTree = TTreeView():New( 1, 1, oWnd )
   oTree:nWidth = 152
   // oTree:SetImageList( oImageList )
   // oTree:Add( "Files" )
   for each oClass in aClasses
     if Empty( oClass:cSuper )
        oItem = oTree:Add( oClass:cName )
        for each oChild in oClass:aChilds
           oItem:Add( oChild:cName )
        next
     endif
   next

   oTree:Expand()

return nil

CLASS TClass

   DATA   cName
   DATA   cSuper
   DATA   aChilds INIT {}

   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 := &( ::cName + "()" )

   for each oClass in aClasses
      try
         if oInstance:IsDerivedFrom( oClass:cName ) .and. ::cName != oClass:cName
            ::cSuper = oClass:cName
         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()

[Antonio Linares]

Una versión mejorada

ClassTree.prg

Code: Select all  Expand view

#include "FiveWin.ch"

static aClasses := {}

function Main()

   local oWnd, o := TDialog()

   DEFINE WINDOW oWnd TITLE "Classes hierarchy"

   ACTIVATE WINDOW oWnd ;
      ON INIT BuildClassesTree( oWnd )

return nil

function BuildClassesTree( oWnd )

   local oTree := TTreeView():New( 1, 1, oWnd )
   local oClass

   oTree:nWidth = 200
   oWnd:oLeft = oTree

   // oTree:SetImageList( oImageList )

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

   oTree:Expand()

return nil

function AddChilds( oItem, aChilds )

   local oChild, oSubItem

   for each oChild in aChilds
      oSubItem = oItem:Add( oChild:cName )
      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 {}

   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 := &( ::cName + "()" )

   for each oClass in aClasses
      try
         if oInstance:IsDerivedFrom( oClass:cName ) .and. ::cName != oClass:cName
            ::cSuper = oClass:cName
         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()

[lucasdebeltran]

Antonio,

Muchas gracias.

¿Y este ejemplo podría convertirse en otro para detectar recursos no liberados en las clases o en las funciones de la aplicación?.

Salu2

[Antonio Linares]

Lucas,

FiveWIn ya proporciona funciones para detectar cualquier recurso no liberado, creado desde las propias clases de FiveWin ó construidos por el programador. De todas formas los recursos no tienen una organización jerárquica, luego no veo un paralelismo entre lo que comentas y el ejemplo que estamos viendo.

[Antonio Linares]

Esta imagen es de 1991 y pertenece a Actor (c) Whitewater Group, adquirido posteriormente y abandonado por Symantec:

http://en.wikipedia.org/wiki/Actor_(programming_language)

Veamos cuanto poder aproximar nuestro ejemplo a este browser

[Antonio Linares]

A propósito, poseo una copia original de Actor, con los manuales etc, pero no vienen incluidos los fuentes de las Classes.

Alguno de vosotros tiene una copia de Actor con fuentes ?

[karinha]

Maestro, esto te sirve?

http://www.koders.com/cpp/fid7BDFFA087D ... x?s=opengl

[Antonio Linares]

Joao,

No, gracias por el intento.

Esto es lo más próximo que he encontrado:

http://biphome.spray.se/mikael_aronsson/index_ac.html

The goal with this project is to produce as full 32 bit implementation of the Actor language and class library for Win32

[Antonio Linares]

Versión mejorada:

ClassTree.prg

Code: Select all  Expand view

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

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

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

function Main()

   local oWnd, o := TDialog()

   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"
   ENDMENU

return oMenu

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

function BuildClassesTree( oWnd )

   local oTree := TTreeView():New( 0, 0, oWnd )
   local oClass, cData, cMethod

   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 := &( ::cName + "()" )

   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
         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()