unit utslvcltree;
interface
{**
    @explan(说明) 树控件相关 %%
    @date(20220510)
**}
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type TVirtualListItem = class(tsluibase)
    {**
    @ignore(忽略) %%
    @explan(说明) list 的 item项目基类
    **}
    type THandleClass=class
    end
    function Create(List);override;
    begin
        {**
        @explan(说明) 构造函数%%
        @param(list)(TVirtualList) item的所有者,必须是TVirtualList或者其派生 %%
        **}
        if(List is class(TVirtualList))then
        begin
            FOwner := List;
        end
        hd := new THandleClass();
        try
            FHandle := inttostr(int64(hd)); ////当前句柄唯一标识
        except
            FHandle := inttostr(gettslvariableptr(hd));
        end;
        inherited create();
        FWidth := 30;
    end
    function paint(cvs,x,y,xwidth,yheight);virtual;
    begin
        {**
        @explan(说明) 绘制 %%
        @param(cvs)(tcustomcanvas) canvas对象 %%
        @param(x)(integer) 当前x轴位置 %%
        @param(y)(integer) 当前y轴位置 %%
        @param(xwidth)(integer) 最大项的宽度 %%
        @param(yheight)(integer) 高度 %%
        **}
    end
    property Width read FWidth write SetWidth;
    property Handle read FHandle;
    property Owner read FOwner;
    {**
    @param(width)(integer) 宽度 %%
    @param(Owner)(TVirtualList) 所有者 %%
    **}
    function Recycling();override;
    begin
        FOwner := nil;
        inherited;
    end
    private
    FHandle;
    function SetWidth(w);virtual;
    begin
        if w>0 and w <> FWidth then
        begin
            if Owner and(Owner.ItemMaxWidth=FWidth)or(Owner.ItemMaxWidth<w)then //当前以及最大 
            begin
                tz := true;
            end
            FWidth := w;
            if tz and Owner and Owner.ItemInList(self)then
            begin
                Owner.ItemUpDated(true);
            end
        end
    end
    FWidth;
    FOwner;
end
type TcustomTreeCtlNode = class(TVirtualListItem)
    {**
    @explan(说明) 树结点 %%
    **}
    protected
    FItems; //子项
    FParent; //父节点
    private
    FBasePos;//周边基准位置
    FCheckPos; //checkbox位置
    FExpandPos; //展开按钮位置
    FExpandWidth; //展开按钮宽度
    FCheckWidth; //checkbox宽度
    FFocusColor;
    //FNodeHash;
    FHierarchyWidth;
    function DrawCheckBox(cvs,x,rec,sz,flag); //绘制checkbox
    begin
        y := rec[1];
        h := rec[3];
        ys := y+(h-sz)/2;
        dr := array((x,ys),(x+sz,ys+sz));
        ow := Owner;
        dflg := flag;
        if ow.OnlyLeafNodeCheckMark and ItemCount>0 then dflg := false;
        cvs.Draw("FrameControl",dr,DFC_BUTTON,dflg?DFCS_CHECKED:DFCS_BUTTONCHECK);
        if(not dflg)and(ItemCount>0)then
        begin
            if allChildChecked()then
            begin
                cvs.Draw("FrameControl",dr,DFC_BUTTON,DFCS_CHECKED);
            end else
            if ChildChecked()then
            begin
                cvs.brush.color := rgb(10,10,10);
                cvs.fillrect(dr[0]+8 union dr[1]-4);
                ow := Owner;
                if self=ow.CurrentNode then cvs.brush.color := FFocusColor[ow.hasFocus()];
                else cvs.brush.color := ow.Color;
            end
        end
    end
    function DrawExpand(cvs,x,rec,sz,flag); //绘制展开按钮
    begin
        sz2 := integer(sz/2);
        y := rec[1];
        h := rec[3];
        ys := y+(h-sz)/2;
        dr := array(array(x,ys),array(x+sz,ys+sz));
        cvs.draw("rectangle",dr);
        cvs.MoveTo(array(x+2,ys+sz/2));
        cvs.LineTo(array(x+sz-2,ys+sz/2));
        if not flag then
        begin
            cvs.MoveTo(array(x+sz/2,ys+2));
            cvs.LineTo(array(x+sz/2,ys+sz-2));
        end
    end
    
    function ChildChecked();
    begin
        for i := 0 to FItems.Count-1 do
        begin
            it := FItems[i];
            ow := Owner;
            if ow and ow.OnlyLeafNodeCheckMark then
            begin
                if it.checked and it.ItemCount<1 then return true;
                if it.ChildChecked()then return true;
            end else
            begin
                if it.Checked then return true;
                if it.ChildChecked()then return true;
            end
        end
        return false;
    end
    function allChildChecked();
    begin
        if FItems.Count<1 then return false;
        for i := 0 to FItems.Count-1 do
        begin
            it := FItems[i];
            if it.ItemCount<1 then
            begin
                if not it.Checked then return false;
            end else
            begin
                if not it.allChildChecked()then return false;
            end
        end
        return true;
    end
    public
    function Paint(cvs,x,y,w,h);override; //绘制
    begin
        {**
        @explan(说明)绘制节点%%
        **}
        ow := Owner;
        if not ow then return;
        cvs.Pen.Color := rgb(50,50,50);
        cvs.Pen.style := PS_SOLID;
        cvs.Pen.width := 1;
        inv := 3;
        BasePos := FBasePos+x;
        FCheckPos := BasePos;
        fitemcountflg := ItemCount or FDirtype;
        for i := 1 to Hierarchy do 
            BasePos += FHierarchyWidth;
        cbase := BasePos;
        itc := 0;
        ExpWidth := FExpandWidth;
        ifsel := false;
        if self=ow.CurrentNode then
        begin
            ifsel := true;
            cvs.brush.Color := FFocusColor[ow.hasFocus()];
        end else
        cvs.brush.Color := ow.Color;
        if fitemcountflg then
        begin
            itc := true;
            BasePos += inv;
            FExpandPos := BasePos;
            DrawExpand(cvs,BasePos,array(x,y,w,h),ExpWidth-2,FExpanded);
            BasePos += ExpWidth;
        end else //else ExpWidth := 0;
        begin
            BasePos += ExpWidth+inv;
        end
        CheckWidth := FCheckWidth;
        if ow.CheckBox then
        begin
            BasePos += inv;
            FCheckPos := BasePos;
            DrawCheckBox(cvs,BasePos,array(x,y,w,h),CheckWidth,FChecked);
            BasePos += CheckWidth;
            BasePos += inv;
        end else
        CheckWidth := false;
        img := ow.ImageList;
        iwidth := 0;
        if(img and img.HandleAllocated())then
        begin
            if(ifsel and FSelImgId >= 0)or(FImgId >= 0)or(FExpandImgId >= 0 and fitemcountflg>0 and FExpanded)then //绘制selimage 
            begin
                if(FExpandImgId >= 0)and fitemcountflg>0 and FExpanded then
                begin
                    img.Draw(FExpandImgId,cvs,BasePos,y+1,nil);
                end else
                if(ifsel and FSelImgId >= 0)then
                begin
                    img.Draw(FSelImgId,cvs,BasePos,y+1,nil);
                end else
                if FImgId >= 0 then
                begin
                    img.Draw(FImgId,cvs,BasePos,y+1,nil);
                end
                BasePos += img.Height;
                BasePos += inv;
            end
            //echo "\r\nimg";
        end
        FCaptionRect := array(BasePos,y,x+1000,y+h);
        cvs.FillRect(FCaptionRect);
        cvs.drawtext(FCaption,FCaptionRect,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
        if ow.HasLine then
        begin
            cvs.Pen.Color := rgb(150,150,150);
            cvs.Pen.style := PS_DOT;
            for i,v in ow.GetHierarchyByHandle(self.Handle) do
            begin
                FLG := TRUE;
                //nx := cbase-FHierarchyWidth*(i+1)+6;
                nx := cbase+FHierarchyWidth *(i-FHierarchy-1)+6;
                if nx>cbase-5 then break;
                cvs.MoveTo(array(nx,y));
                if i=FHierarchy and Parent.LastChild=self then 
                    cvs.LineTo(array(nx,y+h/2+1));
                else cvs.LineTo(array(nx,y+h));
            end
            cvs.MoveTo(array(cbase+ExpWidth,y+h/2));
            cvs.LineTo(array(cbase-FHierarchyWidth+6,y+h/2));
        end
    end
    function MouseUp(o,e);
    begin
        {**
        @explan(说明) 点击消息处理
        **}
        ps := e.pos;
        px := ps[0];
        rec := o.GetIndexRect(o.GetItemIndexByYpos(e.ypos)); //获得位置
        recx := rec[0];
        if(FItems.Count or FDirtype)and px >= FExpandPos and px <=(FExpandPos+FExpandWidth)then //点击展开
        begin
            if mbLeft=e.button()then
            begin
                if FExpanded then UnExpand();
                else Expand();
            end else
            begin
                e.skip := true;
            end
        end else
        if Owner.CheckBox and MouseCanChecked and px >= FCheckPos and px <=(FCheckPos+FCheckWidth)then //点击checkbox
        begin
            //setprofiler(1+2+4);
            if mbLeft=e.button()then
            begin
                Checked := not FChecked;
                p := parent;
                while p and(p is class(TcustomTreeCtlNode)) do
                begin
                    Owner.InvalidateItem(p,0);
                    p := p.parent;
                end
            end else
            e.skip := true;
            //exportfile(ftstream(),"","d:\\tst\\abc.stm",getprofilerinfo(true));
        end else
        if px>FCheckPos then //点击文本
        begin
            return true;
        end
        return false;
    end
    function Create(AOwner);override;
    begin
        inherited;
        FVisible := true;
        FMouseCanChecked := true;
        FModifyChildrenChecked := true;
        FFocusColor := array(rgb(230,240,250),rgb(0,192,250));
        //FNodeHash := array();
        FCheckWidth := 16;
        FExpandWidth := 12;
        FBasePos := 10;
        FHierarchyWidth := 20;
        FItems := new TFpList(); //子项
        FHierarchy :=-1;
        FEexpanded := false;
        FChecked := false;
        FExpandImgId :=-1;
    end
    function GetNodeByIndex(idx);
    begin
        {**
        @explan(说明) 通过序号获得子节点%%
        @param(idx)(TcustomTreeCtlNode) %%
        **}
        if idx >= 0 then return FItems[idx];
        return nil;
    end
    function indexof(v); //获得序号
    begin
        return FItems.indexof(v);
    end
    function UpDateHierarchy(); //更新层级
    begin
        if not Parent then return;
        ph := Parent.Hierarchy;
        nh := ph+1;
        if FHierarchy <> nh then
        begin
            FHierarchy := nh;
            for i := 0 to FItems.Count-1 do
            begin
                FItems[i].UpDateHierarchy();
            end
        end
        UpDateWidth();
    end
    function AppendNodeStr(s);override;
    begin
        {**
        @explan(说明) 追加一个节点 %%
        @param(s)(string) 字符串 %%
        @return(TcustomTreeCtlNode) 新节点 %%
        **}
        ow := Owner;
        idx := FItems.Count;
        return InsertNodeStr(s,idx);
    end
    function InsertNodeStr(s,idx);override;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(s)(string) 字符串 %%
        @param(idx)(integer) 序号 %%
        @return(TcustomTreeCtlNode) 新节点 %%
        **}
        if not(idx >= 0)then idx := 0;
        ow := Owner;
        if not ow then return;
        it := ow.CreateTreeNode(ow); //new TcustomTreeCtlNode(ow);
        it.Caption := s;
        InsertNode(it,idx);
        return it;
    end
    function GetIndex();virtual;
    begin
        {**
        @explan(说明) 获得在父节点中的序号 %%
        @return(integer) 序号 %%
        **}
        if Parent then Parent.indexof(self);
    end
    function AncestorIsExpand();virtual;
    begin
        {**
        @explan(说明) 是否一致展开 %%
        @return(bool) 展开为true,否则为false %%
        **}
        r := Expanded;
        if not(r)then return false;
        if Parent then return Parent.AncestorIsExpand();
        return r;
    end
    function AppendNode(it);virtual;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(it)(TcustomTreeCtlNode) 节点 %%
        @return(bool) 是否成功 %%
        **}
        return InsertNode(it,FItems.Count);
    end
    function HasNode(nd);virtual;
    begin
        {**
        @explan(说明) 是否为某个节点的祖先节点 %%
        @param(nd)(TcustomTreeCtlNode) 子节点 %%
        @return(TcustomTreeCtlNode|0) 如果为祖先节点,就返回查询节点的父节点 %%
        **}
        if not(nd is class(TcustomTreeCtlNode))then return 0;
        ow := Owner;
        if not ow then return;
        if ow <> nd.Owner then return 0;
        p1 := nd.Parent;
        p := p1;
        while p do
        begin
            if p=self then return p1;
            if p is class(TcustomTreeCtlNode)then p := p.Parent;
        end
        return 0;
    end
    function DeleteNode(nd);virtual;
    begin
        {**
        @explan(说明) 删除节点 %%
        @param(nd)(TcustomTreeCtlNode) 待删除节点 %%
        **}
        if nd=self then return 0;
        pn := HasNode(nd);
        if not pn then return;
        return pn.DeleteChildNode(nd);
    end
    
    function DeleteChildNode(nd);
    begin
        {**
        @explan(说明) 删除子节点%%
        @param(nd)(TcustomTreeCtlNode) 节点 %%
        **}
        idx :=-1;
        idx := indexof(nd);
        if idx=-1 then return 0;
        return DeleteNodeByIndex(idx);
    end
    function DeleteNodeByIndex(idx);
    begin
        {**
        @explan(说明) 根据位置删除节点%%
        @param(idx)(integer) 序号 %%
        **}
        nd := FItems[idx];
        if not nd then return;
        try
            Owner.IncPaintLock();
            nd.UnExpand();
            if Owner.NodeInList(nd)then //在显示 
            begin
                Owner.DeleteItemByIndex(Owner.GetItemIndex(nd));
            end
            FItems.Deli(idx);
            CurrentDeleteNode := nd;
            nd.parent := self(true);
            CurrentDeleteNode := nil;
        finally
            Owner.DecPaintLock();
        end
        return true;
    end
    function DeleteChildren();virtual; //
    begin
        {**
        @explan(说明) 删除所有的子节点%%
        **}
        try
            Owner.IncPaintLock();
            r := true;
            if self=Owner.RootNode then
            begin
                while ItemCount>0 DO
                begin
                    DeleteChildNode(FItems[0]);
                end
                r := false;
            end
            if r then
            begin
                UnExpand(); //折叠 
                while ItemCount>0 do
                begin
                    idx := 0; //ItemCount-1;
                    it := FItems[idx];
                    CurrentDeleteNode := it;
                    it.parent := self(true);
                    CurrentDeleteNode := nil;
                    FItems.Deli(idx);
                end
            end
        finally
            Owner.DecPaintLock();
        end
    end
    function GetLastShowNode();
    begin
        {**
        @explan(说明) 获得展示的最后第一个节点 %%
        @return(TcustomTreeCtlNode) %%
        **}
        if FItems.Count<1 or not(FExpanded)then return self;
        for i := FItems.Count-1 downto 0 do 
        begin
            it := FItems[i];
            if it.Visible then return it.GetLastShowNode();
        end 
        return self;        
        return it.GetLastShowNode();
    end
    function InsertNodes(its,idx);virtual;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(it)( array of TcustomTreeCtlNode) 字符串 %%
        @param(idx)(integer) 序号 %%
        **}
        idx0 := idx;
        if not(idx >= 0)then idx0 := 0;
        if idx>FItems.Count then idx0 := FItems.Count;
        nits := array();
        nitsi := 0;
        flag := false;
        bidx := idx0;
        for i,it in its do
        begin
            if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
            begin
                odexp := it.Expanded;
                it.UnExpand();
                FItems.InsertBefor(it,idx0);
                CurrentAddNode := it;
                it.Parent := self(true);
                CurrentAddNode := nil;
                it.UpDateHierarchy();
                nits[nitsi++]:= it;
                idx0++;
                flag := true;
            end
        end
        if flag and Expanded and Owner.NodeInList(self)then
        begin
            preItem := FItems[bidx-1];
            bx := 0;
            //if preItem then bx := Owner.GetItemIndex( preItem.GetLastShowNode())+1;
            if preItem then bx := Owner.GetItemIndex(preItem.GetLastShowNode(),bidx)+1;
            else bx := owner.GetItemIndex(self)+1;
            owner.InsertItems(nits,bx);
        end
    end
    function InsertNode(it,idx);virtual;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(it)(TcustomTreeCtlNode) 字符串 %%
        @param(idx)(integer) 序号 %%
        **}
        if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
        begin
            if idx<0 then idx := 0;
            if idx>FItems.Count then idx := FItems.Count;
            if not(idx >= 0)then idx := 0;
            odexp := it.Expanded;
            it.UnExpand();
            FItems.InsertBefor(it,idx);
            CurrentAddNode := it;
            it.Parent := self(true);
            CurrentAddNode := nil;
            it.UpDateHierarchy();
            if Expanded and Owner.NodeInList(self)then
            begin
                preItem := FItems[idx-1];
                bx := 0;
                if preItem then bx := Owner.GetItemIndex(preItem.GetLastShowNode())+1;
                else bx := owner.GetItemIndex(self)+1;
                owner.InsertItem(it,bx);
            end
            return true;
        end
    end
    function Expand();virtual; //展开
    begin
        {**
        @explan(说明) 展开节点 %%
        **}
        if Owner and Owner.RootNode=self then return;
        if FExpanded then return;
        if ItemCount<1 then //空节点展开
        begin
            if FDirtype then
            begin
                Owner.EmptyNodeExpanding(self(true));
            end
            return;
        end
        //if not Owner.NodeInList(self) then return;
        idx :=-1;
        if(Owner.NodeInList(self))then
        begin
            its := GetShowNodes();
            idx := Owner.GetItemIndex(self);
            Owner.InsertItems(its,idx+1);
        end
        FExpanded := true;
        //return true;
        if Owner.SingleExpand then
        begin
            p := Parent;
            if p is class(TcustomTreeCtlNode)then
            begin
                PItems := p.FItems;
                ct := PItems.Count;
                if ct>1 then
                begin
                    Owner.UpDateWindow();
                    for i := 0 to ct-1 do
                    begin
                        vi := PItems[i];
                        if vi=self then continue;
                        vi.UnExpand();
                    end
                end
            end
        end
        if idx >= 0 then
        begin
            owner.InvalidateItem(self,flag);
        end
        return true;
    end
    function UnExpand();virtual; //折叠
    begin
        {**
        @explan(说明) 折叠节点 %%
        **}
        if Owner and Owner.RootNode=self then return;
        if not FExpanded then return;
        if ItemCount<1 then return;
        idx :=-1;
        idx := Owner.GetItemIndex(self);
        it := GetLastShowNode();
        idx2 := Owner.GetItemIndex(it,idx);
        owner.DeleteItemByBounds(idx+1,idx2);
        //父节点为展开
        FExpanded := false;
        if idx >= 0 then
        begin
            Owner.InvalidateItem(self,flag);
        end
    end
    function RecyclingChildren();virtual;
    begin
        while ItemCount>0 do
        begin
            it := FItems[0];
            //echo "\r\n删除",it.Caption;
            it.Recycling();
        end
    end
    function Recycling();override;
    begin
        p := FParent;
        if p then
        begin
            p.DeleteNode(self);
        end
        while ItemCount>0 do
        begin
            it := FItems[0];
            it.Recycling();
        end
        //if self<>Owner.RootNode then 
        inherited;
    end
    function GetShowItemCount();
    begin
        r := 1;
        if not FExpanded then return r;
        for i := 0 to FItems.Count-1 do
        begin
            it := FItems[i];
            if it.Visible then //可见
            begin 
            r++;
            if it.ItemCount and it.Expanded then r += it.GetShowItemCount();
            end 
        end
        return r;
    end
    function GetShowNodes();
    begin
        {**
        @explan(说明) 获得展开的所有子节点 %%
        @return(array of TcustomTreeCtlNode) %%
        **}
        lst := array();
        for i := 0 to FItems.Count-1 do
        begin
            it := FItems[i];
            if it.Visible then 
            begin 
            lst union=array(it);
            if it.ItemCount and it.Expanded then lst union=it.GetShowNodes();
            end 
        end
        return lst;
    end
    function toarray();virtual;
    begin
        {**
        @explan(说明) 转换为数组 %%
        **}
        r := array();
        r["type"]:= "treenode";
        r["caption"]:= FCaption;
        mid := FImgId;
        smid := FSelImgId;
        r["imgid"]:= mid >= 0?mid:(-1);
        r["selimgid"]:= smid >= 0?smid:(-1);
        if _tag then r["tag"]:= _tag;
        if Checked then r["checked"]:= true;
        if ItemCount then
        begin
            r["nodes"]["type"]:= "treenodes";
            for i := 0 to ItemCount-1 do
            begin
                r["nodes"]["items"][i]:= GetNodeByIndex(i).toarray();
            end
        end
        return r;
    end
    property ImgId read FImgId write SetImgId;
    property SelImgId read FSelImgId write SetSelImgId;
    property ExpandImgId read FExpandImgId write SetExpandImgId;
    property Visible read FVisible write SetVisible;
    property ItemCount read GetItemCount; //节点数
    property Hierarchy Read FHierarchy; //层次
    property Expanded read GetExpanded; //展开 
    property Parent read FParent write SetParent; //父节点
    property Checked read FChecked write SetChecked; //选择
    property LastChild read GetLstChild;
    property dirtype read FDirtype write FDirtype; //目录类型
    property Caption read FCaption write SetCaption; //标题
    property MouseCanChecked read FMouseCanChecked write FMouseCanChecked;
    property ModifyChildrenChecked read FModifyChildrenChecked write FModifyChildrenChecked;
    {**
    @param(ItemCount)(integer) 子节点数量 %%
    @param(Hierarchy)(integer) 层级 %%
    @param(Handle)(pointer) 句柄 %%
    @param(Expanded)(bool) 是否展开 %%
    @param(Parent)(TcustomTreeCtlNode) 父节点 %%
    **}
    protected property CurrentDeleteNode read FCurrentDeleteNode write FCurrentDeleteNode;
    property CurrentAddNode read FCurrentAddNode write FCurrentAddNode;
    function Gitems();
    begin
        return FItems;
    end
    function SetParent(V);virtual;
    begin
        ow := Owner;
        if not ow then return;
        if ow.RootNode=self then return;
        tp := Parent;
        if(v is class(TcustomTreeCtlNode))and v.Owner=ow then
        begin
            if v.CurrentAddNode=self then
            begin
                FParent := v; //新节点 
            end else
            if v.CurrentDeleteNode=self then //从节点移除
            begin
                FParent := nil;
            end else
            begin
                if tp=v then return;
                if tp then
                begin
                    tp.DeleteNode(self(true));
                end
                v.InsertNode(self(true),v.ItemCount);
            end
        end else
        begin
            if tp then tp.DeleteNode(self(true));
        end
    end
    function SetChecked(v);virtual; //设置checked
    begin
        nv := v?true:false;
        if nv <> FChecked then
        begin
            FChecked := nv;
            if ModifyChildrenChecked then
            begin
                for i := 0 to ItemCount-1 do
                begin
                    FItems[i].Checked := nv;
                end
            end
            ow := Owner;
            if ow then ow.InvalidateItem(self,false);
        end
    end
    private
    function GetLstChild();
    begin
        return FItems[FItems.Count-1];
    end
    function SetImgId(id);
    begin
        if(id>-2)and(id<1000)and id <> FImgId then
        begin
            FImgId := integer(id);
        end
    end
    function SetExpandImgId(id);
    begin
        if id>-2 and(id<1000)and id <> FExpandImgId then
        begin
            FExpandImgId := integer(id);
        end
    end
    function SetSelImgId(id);
    begin
        if(id>-2)and(id<1000)and id <> FSelImgId then
        begin
            FSelImgId := id;
        end
    end
    function SetVisible(v); //可见设置
    begin
        if Owner.RootNode = self then return ;
        nv := v?true:false;
        if nv<>FVisible then 
        begin
            FVisible := nv;
            p := Parent;
            if not p then return ; //无父节点
            if p<>Owner.RootNode then //非根节点
            begin 
                if not Owner.NodeInList(p) then return 0;// 不在列表中
                if not p.Expanded then return 0; //非展开  
                pidx := Owner.GetItemIndex(p); //获得位置                
            end  else   //根节点
            begin
                pidx := -1;
            end        
            UnExpand(); //折叠           
            if nv then //变得可见
            begin 
                cidx := p.GetShowNodeidx(self);
                idx := pidx+cidx+1;  
                Owner.InsertItem(self(true),idx);
            end else //变得不可见
            begin
                idx := Owner.GetItemIndex(self);
                owner.DeleteItemByBounds(idx,idx);
            end            
        end 
    end 
    function GetShowNodeidx(nd); //获得子节点在父节点后面的序号
    begin
        idx := 0;
        for i := 0 to FItems.Count-1 do
        begin
            it := FItems[i];
            
            if it = nd then return idx;            
            if it.Visible then 
            begin 
                idx++;
                if it.ItemCount and it.Expanded then
                    idx += it.GetShowNodeidx(0);
            end         
        end
        return idx;
    end
    FVisible;
    FDirtype;
    FImgId;
    FMouseCanChecked;
    FModifyChildrenChecked;
    FSelImgId;
    FCurrentDeleteNode;
    FCurrentAddNode;
    FExpanded;
    FExpandImgId;
    FHierarchy; //层级
    FCaption; //标题
    FChecked; //选择
    function SetCaption(v);virtual; //设置标题
    begin
        if ifstring(v)and V <> FCaption then
        begin
            FCaption := v;
            UpDateWidth();
        end
    end
    function UpDateWidth();
    begin
        bwid := 60;
        for i := 1 to FHierarchy do
        begin
            bwid += FHierarchyWidth;
        end
        if ifstring(FCaption)and FCaption then
        begin
            fw := 8;
            if Owner then
            begin
                ft := Owner.Font;
                fw := abs(ft.Width);
                if fw=0 then fw := integer(abs(ft.Height)/2);
            end
            bwid += length(FCaption)* fw;
        end
        width := bwid;
    end
    function GetExpanded();virtual; //已经展开
    begin
        if Owner and Owner.RootNode=self then return true;
        return FExpanded;
    end
    function GetItemCount(); //子节点数
    begin
        return FItems.Count;
    end
end 
type TVirtualListFixed = class(TCustomScrollControl)
    {**
    @ignore(忽略) %%
    @explan(说明) 滚动条窗口 %%
    **}
    protected
    function GetClientXCapacity();virtual; //宽度容量
    begin
        r := integer(ClientRect[2]/GetXScrollDelta());
        return r;
    end
    function GetClientYCapacity();virtual; //高度容量
    begin
        return integer(ClientRect[3]/GetYScrollDelta());
    end
    function GetClientXCount();virtual; //宽度间隔
    begin
        return ColCount;
    end
    function GetClientYCount();virtual; //高度项
    begin
        return FItemCount;
    end
    function GetXScrollDelta();override;
    begin
        return FColWidth;
    end
    function GetYScrollDelta();override;
    begin
        return FItemHeight;
    end
    function PositionChanged();virtual;
    begin
        InvalidateRect(nil,false);
    end
    function UpDateScrollBar();
    begin
        DoControlAlign();
    end
    public
    function IncPaintLock();
    begin
        BeginUpdate();
    end
    function DecPaintLock();
    begin
        EndUpdate();
    end
    function DoEndUpDate();override;
    begin
        if not(IsUpDating())then
        begin
            if FScroolChanged then
            begin
                FScroolChanged := false;
                UpDateScrollBar();
            end
        end
        inherited;
    end
    function GetItemIndexByYpos(y);virtual;
    begin
        py := GetYPos();
        return integer(y/GetYScrollDelta())+py;
    end
    function ItemUpDated();virtual;
    begin
        //空函数
        UpDateScrollBar();
    end
    function GetValidateRect();virtual;
    begin
        {**
        @explan(说明) 获得绘制区域 %%
        @return(array) array(左,上,右,下) %%
        **}
        return FValidateRect;
    end
    function Create(AOwner);override;
    begin
        inherited;
        FItemHeight := 25;
        FItemCount := 0;
        height := 400;
        width := 300;
        FColWidth := 10;
        FColCount := 0;
        border := true;
        autoscroll := 3;
        ThumbTrack := true;
        FScroolChanged := false;
    end
    function SetTopLine(v);virtual;
    begin
        SetYpos(v);
    end
    function paint();override;
    begin
        xpos := GetXpos();
        ypos := GetYPos();
        // 计算需要重绘的区域
        ps := PAINTSTRUCT().rcPaint;
        tp := ps[1];
        bo := ps[3];
        FValidateRect := ps;
        FirstLine := integer(max(0,yPos+(tp)/FItemHeight));
        LastLine := integer(min(ItemCount-1,yPos+(bo)/FItemHeight));
        FirstCol := integer(max(0,xPos+ps[0]/FColWidth));
        LastCol := integer(min(FColCount-1,xPos+ps[2]/FColWidth));
        x := FColWidth *(0-xPos);
        cvs := Canvas;
        cvs.Font := font;
        PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol);
        FValidateRect := array();
    end
    function PaintRect(cvs,yPos,ht,FirstLine,LastLine,xPos,wd,FirstCol,LastCol);virtual;
    begin
        {**
        @explan(说明) 绘制无效区域 %%
        **}
        for i := FirstLine to LastLine do
        begin
            y := ht *(i-yPos)+FMarginTop;
            for j := FirstCol to LastCol do
            begin
                x := wd *(j-xPos);
                cvs.Textout(format("%d=%d",i,j),array(x,y));
            end
        end
    end
    function Clean();virtual;
    begin
        {**
        @explan(说明) 清空 %%
        **}
        ColCount := 0;
    end
    function GetIndexClientRect(idx);virtual;
    begin
        if idx >= 0 then
        begin
            rc := ClientRect;
            yp := GetYPos();
            rc[1]:=(idx-yp)* FItemHeight;
            rc[3]:= rc[1]+FItemHeight;
            return rc;
        end
    end
    function GetIndexRect(idx);virtual;
    begin
        {**
        @explan(说明) 通过id获得item区域 %%
        @param(idx)(integer) 序号 %%
        @return(array) array(左,上,右,下) %%
        **}
        r := GetIndexClientRect(idx);
        if r then
        begin
            r[0]:= FColWidth *(0-GetXpos());
        end
        return r;
    end
    function GetClientItemIndexs();virtual;
    begin
        rc := ClientRect;
        r := GetRectItemIndexs(rc);
        return r[0]-> r[1];
    end
    function doControlALign();override;
    begin
        if(IsUpDating())then
        begin
            FScroolChanged := true;
        end else
        begin
            InitialScroll();
        end
    end
    property ItemCount read GetItemCount write SetItemCount;
    property ItemHeight read FItemHeight write SetItemHeight;
    property ColCount read FColCount write SetColCount;
    property ColWidth read FColWidth write SetColWidth;
    private
    FValidateRect;
    FItemCount; //项数量
    FItemHeight; //项高	
    FColCount; //列数
    FColWidth; //列宽
    FScroolChanged; //滚动条修改
    function GetRectItemIndexs(rc);
    begin
        yp := GetYPos();
        tp := rc[1];
        bo := rc[3];
        FirstLine := integer(tp/GetYScrollDelta())+yp;
        LastLine := integer((bo)/GetYScrollDelta())+yp;
        return array(FirstLine,LastLine);
    end
    function SetColWidth(h);
    begin
        if FColWidth <> h and h>5 then
        begin
            FColWidth := h;
            UpDateScrollBar();
        end
    end
    function SetColCount(v);
    begin
        nv := GZNumber(v);
        if nv >= 0 and nv <> FColCount then
        begin
            FColCount := nv;
            UpDateScrollBar();
        end
    end
    function GetItemCount();virtual;
    begin
        return FItemCount;
    end
    function SetItemCount(v);virtual;
    begin
        nv := GZNumber(v);
        if nv >= 0 and nv <> FItemCount then
        begin
            FItemCount := nv;
            UpDateScrollBar();
        end
    end
    function SetItemHeight(v);
    begin
        nv := GZNumber(v);
        if FItemHeight <> nv then
        begin
            FItemHeight := nv;
            UpDateScrollBar();
        end
    end
    function GZNumber(v);
    begin
        return v>0?integer(v):0;
    end
end
type TVirtualList = class(TVirtualListFixed)
    {**
    @ignore(忽略) %%
    @explan(说明) 虚拟的list 
    **}
    function GetClientYCount();override; //高度项
    begin
        return FItems.Count;
    end
    function GetClientXCount();override; //宽度间隔
    begin
        return integer(FxClientMax/ColWidth);
    end
    function Create(AOwner);override;
    begin
        inherited;
        FxClientMax := ColWidth;
        FItemMinWidth := FxClientMax;
        FHashItems := array();
        FItems := new TFpList();
    end
    function GetItemByIndex(idx);
    begin
        {**
        @explan(说明) 通过id获得序号 %%
        @param(idx)(integer) 序号 %%
        @return(TVirtualListItem) 项 %%
        **}
        if idx >= 0 and Idx<FItems.Count then return FItems[idx];
    end
    function GetItemIndexByYpos(y);override;
    begin
        {**
        @explan(说明) 通过y轴位置获得item序号 %%
        @param(y)(integer) y轴位置 %%
        @return(integer) 序号 %%
        **}
        idx := inherited;
        if idx>FItems.Count-1 then idx :=-1;
        return idx;
    end
    Function GetItemByYPos(y);
    begin
        {**
        @explan(说明) 通过y轴位置获得item %%
        @param(y)(integer) y轴位置 %%
        @return(TVirtualListItem) 项 %%
        **}
        idx := GetItemIndexByYpos(y);
        if idx >= 0 then return FItems[idx];
    end
    function GetItemIndex(item,guess);
    begin
        {**
        @explan(说明) 获得item序号 %%
        @param(item)(TVirtualListItem) item %%
        @return(integer) 序号 %%
        **}
        for i :=(guess>0?guess:0)to FItems.Count-1 do
        begin
            if item=FItems[i]then return i;
        end
        return-1;
        return FItems.Indexof(item);
    end
    function GetItemRect(item);
    begin
        {**
        @explan(说明) 获得item区域 %%
        @param(item)(TVirtualListItem) item %%
        @return(array) array(左,上,右,下) %%
        **}
        idx := GetItemIndex(item);
        if idx >= 0 then return GetItemRectByIndex(idx);
        return array();
    end
    function GetItemRectByIndex(idx);virtual;
    begin
        {**
        @explan(说明) 通过id获得item区域 %%
        @param(idx)(integer) 序号 %%
        @return(array) array(左,上,右,下) %%
        **}
        if idx >= 0 and idx<FItems.Count then
        begin
            rc := GetIndexRect(idx);
            rc[0]:= 0;
            rc[2]:= ClientRect[2];
            return rc;
            yn := GetYPos();
            h := ItemHeight;
            y :=(idx-yn)* h+100;
            return array(0,y,ClientRect[2],y+h);
        end
        return array();
    end
    function GetIndexRect(idx);override;
    begin
        {**
        @explan(说明) 通过id获得item区域 %%
        @param(idx)(integer) 序号 %%
        @return(array) array(左,上,右,下) %%
        **}
        if idx >= 0 and idx<FItems.Count then
        begin
            return inherited;
        end
        return array();
    end
    function InsertItems(its,idx);virtual;
    begin
        {**
        @explan(说明) 在位置出入项 %%
        @param(it)(array of TVirtualListItem) item %%
        @param(idx)(integer) 位置 %%
        **}
        idx0 :=(idx >= 0 and idx<FItems.Count)?idx:FItems.Count;
        idx1 := idx0;
        try
            IncPaintLock();
            for i,it in its do
            begin
                if(it is class(TVirtualListItem))and(it.Owner=self)then
                begin
                    if FHashItems[it.handle]then continue;
                    if it.Width>FxClientMax then
                    begin
                        FItemMaxItemIndex := idx0;
                        FxClientMax := it.Width;
                    end else
                    begin
                        if FItemMaxItemIndex >= idx0 then FItemMaxItemIndex++;
                    end
                    FItems.InsertBefor(it,idx0);
                    idx0++;
                    FHashItems[it.handle]:= it;
                end
            end
            ItemUpDated();
        finally
            DecPaintLock();
        end;
    end
    function InsertItem(it,idx);virtual;
    begin
        {**
        @explan(说明) 在位置出入项 %%
        @param(it)(TVirtualListItem) item %%
        @param(idx)(integer) 位置 %%
        **}
        //idx0 := FItems.Count;
        try
            IncPaintLock();
            idx0 :=(idx >= 0 and idx<FItems.Count)?idx:FItems.Count;
            if(it is class(TVirtualListItem))and(it.Owner=self)then
            begin
                if FHashItems[it.handle]then r := false;
                else
                begin
                    if it.Width>FxClientMax then
                    begin
                        FItemMaxItemIndex := idx0;
                        FxClientMax := it.Width;
                    end else
                    begin
                        if FItemMaxItemIndex >= idx0 then FItemMaxItemIndex++;
                    end
                    FItems.InsertBefor(it,idx0);
                    FHashItems[it.handle]:= it;
                    r := true;
                end
            end
            ItemUpDated();
        finally
            DecPaintLock();
        end;
        return r;
    end
    function DeleteItemByBounds(b,e);virtual;
    begin
        idx := b;
        ei := e;
        if not(idx >= 0{ and idx})then return false;
        Try
            IncPaintLock();
            while idx <= ei do
            begin
                ei--;
                if FItemMaxItemIndex>idx then FItemMaxItemIndex -= 1;
                else if FItemMaxItemIndex=idx then FItemMaxItemIndex := nil;
                it := FItems[idx];
                if it then reindex(FHashItems,array(it.Handle:nil));
                FItems.Deli(idx);
            end
            ItemUpDated();
        finally
            DecPaintLock();
        end
    end
    function DeleteItemByIndex(idx);virtual;
    begin
        {**
        @explan(说明) 删除位置的项 %%
        @param(idx)(integer) 位置 %%
        **}
        if idx >= 0 and idx<FItems.Count then
        begin
            IncPaintLock();
            try
                if FItemMaxItemIndex>idx then FItemMaxItemIndex -= 1;
                else if FItemMaxItemIndex=idx then FItemMaxItemIndex := nil;
                it := FItems[idx];
                if it then reindex(FHashItems,array(it.Handle:nil));
                FItems.Deli(idx);
                ItemUpDated();
            finally
                DecPaintLock();
            end;
            return true;
        end
        return false;
    end
    function AppendItem(v);virtual;
    begin
        {**
        @explan(说明) 追加项 %%
        @param(v)(TVirtualListItem) item %%
        **}
        return InsertItem(v,FItems.Count);
    end
    function AppendItems(vs);virtual;
    begin
        {**
        @explan(说明) 批量追加项 %%
        @param(v)(array of TVirtualListItem) 项集 %%
        **}
        id := FItems.count;
        try
            IncPaintLock();
            for i,v in vs do
            begin
                if v is class(TVirtualListItem)then
                begin
                    if FHashItems[v.handle]then continue;
                    wd := v.width;
                    if not(FItemMaxItemIndex >= 0)then
                    begin
                        FxClientMax := CalcMaxItemWidth();
                        owd := FxClientMax;
                    end
                    if FxClientMax<wd then
                    begin
                        FxClientMax := wd;
                        FItemMaxItemIndex := FItems.Count;
                    end
                    FItems.Append(v);
                    FHashItems[v.handle]:= v;
                end
            end
            ItemUpDated();
        finally
            DecPaintLock();
        end;
    end
    function ItemUpDated({flag,idx});override;
    begin
        {**
        @explan(说明) 更新状态 %%
        @param(flag)(bool) 是否强制刷新,默认当项宽度不变的时候不刷新 %%
        @param(idx)(integer) 更新id以后的序号 %%
        **}
        mx := CalcMaxItemWidth();
        IncPaintLock();
        if(FxClientMax <> mx)then
        begin
            FxClientMax := mx;
        end
        UpDateScrollBar();
        DecPaintLock();
    end
    function PaintRect(cvs,yPos,ht,FirstLine,LastLine,xPos,wd,FirstCol,LastCol);override;
    begin
        x := wd *(0-xPos);
        rc := ClientRect;
        PrevPaint(FirstLine,LastLine);
        for i := FirstLine to LastLine do
        begin
            nrc := GetIndexRect(i);
            //ri GetItemRectByIndex(i);
            it := FItems[i];
            //y := ht * (i - yPos)+100;
            it.paint(cvs,x,nrc[1],rc[2]-rc[1]-x,ht);
        end
    end
    function SetTopLine(idx);override;
    begin
        {**
        @explan(说明) 将idx行放入client区域 %%
        @param(idx)(integer) 行号 %%
        **}
        if idx >= 0 and idx<FItems.count then
        begin
            inherited;
        end
    end
    function Recycling();override;
    begin
        Clean();
        //FSI := nil;
        //FItems := nil;
        inherited;
    end
    function Clean();virtual;
    begin
        {**
        @explan(说明) 清空 %%
        **}
        FItems.Clean();
        FHashItems := array();
        FxClientMax := ColWidth;
        FItemMaxItemIndex := nil;
        InitialScroll(nil,nil,0);
    end
    function ItemInList(it);
    begin
        if it is class(TVirtualListItem)then return FHashItems[it.Handle];
        return nil;
    end
    function InvalidateItem(it,flag);
    begin
        {**
        @explan(说明) 刷新项 %%
        @param(it)(TVirtualListItem) 项 %%
        @param(flag)(bool) 是否立刻刷新 %%
        **}
        //for i,v in GetClientItems();
        if not ItemInList(it)then return;
        for i,v in GetClientItemIndexs() do
        begin
            if it=FItems[v]then
            begin
                rec := GetItemRectByIndex(v);
                if rec then InvalidateRect(rec,flag);
                return;
            end
        end
    end
    function GetClientItems();
    begin
        {**
        @explan(说明) 获得 客户区的items %%
        @return(array of TVirtualListItem) %%
        **}
        r := array();
        for i,v in GetClientItemIndexs() do
        begin
            r[i]:= FItems[v];
        end
        return r;
    end
    property Items read GetItems;
    property ItemMaxWidth read FxClientMax;
    property ItemMinWidth read FItemMinWidth write SetItemMinWidth;
    {**
    @param(Items)(array of TVirtualListItem) 项 %%
    @param(ItemMaxWidth)(integer) 最大宽度 %%
    @param(ItemHeight)(integer) 项高度 %% 
    **}
    protected
    function SetItemMinWidth(w);virtual;
    begin
        {**
        @explan(说明) 设置最大宽度
        **}
        if w>5 and FItemMinWidth <> w then
        begin
            FItemMinWidth := w;
            if FItemMinWidth>FxClientMax then
            begin
                FxClientMax := FItemMinWidth;
                ColCount := integer(FxClientMax/ColWidth+0.5);
            end
        end
    end
    function CalcMaxItemWidth();virtual;
    begin
        {**
        @explan(说明)计算最大的item宽度 %%
        **}
        mx := FItemMinWidth;
        if ifnil(FItemMaxItemIndex)then
        begin
            FItemMaxItemIndex := 0;
            for i := 0 to FItems.Count-1 do
            begin
                nwd := FItems[i].Width;
                if nwd>mx then
                begin
                    mx := nwd;
                    FItemMaxItemIndex := i;
                end
            end
        end else
        begin
            return FxClientMax;
        end
        return mx;
    end
    
    private
    FHashItems;
    function PrevPaint(begid,endid);virtual;
    begin
    end
    function GetItemCount();override;
    begin
        return FItems.Count;
    end
    function SetColWidth();override;
    begin
    end
    function SetItemCount();override;
    begin
    end
    function GetItems();
    begin
        r := array();
        for i := 0 to FItems.Count-1 do r[i]:= FItems[i];
        return r;
    end
    FItemMinWidth;
    FItemMaxItemIndex;
    FItems; //项目
    FxClientMax; //水平宽度
end
type TcustomTreeCtl = class(TVirtualList)
    {**
    @explan(说明) 树控件 %%
    **}
    type TTreeSelCHngedEvent=class(tuieventbase)
        {**
        @explan(说明) 导航选择改变消息%%
        **}
        function create(m,w,l,h);override;
        begin
            inherited;
        end
        ItemOld;
        ItemNew;
        Item;
    end
    function Create(AOwner);override;
    begin
        inherited;
        FSingleExpand := false;
        FCheckBox := false;
        FHasLine := false;
        FNodeHierarchyWidth := 20;
        FMulSelected := false;
        FMulSelects := array();
    end
    function InsertItem(it,idx);override;
    begin
        if it is class(TcustomTreeCtlNode)then return inherited;
        return false;
    end
    function InsertItems(its,idx);override;
    begin
        lst := array();
        lsti := 0;
        for i,it in its do if it is class(TcustomTreeCtlNode)then lst[lsti++]:= it;
        inherited InsertItems(lst,idx);
    end
    function WMKEYUP(o,e):WM_KEYUP;virtual;
    begin
        if not FCurrentNode then return;
        case e.charcode of
            VK_UP,VK_DOWN:
            begin
                id := GetItemIndex(FCurrentNode);
                setsel(GetItemByIndex((VK_UP=e.charcode)?(id-1):(id+1)));
            end
            VK_LEFT:
            begin
                if FCurrentNode.Expanded then 
                begin 
                    FCurrentNode.UnExpand()
                end 
                else
                begin
                    p := FCurrentNode.Parent;
                    if RootNode=p then return ;
                    SetSel(p);
                end  
            end
            VK_RIGHT:
            begin
                FCurrentNode.Expand();
            end
        end;
    end
    function hasFocus();virtual;
    begin
        return true;
    end
    function AppendItem(it);override;
    begin
        if it is class(TcustomTreeCtlNode)then return inherited;
        return false;
    end
    function SetSel(it);virtual;
    begin
        {**
        @explan(说明) 设置选中节点 %%
        @param(it)(TcustomTreeCtlNode) 节点 %%
        **}
        if(it is class(TcustomTreeCtlNode))and it.Owner=self then
        begin
            r := CallSelChange(it);
            if r then return;
            if it=RootNode then return ;
            IF HandleAllocated()then
            begin
                GoToNode(it);
            end
            if not r then InValidateRect(nil,false);
            //CallSelChange(it);	
        end
    end
    function GoToNode(it);
    begin
        if NodeInList(it)then
        begin
            //return SetTopLine(GetItemIndex(it));	 //滚动
            idxs := GetClientItemIndexs();
            id := GetItemIndex(it);
            if(idxs[0]<= id)and(idxs[length(idxs)-1]>= id)then //在可视窗口不需要滚动
            begin
                return;
            end else
            begin
                return SetTopLine(max(0,id-integer(length(idxs)/2))); //滚动 +integer(length(idxs)/2)
            end
        end else
        begin
            p := it.Parent;
            while p do
            begin
                p.Expand();
                if NodeInList(p)then
                begin
                    f := true;
                    break;
                end
                p := p.parent;
            end
            if f then return GoToNode(it);
        end
    end
    function InitializeWnd();override;
    begin
        inherited;
        if FCurrentNode then GoToNode(FCurrentNode);
    end
    function imageChanged();override;
    begin
        if imageList is class(TCustomImageList)then
        begin
            FBKItemHeight := ItemHeight;
            ItemHeight := imageList.Height+2;
        end else
        begin
            if FBKItemHeight>5 then ItemHeight := FBKItemHeight;
        end
        inherited;
    end
    function CreateNode();virtual;
    begin
        {**
        @ignore(忽略) %%
        **}
        return CreateTreeNode();
        r := new TcustomTreeCtlNode(self(true));
        return r;
    end
    function CreateTreeNode();virtual;
    begin
        r := new TcustomTreeCtlNode(self(true));
        return r;
    end
    function DeleteNode(nd);virtual;
    begin
        if FRootItem then FRootItem.DeleteNode(nd);
    end
    function NodeInList(it);
    begin
        {**
        @explan(说明)节点是否在窗口中展示 %%
        **}
        if it=FRootItem then return FRootItem;
        return ItemInList(it);
    end
    function MouseDown(o,e);override;
    begin
        if e.shiftdouble()and e.button()=mbLeft then //双击 
        begin
            //添加双击折叠展开
            it := GetItemByYpos(e.ypos);
            if it and(it.ItemCount or it.dirtype)and not(it.Expanded)then it.Expand();
            else if it and it.ItemCount and it.Expanded then
            begin
                it.UnExpand();
            end else
            CallMessgeFunction(ondblclick,o,e);
        end
    end
    function MouseUp(o,e);override;
    begin
        {**
        @explan(说明)点击%%
        **}
        if csDesigning in ComponentState then return;
        it := GetItemByYpos(e.ypos);
        if it then
        begin
            if it.MouseUp(o,e)then
            begin
                SetSel(it);
                //CallSelChange(it); //单选 
                //多选
            end
        end
        bt := e.button();
        if bt=mbRight then
        begin
            CallMessgeFunction(onrclick,o,e);
        end else
        if bt=mbLeft then
        begin
            CallMessgeFunction(onclick,o,e);
        end
        //e.skip := true;
    end
    function Recycling();override;
    begin
        //setprofiler(1+2+4);
        //exportfile(ftstream(),"","d:\\tst\\abc.stm",getprofilerinfo(true));
        if FRootItem then FRootItem.Recycling();
        FRootItem := nil;
        FCurrentNode := nil;
        FOnSelChanging := nil;
        FonEmptyNodeExapanding := nil;
        FNodeHierarchyWidth := 20;
        inherited;
    end
    function GetHierarchyByHandle(h);
    begin
        if FPaintArray then return FPaintArray[h];
    end
    function EmptyNodeExpanding(item);
    begin
        if HandleAllocated()then
        begin
            e := new TTreeSelCHngedEvent(self.Handle,0,0,0);
            e.item := item;
            e.ItemNew := item;
            e.ItemOld := item;
            calldatafunction(onEmptyNodeExapanding,self(true),e);
        end
    end
    function Clean();override;
    begin
        if FRootItem then
        begin
            FRootItem.DeleteChildren();
        end
    end
    property CurrentNode read FCurrentNode;
    property CheckBox:bool read FCheckBox write SetCheckBox;
    property HasLine:bool read FHasLine write SetHasLine;
    property OnlyLeafNodeCheckMark read FOnlyLeafNodeCheckMark write FOnlyLeafNodeCheckMark;
    //property NodeHierarchyWidth read FNodeHierarchyWidth write SetNodeHierarchyWidth;
    property RootNode read GetRootNode;
    //property MulSelected read FMulSelected write FMulSelected;
    property SingleExpand read FSingleExpand write FSingleExpand;
    property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged;
    property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging;
    property onEmptyNodeExapanding read FonEmptyNodeExapanding write FonEmptyNodeExapanding;
    protected
    function GetRootNode();virtual; //获得根节点
    begin
        if not(FRootItem)or(ifobj(FRootItem)and(FRootItem.ReCycleState <> 0))then
        begin
            FRootItem := CreateTreeNode();
        end
        //echo FRootItem.Owner,"\r\n";
        return FRootItem;
    end
    private
    FOnlyLeafNodeCheckMark;
    FNodeHierarchyWidth;
    FMulSelected;
    FMulSelects;
    function SetNodeHierarchyWidth(v);
    begin
        if v >= 0 and FNodeHierarchyWidth <> v then
        begin
        end
    end
    function CallSelChange(it);
    begin
        r := 0;
        if FCurrentNode <> it then
        begin
            t1 := FCurrentNode;
            //if t1 then InvalidateItem(t1,false);
            //InvalidateItem(it,false);
            ne := new TTreeSelCHngedEvent(self.Handle,1,1,1);
            ne.ItemOld := t1;
            ne.ItemNew := it;
            ne.Item := it;
            CallMessgeFunction(FOnSelChanging,self(true),ne);
            if ne.Skip then return true;
            FCurrentNode := it;
            CallMessgeFunction(FOnSelChanged,self(true),ne);
        end
        return r;
    end
    FOnSelChanging;
    FonEmptyNodeExapanding;
    FSingleExpand;
    FBKItemHeight;
    FOnSelChanged;
    FCurrentNode;
    FRootItem;
    FCheckBox;
    FHasLine;
    FPaintArray;
    function PrevPaint(begid,endid);virtual;
    begin
        if not FHasLine then return;
        currentline := array();
        FPaintArray := array();
        lasthi := 0;
        Chi := 0;
        //sh := new TMyArrayB();
        for i := ItemCount-1 downto begid do
        begin
            if not it then
            begin
                it := GetItemByIndex(i);
                lasthi := it.Hierarchy;
                if lasthi<1 then continue;
                currentline[lasthi]:= 1;
            end else
            begin
                it2 := GetItemByIndex(i);
                chi := it2.Hierarchy;
                if chi>0 then
                begin
                    currentline[chi]:= 1;
                    if chi<lasthi then //当前小于原有的
                    begin
                        for ii := chi+1 to lasthi do reindex(currentline,array(ii:nil));
                    end else
                    if chi >= lasthi then
                    begin
                        currentline[chi]:= 1;
                    end
                end
            end
            lasthi := chi;
            if it2 then it := it2;
            if i <= endid and it then
            begin
                FPaintArray[it.Handle]:= currentline;
                //sh.unshift( array(array2str(mrows( currentline,1),","),"===>"+inttostr(it.Hierarchy),"%%"+it.caption));
            end
        end
    end
    function SetHasLine(v); //hasline
    begin
        nv := v?true:false;
        if nv <> FHasLine then
        begin
            FHasLine := nv;
            InvalidateRect(nil,false);
        end
    end
    function SetCheckBox(v);
    begin
        bv := v?true:false;
        if bv <> FCheckBox then
        begin
            FCheckBox := bv;
        end
    end
end

implementation

initialization

end.