unit utslvclpage;
interface
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type tcustomtabsheet = class(TCustomControl) //控件页面
    {**
    @explan(说明)page控件页面 %%
    **}
    private
    FImageIndex;
    protected
    function RealSetText(s);override;
    begin
        inherited;
        p := parent;
        if ifstring(s) and p and (p is class(tcustompagecontrol)) then 
        begin
            id := p.GetPageID(self(true));
            p.SetTabText(id,s);
        end 
    end 
    public 
    function AdjustSize();override;
    begin
        class(tcontrol).AdjustSize();
    end
    function paint();override; //设计器模式下绘制网格
    begin
        drawdesigninggrid();
    end 
    function DesigningMove();override;//移动
    begin
        return false;
    end 
    function DesigningSizer();override;//调整大小
    begin
        return false;
    end 
    function create(AOwner);override;
    begin
        inherited;
        WsDlgModalFrame := true; //p.exstyle := 0x101;
        Caption := "tab";
        Visible := false;
    end 
end 
type tcustomtabcontrol = class(TCustomControl)
    private 
    fclocker;//锁
    FirstViewIndex; //第一个展示的序号
    FCurrentid; //当前
    FPrevid;   //上一个       
    [weakref]FOnSelChanged;
    [weakref]FOnSelChanging; //正在改变
    //FOnrclick;
    FTabPosition;
    FTabHeight;
    FTabItemswidth;
    FScrollBtnRect;
    Fprevrect;
    fnextrect;
    FTabRects;
    FClientarea;
    protected
    FTabItems; // 
    function setselidx(id); //选择序号
    begin
        if FCurrentid= id then return ;
        if fclocker.locked then return ;
        lk := new tcountlocker(fclocker);
        if id>=0 and id<FTabItems.length() then 
        begin
            if FCurrentid<>-1 and fOnSelChanging then 
            begin 
                e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
                doonSelChanging(self(true),e);
                if e.skip then return ;
            end    
            FPrevid := FCurrentid;
            FCurrentid := id; 
            InsureIdxVisible(id);          
            //InvalidateRect(nil,false);
            //DoControlAlign();  
            DoControlAlign();          
            if FOnSelChanged then 
            begin
                doonSelChange(self(true),new tuieventbase(0,FPrevid,FCurrentid,0));
            end
        end else 
        if FTabItems.length()=0 then 
        begin
            FPrevid := -1;
            FCurrentid := -1;   
        end 
    end 
    function RemovePageTab(id);//移除sheet
    begin
        if not(id>=0) then return ;
        FTabItems.splice(id,1);
        if id = FCurrentid then 
        begin
            if id = 0 then 
            begin
                if FTabItems.length()=0 then 
                begin
                    FCurrentid := -1;   
                    FPrevid := -1;     
                end 
            end 
            FCurrentid := -1; 
            FPrevid := -1;  
            cid := min(max(0,id-1),FTabItems.length()-1);
            if cid >=0 then 
            begin
                return setselidx(cid); 
            end else 
            begin
                if FOnSelChanged then 
                begin
                    doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
                end 
            end     
        end else 
        if id<FCurrentid then 
        begin
            FCurrentid--;    
        end 
        FPrevid := -1; 
        DoControlAlign();
        //CalcTabs();
        //InvalidateRect(nil,false);                    
    end
    function CreateTableItem(cp);
    begin
        r := new tcustomtabitem();
        r.caption := cp;
        return r;
    end 
    function CalcTabs(); //计算区域
    begin
        rec := getwndclientrect() ;//ClientRect;  //区域
        fclosebtnrect := array();     
        ft := font;
        if not ft then return ;
        fw := ft.width;
        if not fownerdraw  then 
        begin  
            fh := ft.height;
            FTabHeight := fh+8;     
        end         
        FTabItemswidth := array();
        e := new tuieventbase(0,0,0,0);
        for i := 0 to FTabItems.length()-1 do 
        begin
            pg := FTabItems[i];
            ta := pg.Caption;
            FTabItemswidth[i] := max(20, length(ta)*fw+10 ); 
            if fonmeasuretabwidth then 
            begin                
                e.wparam := i;
                CallMessgeFunction(fonmeasuretabwidth,self(true),e);
                if e.lparam>=0 then FTabItemswidth[i] := e.lparam;
            end                          
        end 
        FMaxsize :=  sum(FTabItemswidth);      
        FClientarea := rec;
        FScrollBtnRect := 0;
        Fprevrect := 0;
        fnextrect := 0;
        FTabRects := array();
        case FTabPosition of 
            alLeft:
            begin
                if FTabItemswidth then 
                begin  
                    FClientarea[0] :=rec[0]+FTabHeight;//FTabItemswidth[0];
                    if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then 
                    begin
                        FScrollBtnRect := array(rec[0],rec[3]-FTabHeight*2,rec[0]+FTabHeight,rec[3]);
                        Fprevrect := array(rec[0],rec[3]-FTabHeight*2,rec[0]+FTabHeight,rec[3]-FTabHeight);
                        Fnextrect := array(rec[0],rec[3]-FTabHeight,rec[0]+FTabHeight,rec[3]);
                    end else 
                    begin
                        FirstViewIndex := 0;
                    end 
                    ybase := rec[1];
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin 
                            FTabRects[i] := array(rec[0],ybase,FTabHeight+rec[0],ybase+FTabItemswidth[i]-1);
                            ybase+=FTabItemswidth[i];
                            if xbase>(rec[3]-FTabHeight-FTabHeight) then break;
                        end 
                        else FTabRects[i] := nil;
                    end 
                end  
            end 
            alRight:
            begin
                if FTabItemswidth then 
                begin                     
                    FClientarea[2] :=rec[2]-FTabHeight;
                    if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then 
                    begin
                        FScrollBtnRect := array(rec[2]-FTabHeight,rec[3]-FTabHeight*2,rec[2],rec[3]);
                        Fprevrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight*2,rec[2],rec[3]-FTabHeight);
                        Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]);
                    end else 
                        FirstViewIndex := 0;
                    ybase := rec[1];
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin
                            FTabRects[i] := array(rec[2]-FTabHeight,ybase,rec[2],ybase+FTabItemswidth[i]-1);
                            ybase+=FTabItemswidth[i];
                            if xbase>(rec[3]-FTabHeight-FTabHeight) then break;
                        end 
                        else FTabRects[i] := nil;
                    end 
                end  
            end 
            alTop:
            begin                
                if FTabItemswidth then 
                begin 
                                      
                    FClientarea[1] :=rec[1]+FTabHeight;
                    if fclosebtn then 
                    begin 
                        cbt := max(0,integer((FTabHeight-16)/2));
                        fclosebtnrect := array(rec[2]-18,cbt,rec[2]+2,cbt+16);
                        rec[2]-=21;
                    end 
                    if length(FTabItemswidth)>1 and (FMaxsize>(rec[2]-rec[0]-(fclosebtn?20:0))) then 
                    begin
                        FScrollBtnRect := array(rec[2]-FTabHeight*2,rec[1],rec[2],rec[1]+FTabHeight);                        
                        Fnextrect := array(rec[2]-FTabHeight,rec[1],rec[2],rec[1]+FTabHeight);
                        Fprevrect := array(rec[2]-FTabHeight*2,rec[1],rec[2]-FTabHeight,rec[1]+FTabHeight);
                    end else FirstViewIndex := 0;
                    xbase := rec[0];
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin 
                            FTabRects[i] := array(xbase,rec[1],xbase+FTabItemswidth[i]-1,FTabHeight+rec[1]);
                            xbase+=FTabItemswidth[i];
                            if xbase>(rec[2]-FTabHeight-FTabHeight) then break;
                        end else 
                            FTabRects[i] := nil;
                    end 
                end 
            end 
            alBottom:
            begin
                if FTabItemswidth then 
                begin                     
                    FClientarea[3] :=rec[3]-FTabHeight;
                    if length(FTabItemswidth)>1 and (FMaxsize>(rec[2]-rec[0])) then 
                    begin
                        FScrollBtnRect := array(rec[2]-FTabHeight*2,rec[3]-FTabHeight,rec[2],rec[3]);
                        Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]);
                        Fprevrect := array(rec[2]-FTabHeight*2,rec[3]-FTabHeight,rec[2]-FTabHeight,rec[3]);
                    end else FirstViewIndex := 0;
                    xbase := rec[0];
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin 
                            FTabRects[i] := array(xbase,rec[3]-FTabHeight,xbase+FTabItemswidth[i]-1,rec[3]);
                            xbase+=FTabItemswidth[i];
                            if xbase>(rec[2]-FTabHeight-FTabHeight) then break;
                        end else 
                            FTabRects[i] := nil;
                    end 
                end 
            end         
        end 
    end 
    private 
    function gettabsheetitem(idx); virtual;
    begin
        if idx>=0 and idx<ftabitems.length() then return FTabItems[idx];
    end 
    function SetTabPosition(v);
    begin
        if FTabPosition=v then exit;
        if not(v in array(alTop,alBottom,alLeft,alRight)) then exit;
        FTabPosition := v;        
        DoControlAlign();
        //InvalidateRect(nil,false);
    end 
    function GetTabCount();
    begin
        return FTabItems.length();
    end 
    function InsureIdxVisible(id); //确保可见
    begin
        if FScrollBtnRect and (not FTabRects[id]) then 
        begin
            tl := (FTabItems.length()-1);
            if id>FirstViewIndex then 
            begin
                while(not FTabRects[min(id+1,tl)]) do 
                begin
                    FirstViewIndex++;
                    CalcTabs();    
                end 
            end else 
            if id<FirstViewIndex then 
            begin
                while(not FTabRects[min(max(0,id),tl)]) do 
                begin
                    FirstViewIndex--;
                    CalcTabs();    
                end 
            end         
        end     
    end 
    
    function PaintTabs();//绘制tab
    begin
        lk := new tcountlocker(fclocker);
        dc := Canvas;
        dc.font := font;
        ar := 0->(FTabItems.length()-1);
        if FTabRects[FCurrentid] then 
        begin 
            ar[FCurrentid] := -100;
            ar[length(ar)] := FCurrentid; 
        end 
        for ii,i in ar  do 
        begin            
            rec := FTabRects[i];
            if rec then 
            begin  
                if fownerdraw and fondrawtab then 
                begin 
                    e := new teventdrawtab(i,(FCurrentid=i),rec,dc);
                    CallMessgeFunction(fondrawtab,self(true),e);
                    continue;
                end 
                dc.pen.color := 13158600;//rgb(200,200,200);   
                if FCurrentid=i then 
                begin
                     bc:= 0xc0b0a0;//rgb(100,192,250);//rgb(230,240,250);//rgb(200,200,200);
                end else bc := 16711422;//rgb(254,254,254);
                dc.brush.color := bc;
                dc.font.color := complementary_color(bc);///////////采用补色
                dc.draw("roundrect",array(rec[0:1],rec[2:3],array(2,2)));
                rec[1]+=2;
                it := FTabItems[i];
                if fTabPosition in array(alLeft,alRight) then 
                begin 
                    dc.SaveDC();
                    dc.trans(pi()/2,rec[0],rec[3]);
                    dc.textout(it.Caption,array(4,3));
                    //dc.drawtext(it.caption,array(0,0,rec[3]-rec[1],rec[2]-rec[0]),DT_CENTER .|DT_VCENTER);
                    dc.RestoreDC();
                end else 
                    dc.drawtext(it.caption,rec,DT_CENTER .|DT_VCENTER);   
            end 
        end 
    end 
    function PaintScroll(); //绘制滚动
    begin
        dc := Canvas;
        if FScrollBtnRect then 
        begin
            case FTabPosition of
                alTop,alBottom:
                begin 
                    rc1 := array(FScrollBtnRect[0:1]+1,(FScrollBtnRect[0]+FTabHeight-1,FScrollBtnRect[3]-1));                
                    dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLLEFT);
                    rc1 := array((FScrollBtnRect[0]+FTabHeight+1,FScrollBtnRect[1]+1),FScrollBtnRect[2:3]-1);
                    dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLRIGHT);
                end else 
                begin
                    rc1 := array(FScrollBtnRect[0:1]+1,(FScrollBtnRect[2]-1,FScrollBtnRect[3]-FTabHeight-1));
                    dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLUP);
                    rc1 := array((FScrollBtnRect[0]+1,FScrollBtnRect[3]-FTabHeight+1),FScrollBtnRect[2:3]-1);
                    dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLDOWN);
                end 
            end             
        end 
        if fclosebtnrect then 
        begin 
            dc.brush.color := 0x0000ff;
            dc.FillRect(fclosebtnrect);
            dc.pen.color := 0xf0f0f0;
            dc.moveto(fclosebtnrect[0:1]);
            dc.LineTo(fclosebtnrect[2:3]);
            dc.moveto(array(fclosebtnrect[2],fclosebtnrect[1]));
            dc.LineTo(array(fclosebtnrect[0],fclosebtnrect[3]));
        end 
    end 
    function ScrollPrev(); //滚动到下一个
    begin
        if FScrollBtnRect and  FirstViewIndex>0 then 
        begin            
            FirstViewIndex-- ;
            DoControlAlign();//CalcTabs();
            //InvalidateRect(nil,false);
        end         
    end 
    function scrollnext(); //滚动到上一个
    begin
        if FScrollBtnRect and  FirstViewIndex<FTabItems.length()-1 then 
        begin
            rec := FTabRects[FTabItems.length()-1];
            case FTabPosition of 
                alTop,alBottom:
                begin
                    if rec and (rec[2]<Fprevrect[0]) then return ;
                end 
                alLeft,alRight :
                begin
                    if rec and (rec[3]<Fprevrect[1]) then return ;
                end             
            end ;            
            FirstViewIndex++ ;
            //CalcTabs();
            //InvalidateRect(nil,false);
            DoControlAlign();
        end             
    end
       
    public
    function FontChanged(o);override;
    begin        
        DoControlAlign();
        inherited;
    end
    function GetClientRect();override;
    begin
        return getsheetrect();
    end 
    function GetPreferredSize(w,h);override;
    begin
        ft := font;
        if not ft then return ;
        if not ownerdraw then 
        begin 
            FTabHeight := ft.height+7; 
        end 
        case FTabPosition of 
            alLeft,alRight:
            begin
                w := FTabHeight;
                h := height;    
            end 
            alTop,alBottom:
            begin
                h := FTabHeight;
                w := width;
            end 
            alNone:
            begin
                h := FTabHeight;
                w := width;
            end else 
            begin 
                h := height;
                w := width;
            end         
        end 
    end 
    function hittabat(xy); //命中
    begin
        r := array();
        if (FScrollBtnRect and pointinrect(xy,FScrollBtnRect)) then 
        begin
            r["idx"] := "scroll";
            return r; 
        end 
        if (fclosebtnrect and pointinrect(xy,fclosebtnrect)) then 
        begin
            r["idx"] := "closebtn";
            return r;
        end 
        for i,v in FTabRects do 
        begin
            if v and pointinrect(xy,v) then 
            begin                
                r["idx"] := i;
                r["pos"] := array(xy[0]-v[0],xy[1]-v[1]);
                return r;
            end 
        end 
        return r;
    end  
    function getsheetrect(); //获得sheet
    begin
    {**
        @explan(说明) 获得sheet可视区域 %%
        @return(array) array(左,上,右,下) %%
    **}
        if not FClientarea then CalcTabs();
        return FClientarea;
    end 
    function DesigningClick();override;
    begin
        return true;
    end 
    function create(aowner);
    begin
        inherited; 
        FTabPosition := alTop;
        fclosebtn := false;
        FTabHeight := font.height+8;             
    end 
    function AfterConstruction();override;
    begin
        inherited;
        fclocker := new tcountkernel();
        color := 0xffffff;
        height := 200;
        width := 200;
        left := 10;
        top := 10;	        
        FirstViewIndex := 0;
        FCurrentid := -1;
        FPrevid := -1;
        FTabItems := new tnumindexarray();       
    end 
    Function SetCurSel(id); virtual; //设置当前序号
    begin
        if ifnumber(id) and id>=0 then 
        begin
            iid := integer(id);
            setselidx(iid);
        end 
    end     
    function paint();override; //绘制
    begin
        PaintTabs();
        PaintScroll();   
    end 
    function MouseUp(o,e);override;//鼠标弹起
    begin
        if e.skip then return ;
        ps := e.pos();
        mb := e.button();
        //if mb=mbRight then return ;
        if(mb=mbLeft) then 
        begin 
            if fclosebtn and fclosebtnrect and pointinrect(ps,fclosebtnrect) then 
            begin 
                if fonclosebtnclick then 
                begin 
                    e := new tuieventbase(0,0,0,0);
                    CallMessgeFunction(fonclosebtnclick,self(true),e);
                end 
                return ;
            end 
            if FScrollBtnRect and  pointinrect(ps,fnextrect) then 
            begin 
                return ScrollNext();
            end 
            if FScrollBtnRect and pointinrect(ps,Fprevrect) then 
            begin 
                return scrollprev();
            end         
        end 
        if not FTabRects then return ;
        for i := 0 to  length( FTabRects)-1 do 
        begin
            v := FTabRects[i];
            if v and pointinrect(ps,v) then 
            begin
                setselidx(i);
                if Onclick and (mb = mbLeft) then 
                begin                     
                    CallMessgeFunction(Onclick,o,e);
                end else 
                if onrclick and (mb = mbRight) then
                begin
                    CallMessgeFunction(onrclick,o,e);
                end 
                return ; 
            end 
            //
        end 
    end 
    function doonSelChange(o,e);virtual;
    begin
        CallMessgeFunction(FOnSelChanged,o,e);
    end 
    function doonSelChanging(o,e);virtual;
    begin
        CallMessgeFunction(fOnSelChanging,o,e);
    end 
    function TabRect(AIndex: Integer); //获取区域
    begin
        r := FTabRects[AIndex];
        if r then return r;
        return array(0,0,0,0);
    end 
    function GetTabText(AIndex);//获得caption
    begin
        r := "";
        if AIndex<FTabItems.length() and AIndex>0 then return FTabItems[AIndex].Caption;
        return r;
    end 
    function DoControlAlign();override;//调整位置
    begin
        CalcTabs();   
        InvalidateRect(nil,false);     
    end         
    function SetTabText(i,Value);
    begin
        {**
        @explan(说明)修改tab标签文字 %%
        @param(i)(integer)序号 %%;
        @param(Value)(string)文本 %%;
        **}
        it := FTabItems[i];
        if it and value<>it.caption then 
        begin
            it.Caption := Value;
            DoControlAlign();
            //InvalidateRect(nil,false);
        end 
    end 
    function SetTabIndex(AIndex,AIndexnew);
    begin
        {**
        @explan(说明) 修改标签的次序 %%
        @param(AIndex)(integer) 位置 %%
        @param(AIndexnew)(integer) 新位置  %%        
        **}
        if (AIndex<>AIndexnew) and (AIndex>=0) and 
           (AIndex<FTabItems.length()) and (AIndexnew>=0) and 
           (AIndexnew<FTabItems.length())   then 
        begin
            FTabItems.swap(AIndex,AIndexnew);
            if FCurrentid = AIndex then 
            begin
                FCurrentid := AIndexnew;    
            end else 
            if FCurrentid = AIndexnew then 
            begin
                FCurrentid := AIndex;
            end 
            DoControlAlign();//CalcTabs();
            //InvalidateRect(nil,false);            
        end 
    end 
    function Recycling();override;
    begin	
        FOnSelChanged := nil;
        FOnSelChanging := nil;
        FTabItems.splice(0,nil);
        inherited;  
    end 
    		{**
    			@param(cursel)(integer) 当前选中序号 %%
    			@param(TabCount)(integer) page数量 %%
    			@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
    			@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
    			@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
    		**}
    published		
    property cursel:lazyinteger read FCurrentid write SetCurSel;
    property OnSelChanged:eventhandler read FOnSelChanged write  FOnSelChanged;
    property OnSelChanging:eventhandler read FOnSelChanging write  FOnSelChanging;
    property TabCount read GetTabCount;
    property tabs:Strings read get_tabs write set_tabs;
    property TabPosition:tabalign read FTabPosition write SetTabPosition;
    property tabsheetitem:tcustomtabitem read gettabsheetitem;
    property onmeasuretabwidth:eventhandler read fonmeasuretabwidth write fonmeasuretabwidth;
    property ondrawtab:eventhandler read fondrawtab write fondrawtab;
    property ownerdraw:bool read fownerdraw write fownerdraw;
    property tabheight:lazyinteger read FTabHeight write settabheight;
    property closebtn:bool read fclosebtn write setclosebtn;
    property onclosebtnclick:eventhandler read fonclosebtnclick write fonclosebtnclick;
    private 
    fownerdraw;
    fclosebtn;
    fclosebtnrect;
    [weakref] fondrawtab;
    [weakref] fonmeasuretabwidth; 
    [weakref] fonclosebtnclick; 
    private 
    function get_tabs();
    begin
        r := array();
        for i := 0 to FTabItems.length()-1 do 
        begin 
            r[i] := FTabItems[i].Caption;
        end 
        return r ;
    end 
    function set_tabs(r);
    begin
        if not ifarray(r) then return ;
        if not NoRecycled() then return ;
        rs := array();
        for i,v in r do 
        begin 
            if ifstring(v) then rs[length(rs)] := v;    
        end 
        ts := get_tabs();
        if ts<>rs then 
        begin 
            FTabItems.splice(0,nil);
            for i,v in rs  do 
            begin 
                FTabItems.Push(CreateTableItem(v));
            end 
            AdjustSize();
            FPrevid := -1;
            FCurrentid := -1;
            if FTabItems.length()>0 then 
            begin                 
                setselidx(0);
            end 
        end     
    end 
    function setclosebtn(v);
    begin 
        nv := v?true:false;
        if nv<>fclosebtn then 
        begin 
            fclosebtn := nv;
            DoControlAlign();
        end 
    end   
    function settabheight(h);
    begin
        if not NoRecycled() then return ;
        if ownerdraw and ( h>=0) and FTabHeight<>h then 
        begin             
            FTabHeight := h;  
            AdjustSize();
        end 
    end 
end 
type tcustompagecontrol = class(tcustomtabcontrol)
    private 
    function gettabsheetitem(idx);override;
    begin
        if idx>=0 and idx<ftabitems.length() then return FTabItems[idx];
        if isacceptsheettype(idx) then 
        begin 
            for i:= 0 to ftabitems.length()-1 do 
            begin 
                it := FTabItems[i];
                if idx=it.PageSheet  then return it;        
            end 
        end 
    end 
    function gettabesheet(idx);
    begin
        if idx>=0 and idx<ftabitems.length() then 
        begin 
            return FTabItems[idx].PageSheet;
        end 
    end 
    function getactivetabsheet();
    begin
        id := cursel;
        if id>=0 then return FTabItems[id].PageSheet;
    end 

    function addtabitem(page);//添加sheet 
    begin
        //if not(page is class(tcustomtabsheet)) then return -1;	
        for i := 0 to FTabItems.length()-1 do 
        begin
            if FTabItems[i].PageSheet = page then return -1;
        end 
        if page then 
            cp := page.Caption;
        it := CreateTableItem(cp);
        FTabItems.Push(it);
        if FTabItems.length()>1 then 
        begin
            if page then 
            begin 
                page.visible := false;
            end 
        end 
        it.PageSheet := Page;            
        if  cursel=-1 then 
        begin
            setselidx(0);
        end else 
        begin
            if not (page is class(TWinControl)) then CalcTabs();
            InvalidateRect(nil,false);
        end 
    end   
    public
    function GetPreferredSize(w,h);override;
    begin
        len := ftabitems.length();
        if len<1 then 
        begin 
            w := width;
            h := height;
            return ;
        end 
        w := 100;
        h := 100;  
        for i:= 0 to len-1 do 
        begin 
            FTabItems[i].PageSheet.GetPreferredSize(wi,hi); 
            w := max(w,wi);   
            h := max(h,hi);   
        end 
        rc := ClientRect;
        bc := BoundsRect;
        dh := bc[3]-bc[1]-(rc[3]-rc[1]);
        dw := bc[2]-bc[0]-(rc[2]-rc[0]);
        w := w+dw;
        h := h+dh;
    end 
    function checknewchild(achild);override;//检查child
    begin
        r := inherited;
        if isacceptsheettype( achild) then achild.Align := alNone;
        return r;
    end 
    function create(aowner);
    begin
        faccepttype := array();
        inherited;          
        acceptsheettype(class(tcustomtabsheet));               
    end 
    function ControlAppended(AControl);override; 
    begin
        if not isacceptsheettype(AControl) {not(AControl is class(tcustomtabsheet))} then return;	
        addtabitem(AControl);
    end
    function ControlDeleted(AControl);override;
    begin
        if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
        id := GetPageID(AControl);
        RemovePageTab(id);
        //fcoolbands.deleteitem(AControl,true);       
    end
    Function SetCurSel(id);override; //设置当前序号
    begin
        if isacceptsheettype(id) {id is class(tcustomtabsheet)} then 
        begin
            return SetCurSel(GetPageID(id));
        end 
        return inherited;
    end     
    function GetPageID(page);//获得page序号
    begin
        {**
        @explan(说明)获取page的序号 %%
        **}
        r := -1;
        if  isacceptsheettype(page) then 
        begin
            for it := 0 to FTabItems.length()-1 do 
            begin
                if FTabItems[it].PageSheet = page then
                begin
                    return it;
                end 
            end 
        end 
        return r;
    end 
    function DoControlAlign();override;//调整位置
    begin
        inherited;      
        for i := 0 to FTabItems.length()-1 do 
        begin
            pg := FTabItems[i].PageSheet;
            if not pg then continue;
            pg.Align := alNone;
            curid := cursel;
            if (pg is class(TWinControl)) and pg.WsPopUp then
            begin
                if i=curid  then 
                begin
                    pg.show();
                end 
                continue;
            end 
            if i=curid then
            begin
                //pg.Visible := true;
                rc := getsheetrect(); 
                if not rc then return ;
                pg.Visible := ((rc[3]>rc[1]) and (rc[2]>rc[0])); 
                rc[1]+=1;
                if csDesigning in ComponentState then 
                begin
                    rc[0]+=2;
                    rc[2]-=2;
                    rc[3]-=2;
                end 
                pg.SetBoundsrect(rc);                   
            end else 
            begin 
                pg.Visible := false;
            end 
        end 		
    end         
   
    function Recycling();override;
    begin	
        FOnSelChanged := nil;
        FOnSelChanging := nil;
        FTabItems.splice(0,nil);
        inherited;  
        faccepttype := array();
    end 
    function acceptsheettype(ty,del);
    begin 
        idx := 0;
        if ifstring(ty) and ty then 
        begin
            ob := findclass(ty);
            if ob then return  acceptsheettype(ob,del);   
            return false;
        end 
        if ty is class(tcontrol) then 
        begin 
            idx := inttostr(int64(ty));            
        end 
        if idx = 0 then return 0;
        if del then 
        begin 
            reindex(faccepttype,array(idx:nil));        
        end else 
        begin         
            faccepttype[idx] := ty; 
        end    
        return true;
    end 
    		{**
    			@param(activetabsheet)(tcustomtabsheet) 当前选中的页面 %%
    			@param(tabsheet)(tcustomtabsheet) 通过下标获得页面 %%
    		**}
    published		
    property activetabsheet:tcustomtabsheet read getactivetabsheet write SetCurSel;
    property tabsheet read gettabesheet ;
    private 
    tabs;
    faccepttype;
    private 
    function isacceptsheettype(c);
    begin
        for i,v in faccepttype do 
        begin 
            if c is v then return true;
        end 
    end   
end 
implementation
type tcustomtabitem = class() //
    {**
    @explan(说明)tab控件标签对象 %%
    **}
    private
    FCaption;
    FVisible;
    [weakref]FPageSheet;
    function SetVisible(v);//设置可见
    begin
        nv := v?true:false;
        if nv<>FVisible then 
        begin
            FVisible := v;
        end 
    end 
    function SetCaption(s);//设置标签
    begin
        if ifstring(s) and s<>FCaption then 
        begin
            FCaption := s;
            if PageSheet  then PageSheet.Caption := s;
        end 
    end         
    public
    function Create();//构造
    begin
        FVisible:= true;
        FCaption := "";
    end 
    published
    property Caption read FCaption write SetCaption;
    property PageSheet read FPageSheet Write FPageSheet;
    _tag;
end 
type teventdrawtab = class(tuieventbase)
{**
    @explan(说明)单元格绘制消息对象 %%
    @param(idx)(integer) 序号 %%
    @param(sel)(integer) 是否选中 %%
    @param(rec)(array(左上右下)) 区域 %%
    @param(canvas)(TCanvas) 画布 %%
**}
    function create(id,s,rc,cvs);
    begin
        inherited create(0,0,0,0);
        idx := id;
        sel := s;
        rec := rc;   
        canvas := cvs; 
    end 
    idx;
    sel;
    rec;
    canvas;
end 
initialization

end.