Problema de recursos con TreeBegin-TreEnd()

[MarioG]

Estimados:
Tengo una aplicacion, bastante viejita. En la misma tomo datos de la Dbf y contruyo un Tree de 2 niveles.
Ahora, con el tiempo, a uno de mis clientes le pasa que su Dbf creció, aunque no tanto, aunque al intentar agregar o quitar un Item la PC, bajo Win98SE, se queda sin recursos luego de re construir el Tree (la imagen se vuelve tipo 16 colores)
El código lo plantee así:

Code: Select all  Expand view

   // Construir arbol
   bArbol:= {|| if( Empty(oTree),, oTree:= nil ), ;
                CursorWait()                    , ;
                oTree:= TreeBegin(,)            , ;
                dbEval({|| cClaEnt:= Cuentas->Cla_Bn, ;
                           _TreeItem( " "+Cuentas->Nombre,,,oVP:cDirBmp+"\Entidad.bmp",oVP:cDirBmp+"\AbrirEnt.bmp",.F.), ;
                           aArrCtas:= Cuentas->ArrCtas, ;
                           TreeBegin(,)               , ;
                           aEval( aArrCtas, {|a| _TreeItem( " ["+cClaEnt+"]  "+a[xNomSbCta] ;
                                                            ,,,oVP:cDirBmp+"\AbrirCta.bmp",,.F.) } ), ;
                           TreeEnd() } ), ;
                SysRefresh(), ;           
                TreeEnd()   , ;
                CursorArrow() }

   MsgRun ("Construyendo Arbol de Entidades...", "Aguarde...", bArbol)

   REDEFINE LISTBOX oLbxTree FIELDS    ;
            ID BRW_CTAS OF oDlg        ;
            FONT oFnt1 UPDATE          ;
            COLOR CLR_BLACK, CLR_WHITE ;
            HEADER "",""," E n t i d a d e s ¬ C u e n t a s" ;

   oLbxTree:SetTree( oTree )
   oLbxTree:nClrForeFocus:= CLR_WHITE
   oLbxTree:nClrBackFocus:= CLR_TREEFRED

   bDblkCta:= {|nRow, nCol| if( oLbxTree:Cargo:nLevel == NIVEL_ENT, ;
                                ( oLbxTree:SetFocus()    , ;
                                  oLbxTree:Cargo:Toggle(), ;
                                  oLbxTree:GoDown()      , ;
                                  oLbxTree:SetFocus()    , ;
                                  oLbxTree:Refresh() )   , ;
                                ( oWnd:Minimize()        , ;
                                  byr_PLAN( oLbxTree, oWnd ) ) ) }

   oLbxTree:blDblClick:= bDblkCta
   oLbxTree:bRClicked:= {|nRow, nCol| fMenuPop( nRow,nCol ) }
   oWnd:bGotFocus:= {|| if( Used(), aoDbf[dbCTA]:SetFocus(), fAbreDbf(dbCTA, TRUE, FALSE) ), ;
                        aoDbf[dbCTA]:SetOrder("CTA_NOMBRE"), ;
                        oWnd:Restore(), oLbxTree:SetFocus() }




Esto está en un Dlg. Luego cuando Agrego o Borro un item (Entidad o Cuenta), hago lo siguiente:

Code: Select all  Expand view

   bRebuild:=  {|| MsgRun ("Reconstruyendo  Arbol de Entidades...", "Aguarde...", bArbol), ;
                   oLbxTree:SetTree( oTree ),   ;
                   oLbxTree:SetFocus(),         ;
                   oLbxTree:Refresh(),          ;
                   oLbxTree:blDblClick:= bDblKCta }


Y aquí es donde se queda sin recursos. Sin dudas que siempre existió el error, que no fue notorio porque procesaba pocos registros o bien porque la App se corre en una PC con XP.
Alguna idea de como solucionarlo?

muchas gracias, saludos

[/code]

[Antonio Linares]

Mario,

Añade esta función a source\classes\trees.prg:

Code: Select all  Expand view

function TreeFree()

   if hBmpOpen != nil
      PalBmpFree( hBmpOpen )
      hBmpOpen = nil
   endif
   
   if hBmpClose != nil
      PalBmpFree( hBmpClose )
      hBmpClose = nil
   endif
     
return nil


Y añade la llamada a esa función al final del método End() de la Clase TLinkList.

Importante: Antes de construir el tree nuevamente, llama a oTree:End()

[MarioG]

Antonio; muhas gracias.
He realizado los cambios. Ahora ya no pierde recursos; aunque afecta al proceso de reeconstruir el arbol. Los íconos [+] y el de rama abierta son reemplzados por uno de los bmp que uso. Por favor miralo en el adjunto

http://hyperupload.com/download/0233d3d790/Tree.zip.html

El código TListLink quedó así:

Code: Select all  Expand view

METHOD End() CLASS TLinkList

   local oItem := ::oFirst
   local aBmps, n

   while oItem != nil
      oItem:End()
      oItem = If( oItem:oTree != nil, oItem:oTree:oFirst, oItem:oNext )
   end

   aBmps = GetTreeBmps()
   if ValType( aBmps ) == "A"
      for n = 1 to Len( aBmps )
         DeleteObject( aBmps[ n ] )
      next
   endif
   
   TreeFree()
   
return nil


Mi código:

Code: Select all  Expand view

bArbol:= {|| if( Empty(oTree),, oTree:End() ), ;
                CursorWait()                    , ;
                oTree:= TreeBegin(,)            , ;
                dbEval({|| cClaEnt:= Cuentas->Cla_Bn, ;
                           _TreeItem( " "+Cuentas->Nombre,,,oVP:cDirBmp+"\Entidad.bmp",oVP:cDirBmp+"\AbrirEnt.bmp",.F.), ;
                           aArrCtas:= Cuentas->ArrCtas, ;
                           TreeBegin(,)               , ;
                           aEval( aArrCtas, {|a| _TreeItem( " ["+cClaEnt+"]  "+a[xNomSbCta] ;
                                                            ,,,oVP:cDirBmp+"\AbrirCta.bmp",,.F.) } ), ;
                           SysRefresh() , ;                                                           
                           TreeEnd() } ), ;
                TreeEnd(), ;
                CursorArrow() }


[Antonio Linares]

Mario,

Modifica la función GetTreeBmps() en la Clase TTreeItem (source\classes\treeitem.prg) de la siguiente forma:

Code: Select all  Expand view

function GetTreeBmps()

   local aTemp := aLines
   
   aLines = nil

return aTemp


[MarioG]

Funciona Ok!
gracias por tu tiempo

Saludos

[Antonio Linares]

Mario,

Bien!