loForm = NEWOBJECT("tForm")
loForm.Show(1)

DEFINE CLASS tForm AS Form
ADD OBJECT Grd AS tGrid
PROCEDURE Load
    lcTestCursor = "CurTest"
    USE IN SELECT(lcTestCursor)
    CREATE CURSOR (lcTestCursor) ( ;
        nLft I, ;        && Обязательные поля - порядок обхода дерева.
        nRgt I, ;        &&                - ~ -
        nLev I, ;        && Обязательное поле - уровень вложенности элемента
        lExp L, ;        && Обязательное поле - флаг развернутости, свернутости элемента
        lVis L, ;        && Обязательное поле - расчетный индекс видимости элемента
        nIco I, ;        && Обязательное поле - № иконки (здесь отключено)
        Name C(80), ;    && Обязательное поле - текст в иерархической колонке
        Kod I, ;        && Уникальный идентификатор (используется для построения иерархии, дальше не нужен)
        KodPar I NULL)    && Идентификатор родителя (используется для построения иерархии, дальше не нужен)

    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (1, .NULL.)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (2, .NULL.)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (3, 1)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (4, 1)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (5, 3)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (6, 5)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (7, 5)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (8, 5)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (9, 2)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (10, 2)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (11, 10)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (12, 10)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (13, 2)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (14, 11)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (15, 11)
    INSERT INTO (lcTestCursor) (Kod, KodPar) VALUES (16, 15)
    BuildHierarhyIdx(.NULL., 0, 0, "Kod", "KodPar")
    REPLACE ALL lExp WITH .F., ;
                lVis WITH (nLev = 1)
*!*       REPLACE ALL lExp WITH .T., ;
*!*                   lVis WITH .T.
    LOCAL lcKey, lnLev
    lcKey = ""
    lnLev = 0
    SCAN    
        DO CASE
            CASE lnLev < nLev AND !ISNULL(KodPar)
                lcKey = lcKey + TRANSFORM(KodPar) + "."
            CASE lnLev > nLev AND !EMPTY(lcKey) 
                IF nLev > 1
                    lcKey = LEFT(lcKey, AT(".", lcKey, nLev - 1))
                ELSE
                    lcKey = ""
                ENDIF                
        ENDCASE
        lnLev = nLev
        REPLACE Name WITH lcKey + TRANSFORM(Kod)
    ENDSCAN    
    
    lcIndexFile = SYS(2015)
    INDEX ON nLft TAG nLft OF (lcIndexFile)
    INDEX ON lVis TAG lVis OF (lcIndexFile) ADDITIVE
    SET ORDER TO NLFT   && NLFT
    SET FILTER TO lVis
    GO TOP
ENDPROC && Load
PROCEDURE Init
    WITH ThisForm        
        .Resize()
    ENDWITH
ENDPROC && Init
PROCEDURE Grd.Init
    DODEFAULT()
    WITH This
        .ColumnCount = 2
        .RecordSource = "CurTest"
        .Column1.ControlSource = .RecordSource + ".Name"
        .Column2.ControlSource = .RecordSource + ".Name"
        .SetAll("Sparse", .F.)
        .SetAll("ReadOnly", .T.)
        .SetAll("Alignment", 1)
        .SetAll("Width", 150)
    ENDWITH
ENDPROC && Grd.Init
PROCEDURE Resize
    WITH ThisForm
        .Grd.Width = .Width
        .Grd.Height = .Height
    ENDWITH
ENDPROC && Resize
ENDDEFINE

DEFINE CLASS tGrid AS Grid
ADD OBJECT Column1 AS tCol
Tree_nMaxLevel = 30
PROCEDURE AfterRowColChange
    LPARAMETERS nColIndex
    IF m.nColIndex=1
        This.Refresh()
    ENDIF
    DODEFAULT(nColIndex)
ENDPROC && AfterRowColChange
PROCEDURE Tree_Expand
    LPARAMETERS tlExpand

    LOCAL lnSaveSelect, lnSaveRec, lcSaveFilter
    LOCAL lnLft, lnRgt
    LOCAL laExpand(1)
    WITH This    
        lnSaveSelect = SELECT()
        SELECT (.RecordSource)
        lnSaveRec = RECNO()
        lcSaveFilter = SET("Filter")    
        
        DIMENSION laExpand (.Tree_nMaxLevel)
        laExpand[nLev] = tlExpand
        REPLACE lExp WITH tlExpand
        lnLft = nLft + 1
        lnRgt = nRgt - 1
        
        IF !tlExpand
            REPLACE ALL lVis WITH .F. FOR BETWEEN(nLft, lnLft, lnRgt)
        ELSE
            SET FILTER TO
            SCAN FOR BETWEEN(nLft, lnLft, lnRgt)
                laExpand[nLev] = lExp AND laExpand[nLev - 1]
                REPLACE lVis WITH laExpand[nLev - 1]
            ENDSCAN
            SET FILTER TO &lcSaveFilter
        ENDIF
        
            
        IF lnSaveRec <= RECCOUNT()
            GOTO lnSaveRec
        ENDIF
        SELECT(lnSaveSelect)
        .SetFocus()
    ENDWITH
ENDPROC && Tree_Expand
PROCEDURE BindTxtKeyPress
    *-* (IGEL) Здесь у меня биндится поиск по ControlSource
    LPARAMETERS nKeyCode, nShiftAltCtrl
ENDPROC && BindTxtKeyPress
ENDDEFINE

DEFINE CLASS tCol AS Column
ADD OBJECT CntDrw AS tCnt
CurrentControl = "CntDrw"
DynamicCurrentControl="This.Column1.CntDrw.ItemShow(This.Column1.CurrentControl)"
ENDDEFINE

DEFINE CLASS tCnt AS Container
BorderWidth = 0
BackStyle = 0
ADD OBJECT Txt AS tTxt WITH Left = -100, Width = 20
ADD OBJECT Lbl AS tLbl
ADD OBJECT ImgExp AS tImg
cName        = ""
lExp        = .F.
lVis        = .F.
nIco        = 0
nLev        = 0
nLft        = 0
nRgt        = 0
RowHeight    = 0
PROCEDURE Init
    WITH This
        .Txt.Left = -100
    ENDWITH    
    *-* (IGEL) Эта процедура используется в гриде для поиска.
    BINDEVENT(This, "KeyPress", This.Parent.Parent, "BindTxtKeyPress")    
ENDPROC && Init
PROCEDURE ItemShow
    LPARAMETERS tcCurrentControl
    LOCAL lnHeight, lnLev
    WITH This
        lnLev                = .nLev
        lnHeight            = .RowHeight
        IF .nLft + 1 != .nRgt
            .ImgExp.Left        = (lnLev - 1) * lnHeight + (lnHeight - .ImgExp.Width) / 2
            .ImgExp.Top            = (lnHeight - .ImgExp.Height) / 2
            .ImgExp.Visible        = .T.
            *-* (IGEL) Здесь у меня картинки [+] и [-]
            .ImgExp.Picture        = IIF(.lExp, "tree_mn.bmp", "tree_pl.bmp")
            .ImgExp.Width        = 11
        ELSE
            .ImgExp.Visible        = .F.
        ENDIF
        .Lbl.Left        = lnLev * lnHeight 
        .Lbl.Top        = (lnHeight - .Lbl.Height) / 2
        .Lbl.Caption    = .cName    
        .Txt.Left        = - 100
        .Txt.Width        = 20
    ENDWITH
    RETURN (m.tcCurrentControl)
ENDPROC
PROCEDURE DblClick
    This.Parent.Parent.Tree_Expand(!This.lExp)
ENDPROC && DblClick
PROCEDURE cName_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".Name")
ENDPROC && cName_Access
PROCEDURE lExp_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".lExp")
ENDPROC && lExp_Access
PROCEDURE lVis_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".lVis")
ENDPROC && lVis_Access
PROCEDURE nIco_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".nIco")
ENDPROC && nIco_Access
PROCEDURE nLev_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".nLev")
ENDPROC && nLev_Access
PROCEDURE nLft_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".nLft")
ENDPROC && nLft_Access
PROCEDURE nRgt_Access
    RETURN EVALUATE(This.Parent.Parent.RecordSource + ".nRgt")
ENDPROC && nRgt_Access
PROCEDURE RowHeight_Access
    RETURN THIS.Parent.Parent.RowHeight
ENDPROC && RowHeight_Access
PROCEDURE KeyPress
    LPARAMETERS nKeyCode, nShiftAltCtrl
    * Это для BINDEVENT используется
ENDPROC && KeyPress
ENDDEFINE

DEFINE CLASS tTxt AS TextBox
BackStyle = 0
BorderStyle = 0
PROCEDURE KeyPress
    LPARAMETERS nKeyCode, nShiftAltCtrl

    LOCAL lnLft, lnRgt, lnLev, lnSaveSelect
    WITH This.Parent
        DO CASE
            CASE nShiftAltCtrl = 2 AND nKeyCode = 145    && CTRL+DWN_ARR
                NODEFAULT
                .Parent.Parent.DoScroll(1)
            CASE nShiftAltCtrl = 2 AND nKeyCode = 141    && CTRL+UP_ARR
                NODEFAULT
                .Parent.Parent.DoScroll(0)
            CASE nShiftAltCtrl = 0 AND nKeyCode = 24    && DWN_ARR
                NODEFAULT
                IF !EOF(.Parent.Parent.RecordSource)
                    SKIP 1 IN (.Parent.Parent.RecordSource)
                ENDIF
            CASE nShiftAltCtrl = 0 AND nKeyCode = 5        && UP_ARR
                NODEFAULT
                IF !BOF(.Parent.Parent.RecordSource)
                    SKIP -1 IN (.Parent.Parent.RecordSource)
                ENDIF
            CASE nShiftAltCtrl = 0 AND nKeyCode = 19        && LEFT_ARR
                NODEFAULT
                IF .lExp
                    .Parent.Parent.Tree_Expand(.F.)
                ELSE                
                    lnLft = .nLft
                    lnRgt = .nRgt
                    lnLev = .nLev - 1
                    lnSaveSelect = SELECT()
                    SELECT(.Parent.Parent.RecordSource)
                    LOCATE FOR nLft < lnLft AND nRgt > lnRgt AND nLev = lnLev
                    SELECT(lnSaveSelect)
                ENDIF
            CASE nShiftAltCtrl = 0 AND nKeyCode = 4        && RIGHT_ARR
                NODEFAULT
                IF .lExp
                    lnLft = .nLft
                    lnRgt = .nRgt
                    IF lnLft + 1 < lnRgt
                        lnSaveSelect = SELECT()
                        SELECT(.Parent.Parent.RecordSource)
                        LOCATE FOR nLft > lnLft AND nRgt < lnRgt
                        SELECT(lnSaveSelect)
                    ENDIF
                ELSE
                    .Parent.Parent.Tree_Expand(.T.)
                ENDIF
            OTHERWISE
                *WaitCenter(TEXTMERGE([<<nKeyCode>>, <<nShiftAltCtrl>>]))
                RAISEEVENT(This.Parent, "KeyPress", nKeyCode, nShiftAltCtrl)
        ENDCASE
    ENDWITH
ENDPROC && KeyPress
ENDDEFINE

DEFINE CLASS tImg AS Image
BackStyle = 0
Stretch = 0
Width = 11
Height = 11
PROCEDURE Click
    RAISEEVENT(This.Parent, "DblClick")
ENDPROC
ENDDEFINE

DEFINE CLASS tLbl AS Label
BackStyle = 0
AutoSize = .T.
PROCEDURE DblClick
    RAISEEVENT(This.Parent, "DblClick")
ENDPROC
ENDDEFINE

PROCEDURE BuildHierarhyIdx
***********************************************************
* Строим иерархию в текущем курсоре.
LPARAMETERS tuNode, tnCounter, tnLevel, tcKeyField, tcParField

PRIVATE ALL
LOCAL lcOldAlias, lcNewAlias, lcIndex

tnLevel        = tnLevel + 1
lcOldAlias    = ALIAS()
lcNewAlias    = SYS(2015)
lcIndex        = SYS(2015)
*-* (IGEL) 1. Строим индексы
USE (DBF(lcOldAlias)) IN 0 ALIAS (lcNewAlias) AGAIN

SELECT (lcNewAlias)
INDEX ON &tcKeyField TAG KeyVal OF &lcIndex FOR NVL(&tcKeyField!=&tcParField, .T.) ADDITIVE
INDEX ON &tcParField TAG ParVal OF &lcIndex ADDITIVE
lcUslovie = TEXTMERGE([!INDEXSEEK(<<tcParField>>, .F., "<<lcNewAlias>>", "KeyVal")])

*-* (IGEL) 2. Основной цикл по данным
SELECT (lcOldAlias)
SCAN FOR ISNULL(&tcParField) OR !INDEXSEEK(&tcParField, .F., lcOldAlias, "KeyVal")
    tnCounter = tnCounter + 1
    REPLACE nLft WITH tnCounter, ;
            nLev WITH tnLevel
    
    IF INDEXSEEK(&tcKeyField, .F., lcOldAlias, "ParVal")
        tnCounter = BuildHierarhyIdx_Iterate(&tcKeyField, tnCounter, tnLevel, lcOldAlias, tcKeyField, tcParField)
    ENDIF
            
    tnCounter = tnCounter + 1
    REPLACE nRgt WITH tnCounter
ENDSCAN

*-* (IGEL) 3. Вычищаем нами же построенные индексы
USE IN SELECT(lcNewAlias)
DELETE TAG KeyVal OF (lcIndex)
DELETE TAG ParVal OF (lcIndex)
TRY
    IF FILE(FORCEEXT(lcIndex, "CDX"))
        ERASE (FORCEEXT(lcIndex, "CDX"))
    ENDIF
CATCH    
ENDTRY

RETURN tnCounter

FUNCTION BuildHierarhyIdx_Iterate
    LPARAMETERS tuNode, tnCounter, tnLevel, tcAlias, tcKeyField, tcParField
    LOCAL lnSaveRec
    lnSaveRec    = RECNO()
    IF tnCounter > RECCOUNT() * 2
        =MESSAGEBOX(TEXTMERGE("Алгоритм BuildHierarhyIdx_Iterate зациклился на <<ALIAS()>>"), 0+16, "Error")
        RETURN tnCounter
    ENDIF
    tnLevel        = tnLevel + 1
    SCAN FOR &tcParField = tuNode
        IF NVL(&tcKeyField = &tcParField, .F.)
            LOOP
        ENDIF
        tnCounter = tnCounter + 1
        REPLACE nLft WITH tnCounter, ;
                nLev WITH tnLevel
        
        IF INDEXSEEK(&tcKeyField, .F., tcAlias, "ParVal")
            tnCounter = BuildHierarhyIdx_Iterate(&tcKeyField, tnCounter, tnLevel, tcAlias, tcKeyField, tcParField)
        ENDIF
                
        tnCounter = tnCounter + 1
        REPLACE nRgt WITH tnCounter
    ENDSCAN
    GOTO lnSaveRec
    RETURN tnCounter
ENDFUNC
ENDPROC