Tree

[Natter]

Hi all !

How to make the opening of the branches was followed by prompting for a password ?

[Antonio Linares]

Nater,

Several changes are required in Class TTreeView. Here I copy the entire class with the changes and a example of use:

Please notice this code in my example:
oTree:bExpanded = { | hItem | MsgInfo( oTree:GetItem( hItem ):cPrompt ) }

ttreevie.prg

Code: Select all  Expand view

// Win32 TreeView support

#include "FiveWin.ch"
#include "Constant.ch"

#define TVN_FIRST                -400
#define TVN_ITEMEXPANDED        (TVN_FIRST-6)

#define COLOR_WINDOW         5
#define COLOR_WINDOWTEXT     8
#define COLOR_BTNFACE       15
#define COLOR_BTNSHADOW     16
#define COLOR_BTNHIGHLIGHT  20

#define FD_BORDER            8
#define FD_HEIGHT           22

#define DT_CENTER            1
#define DT_VCENTER           4

#define WINDING              2
#define SC_KEYMENU       61696 //  0xF100

#define TVS_HASBUTTONS       1
#define TVS_HASLINES         2
#define TVS_LINESATROOT      4
#define TVS_SHOWSELALWAYS   32 //  0x0020
#define TVS_DISABLEDRAGDROP 16 //  0x0010
#define TVS_CHECKBOXES     256 //  0x0100

#define CTRL_NAME "SysTreeView32"

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

CLASS TTreeView FROM TControl

   DATA   aItems
   DATA   oImageList
   DATA   bChanged
   DATA   bExpanded
   
   CLASSDATA aProperties ;
      INIT { "aItems", "cTitle", "cVarName", "l3D", "nClrText",;
             "nClrPane", "nAlign", "nTop", "nLeft",;
             "nWidth", "nHeight", "oFont", "Cargo" }

   METHOD New( nTop, nLeft, oWnd, nClrFore,;
               nClrBack, lPixel, lDesign, nWidth, nHeight,;
               cMsg, lCheckBoxes, bChange ) CONSTRUCTOR

   METHOD ReDefine( nId, oWnd, nClrFore, nClrBack, lDesign, cMsg ) CONSTRUCTOR

   METHOD Add( cPrompt, nImage, nValue )

   METHOD VScroll( nWParam, nLParam ) VIRTUAL   // standard behavior requested

   METHOD HScroll( nWParam, nLParam ) VIRTUAL

   METHOD CollapseAll( oItem ) INLINE ScanItems( ::aItems, .f. ),;
      oItem := ::GetSelected(), if( oItem <> nil, oItem:MakeVisible(), nil )

   METHOD CollapseBranch( oItem ) INLINE ;
      If( oItem == nil, oItem := ::GetSelected(),), ;
      If( oItem != nil, ( oItem:Collapse(), ScanItems( oItem:aItems, .f. ), oItem:MakeVisible() ),)

   METHOD Expand() INLINE AEval( ::aItems, { | oItem | oItem:Expand() } )

   METHOD ExpandAll( oItem ) INLINE ScanItems( ::aItems, .t. ),;
      oItem := ::GetSelected(), if( oItem <> nil, oItem:MakeVisible(), nil )

   METHOD ExpandBranch( oItem ) INLINE ;
      If( oItem == nil, oItem := ::GetSelected(), nil ), ;
      If( oItem != nil, ( oItem:Expand(), ScanItems( oItem:aItems, .t. ), oItem:MakeVisible() ), nil )
     
   METHOD GetSelected()
   METHOD GetItem( hItem )

   METHOD Select( oItem ) INLINE TVSelect( ::hWnd, oItem:hItem )

   METHOD GetSelText() INLINE TVGetSelText( ::hWnd )

   METHOD GoTop() INLINE If( Len( ::aItems ) > 0, ::Select( ::aItems[ 1 ] ),)

   METHOD SelChanged() INLINE If( ::bChanged != nil, Eval( ::bChanged, Self ), nil )

   METHOD SetImageList( oImageList )

   METHOD DeleteAll() INLINE ( TVDelAllItems( ::hWnd ), ::aItems := {} )

   METHOD HitTest( nRow, nCol )
   
   METHOD HandleEvent( nMsg, nWParam, nLParam )

   METHOD Initiate( hDlg ) INLINE ::Super:Initiate( hDlg ), ::SetColor( ::nClrText, ::nClrPane )
   
   METHOD cToChar() INLINE ::Super:cToChar( CTRL_NAME )
   
   METHOD SetColor( nClrText, nClrPane ) INLINE ;
      ::Super:SetColor( nClrText, nClrPane ), TVSetColor( ::hWnd, nClrText, nClrPane )

   METHOD Toggle() INLINE AEval( ::aItems, { | oItem | oItem:Toggle() } )

   METHOD ToggleAll( oItem ) INLINE ScanItems( ::aItems, , .t. ), ;
      oItem := ::GetSelected(), If( oItem <> nil, oItem:MakeVisible(), nil )

   METHOD ToggleBranch( oItem ) INLINE ;
      If( oItem == nil, oItem := ::GetSelected(), nil ), ;
      If( oItem != nil, ( oItem:Toggle(), ScanItems( oItem:aItems, , .t. ), oItem:MakeVisible() ), nil )

   METHOD GetCheck( oItem ) INLINE ;
      If( oItem == nil, oItem := ::GetSelected(), nil ), ;
      TVGetCheck( ::hWnd, oItem:hItem )

   METHOD SetCheck( oItem, lOnOff ) INLINE ;
      If( oItem == nil, oItem := ::GetSelected(), nil ), ;
      TVSetCheck( ::hWnd, oItem:hItem, lOnOff )

   METHOD SetItems( aItems )
   
   METHOD GenMenu( lPopup )
   
   METHOD LoadFromMenu( oMenu )
   
   METHOD Notify( nIdCtrl, nPtrNMHDR )

ENDCLASS

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

METHOD LoadFromMenu( oMenu ) CLASS TTreeView

   local n
   
   ::DeleteAll()
   
   for n = 1 to Len( oMenu:aItems )
      ::Add( oMenu:aItems[ n ]:cPrompt )
      if ValType( oMenu:aItems[ n ]:bAction ) == "O"
         AddSubItems( ATail( ::aItems ), oMenu:aItems[ n ]:bAction )
      endif      
   next
   
return nil      

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

static function AddSubItems( oItem, oSubMenu )

   local n
   
   for n = 1 to Len( oSubMenu:aItems )
      oItem:Add( oSubMenu:aItems[ n ]:cPrompt )
      if ValType( oSubMenu:aItems[ n ]:bAction ) == "O"
         AddSubItems( ATail( oItem:aItems ), oSubMenu:aItems[ n ]:bAction )
      endif      
   next
   
return nil      

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

METHOD New( nTop, nLeft, oWnd, nClrFore,;
            nClrBack, lPixel, lDesign, nWidth, nHeight, cMsg, lCheckBoxes, bChange ) CLASS TTreeView

   DEFAULT nTop        := 0, nLeft := 0,;
           oWnd        := GetWndDefault(),;
           nClrFore    := oWnd:nClrText,;
           nClrBack    := GetSysColor( COLOR_WINDOW ),;
           lPixel      := .f.,;
           lDesign     := .f.,;
           nWidth      := 150, nHeight := 150,;
           lCheckBoxes := .F.

   ::nStyle    = nOR( WS_CHILD, WS_VISIBLE, CS_VREDRAW, CS_HREDRAW,;
                      If( lDesign, WS_CLIPSIBLINGS, 0 ), WS_TABSTOP,;
                      TVS_HASBUTTONS, TVS_HASLINES, TVS_LINESATROOT, TVS_SHOWSELALWAYS, TVS_DISABLEDRAGDROP,;
                      If( lCheckBoxes, TVS_CHECKBOXES, 0 ) )

   ::nId       = ::GetNewId()
   ::oWnd      = oWnd
   ::cMsg      = cMsg
   ::nTop      = If( lPixel, nTop, nTop * SAY_CHARPIX_H )
   ::nLeft     = If( lPixel, nLeft, nLeft * SAY_CHARPIX_W )
   ::nBottom   = ::nTop + nHeight - 1
   ::nRight    = ::nLeft + nWidth - 1
   ::lDrag     = lDesign
   ::lCaptured = .f.
   ::nClrText  = nClrFore
   ::nClrPane  = nClrBack
   ::aItems    = {}
   ::bChanged  = bChange

   if ! Empty( oWnd:hWnd )
      ::Create( CTRL_NAME )
      oWnd:AddControl( Self )
      ::SetColor( nClrFore, nClrBack )
   else
      oWnd:DefControl( Self )
   endif

   ::Default()
   ::lDrag = lDesign

   if lDesign
      ::CheckDots()
   endif

return Self

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

METHOD ReDefine( nId, oWnd, nClrFore, nClrBack, lDesign, cMsg ) CLASS TTreeView

   DEFAULT oWnd     := GetWndDefault(),;
           nClrFore := oWnd:nClrText,;
           nClrBack := oWnd:nClrPane,; // GetSysColor( COLOR_WINDOW ),;
           lDesign  := .f.

   ::nId     = nId
   ::oWnd    = oWnd
   ::aItems  = {}
   ::nClrText = nClrFore
   ::nClrPane = nClrBack

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW, TVS_HASBUTTONS, TVS_HASLINES, TVS_LINESATROOT ) )

   oWnd:DefControl( Self )

return Self

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

METHOD Add( cPrompt, nImage, nValue ) CLASS TTreeView

   local oItem

   oItem := TTVItem():New( TVInsertItem( ::hWnd, cPrompt,, nImage, nValue ), Self )

   oItem:cPrompt := cPrompt
   oItem:nImage  := nImage

   AAdd( ::aItems, oItem )

return oItem

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

static function ScanItems( aItems, lExpand, lToggle )

   local oItem, i

   DEFAULT lExpand := .t., lToggle := .f.

   for i := 1 to Len( aItems )
       oItem = aItems[ i ]

       if lToggle
          oItem:Toggle()
       elseif lExpand
          oItem:Expand()
       else
          oItem:Collapse()
       endif

       if Len( oItem:aItems ) != 0
          ScanItems( oItem:aItems, lExpand, lToggle )
       endif
   next

return nil

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

METHOD GenMenu( lPopup ) CLASS TTreeView

   local oMenu
   
   DEFAULT lPopup := .T.
   
   if Len( ::aItems ) > 0
      if lPopup
         MENU oMenu POPUP
      else  
         MENU oMenu
      endif  
      GenMenuItems( ::aItems )  
      ENDMENU
   endif
   
return oMenu        

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

static function GenMenuItems( aItems )

   local n
   
   for n = 1 to Len( aItems )
      MENUITEM aItems[ n ]:GetText()
      if Len( aItems[ n ]:aItems ) > 0
         MENU
            GenMenuItems( aItems[ n ]:aItems )
         ENDMENU
      endif  
   next
   
return nil        

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

METHOD GetSelected() CLASS TTreeView

return SearchItem( ::aItems, TVGetSelected( ::hWnd ) )

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

METHOD GetItem( hItem ) CLASS TTreeView

return SearchItem( ::aItems, hItem )

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

METHOD HitTest( nRow, nCol ) CLASS TTreeView

   local hItem

   hItem := TVHitTest( ::hWnd, nRow, nCol )

   If hItem > 0
      return ::GetItem( hItem )
   Endif

return nil

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

METHOD Notify( nIdCtrl, nPtrNMHDR ) CLASS TTreeView

   local nCode := GetNMHDRCode( nPtrNMHDR )

   do case
      case nCode == TVN_ITEMEXPANDED
           if ! Empty( ::bExpanded )
              if NMTREEVIEWAction( nPtrNMHDR ) == 2 // Expanded
                 Eval( ::bExpanded, NMTREEVIEWItemNew( nPtrNMHDR ) ) // hItem
              endif
           endif
     
   endcase
   
return nil      

//----------------------------------------------------------------------------//
   
METHOD SetImageList( oImageList ) CLASS TTreeView

   ::oImageList = oImageList

   TVSetImageList( ::hWnd, oImageList:hImageList, 0 )

return nil

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

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TTreeView

   local oItem

   do case
      case nMsg == WM_CHAR
           if nWParam == VK_RETURN
              return 1
           endif
   endcase
   
return ::Super:HandleEvent( nMsg, nWParam, nLParam )              

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

METHOD SetItems( aItems ) CLASS TTreeView

   local n
   
   for n = 1 to Len( aItems )
      ::Add( aItems[ n ] )
   next
   
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

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

Code: Select all  Expand view

HB_FUNC( NMTREEVIEWITEMNEW )
{
     #ifndef _WIN64
      NMTREEVIEW * pNMHDR = ( NMTREEVIEW * ) hb_parnl( 1 );
   #else  
      NMTREEVIEW * pNMHDR = ( NMTREEVIEW * ) hb_parnll( 1 );
   #endif
   
   #ifndef _WIN64
      hb_retnl( ( LONG ) pNMHDR->itemNew.hItem );
   #else
      hb_retnll( ( LONGLONG ) pNMHDR->itemNew.hItem );
   #endif
}

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(), 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"
   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 ) }
   oTree:bExpanded = { | hItem | MsgInfo( oTree:GetItem( hItem ):cPrompt ) }

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

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

[Natter]

Antonio, thank You very much !