unit utslvclpage;
interface
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type tcustomtabitem = class() //TTCITEMA
    {**
    @explan(说明)tab控件标签对象 %%
    **}
    private
    FPageCtrl;
    FCaption;
    FVisible;
    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;
            psztext := FCaption;
            if PageSheet is class(tcustomtabsheet) then PageSheet.Caption := s;
        end 
    end         
    public
    function Create();
    begin
        FVisible:= true;
    end 
    property Caption read FCaption write SetCaption;
    property PageSheet read FPageSheet Write FPageSheet;
end 
type tcustomtabsheet = class(TCustomControl)
    {**
    @explan(说明)page控件页面 %%
    **}
    private
    FImageIndex;
    protected
    function RealSetText(s);override;
    begin
        inherited;
        if ifstring(s) and Parent then 
        begin
            id := parent.GetPageID(self(true));
            Parent.SetTabText(id,s);
        end 
    end 
    function SetParent(p);override;
    begin
        if (P is class(tcustompagecontrol) ) and parent<>p then 
        begin
            oldparent := Parent;
            if oldparent then 
            begin
                oldparent.RemovePage(self);
            end 
            inherited;
            parent.addtabitem(self);            
        end else 
        if not(p is class(TWincontrol)) then 
        begin
            if Parent then 
            begin 
                id := Parent.GetPageID(self);
                Parent.RemovePageTab(id);
            end 
            inherited;
        end 
    end 
    public 
    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;
        Caption := "tab";
        Visible := false;
        FTabVisible := True;   
    end 
    function CreateParams(p);override;
    begin
        inherited;
        p.exstyle := 0x101;
    end 		
end 
type tcustompagecontrol = class(TCustomControl)
    private 
    FirstViewIndex;
    FCurrentid;
    FPrevid;
    FTabItems; //
    
    FOnSelChange;
    FOnSelChanging;
    //FOnrclick;
    FTabPosition;
    FTabHeight;
    FTabItemswidth;
    FScrollBtnRect;
    Fprevrect;
    fnextrect;
    FTabRects;
    FClientarea;
    function SetTabPosition(v);
    begin
        if FTabPosition=v then exit;
        if not(v in array(alTop,alBottom,alLeft,alRight)) then exit;
        FTabPosition := v;        
        InvalidateRect(nil,false);
        DoControlAlign();
    end 
    function GetTabCount();
    begin
        return FTabItems.length();
    end 
    function CreateTableItem(cp);
    begin
        r :=  new tcustomtabitem();
        r.caption := cp;
        return r;
    end 
    function CalcTabs(); //计算区域
    begin
        rec := ClientRect;  //区域
        ft := font;
        fw := ft.width;
        fh := ft.height;
        FTabHeight := fh+7;
        FTabItemswidth := array();
        for i := 0 to FTabItems.length()-1 do 
        begin
            pg := FTabItems[i];
            ta := pg.Caption;
            FTabItemswidth[i] := max(20, length(ta)*fw+8 );             
        end 
        FMaxsize := 0;
        if FTabPosition in array(alLeft,alRight) then 
        begin
            FTabItemswidth := zeros(length(FTabItemswidth))+maxvalue(FTabItemswidth);   
            FMaxsize :=  length(FTabItemswidth)*FTabHeight;           
        end  else 
        begin
            FMaxsize :=  sum(FTabItemswidth);
        end 
        FClientarea := rec;
        FScrollBtnRect := 0;
        Fprevrect := 0;
        fnextrect := 0;
        FTabRects := array();
        case FTabPosition of 
            alLeft:
            begin
                if FTabItemswidth then 
                begin                     
                    FClientarea[0] :=rec[0]+FTabItemswidth[0];
                    if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then 
                    begin
                        FScrollBtnRect := array(rec[0],rec[3]-FTabHeight*2,rec[0]+FTabItemswidth[0],rec[3]);
                        Fprevrect := array(rec[0],rec[3]-FTabHeight*2,rec[0]+FTabItemswidth[0],rec[3]-FTabHeight);
                        Fnextrect := array(rec[0],rec[3]-FTabHeight,rec[0]+FTabItemswidth[0],rec[3]);
                    end else 
                    begin
                        FirstViewIndex := 0;
                    end 
                    ybase := 0;
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin 
                            FTabRects[i] := array(0,ybase,FTabItemswidth[0],ybase+FTabHeight);
                            ybase+=FTabHeight;
                            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]-FTabItemswidth[0];
                    if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then 
                    begin
                        FScrollBtnRect := array(rec[2]-FTabItemswidth[0],rec[3]-FTabHeight*2,rec[2],rec[3]);
                        Fprevrect := array(rec[2]-FTabItemswidth[0],rec[3]-FTabHeight*2,rec[2],rec[3]-FTabHeight);
                        Fnextrect := array(rec[2]-FTabItemswidth[0],rec[3]-FTabHeight,rec[2],rec[3]);
                    end else 
                        FirstViewIndex := 0;
                    ybase := 0;
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin
                            FTabRects[i] := array(rec[2]-FTabItemswidth[0],ybase,rec[2],ybase+FTabHeight);
                            ybase+=FTabHeight;
                            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 length(FTabItemswidth)>1 and (FMaxsize>(rec[2]-rec[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 := 0;
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin 
                            FTabRects[i] := array(xbase,0,xbase+FTabItemswidth[i],FTabHeight);
                            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 := 0;
                    for i,v in FTabItemswidth do 
                    begin 
                        if i>=FirstViewIndex then 
                        begin 
                            FTabRects[i] := array(xbase,rec[3]-FTabHeight,xbase+FTabItemswidth[i],rec[3]);
                            xbase+=FTabItemswidth[i];
                            if xbase>(rec[2]-FTabHeight-FTabHeight) then break;
                        end else 
                            FTabRects[i] := nil;
                    end 
                end 
            end         
        end 
    end 
    function InsureIdxVisible(id); //确保可见
    begin
        if FScrollBtnRect and (not FTabRects[id]) then 
        begin
            if id>FirstViewIndex then 
            begin
                while(not FTabRects[min(id+1,(FTabItems.length()-1))]) do 
                begin
                    FirstViewIndex++;
                    CalcTabs();    
                end 
            end else 
            if id<FirstViewIndex then 
            begin
                while(not FTabRects[id]) do 
                begin
                    FirstViewIndex--;
                    CalcTabs();    
                end 
            end 
        
        end     
    end 
    function setselidx(id); //选择序号
    begin
        if FCurrentid= id then return ;
        if id>=0 and id<FTabItems.length() then 
        begin
            FPrevid := FCurrentid;
            FCurrentid := id; 
            InsureIdxVisible(id);          
            InvalidateRect(nil,false);
            DoControlAlign();
            doonSelChanging(self(true),new tuieventbase(0,0,0,0));
            doonSelChange(self(true),new tuieventbase(0,0,0,0));
        end else 
        if FTabItems.length()=0 then 
        begin
            FPrevid := FCurrentid;
            FCurrentid := -1;    
        end 
    end 
    function PaintTabs();
    begin
        dc := Canvas;
        for i := 0 to  FTabItems.length()-1 do 
        begin            
            rec := FTabRects[i];
            dc.pen.color := rgb(200,200,200);
            if rec then 
            begin            
                 
                if FCurrentid=i then 
                begin
                    dc.brush.color := rgb(100,192,250);//rgb(230,240,250);//rgb(200,200,200);
                end else dc.brush.color := rgb(254,254,254);
                dc.draw("roundrect",array(rec[0:1],rec[2:3],array(2,2)));
                //dc.draw("rectangle",array(rec[0:1],rec[2:3],array(5,5)));
                rec[1]+=2;
                dc.drawtext(FTabItems[i].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 
    end 
    function ScrollPrev(); //滚动到下一个
    begin
        if FScrollBtnRect and  FirstViewIndex>0 then 
        begin            
            FirstViewIndex-- ;
            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);
        end     
        
    end 
    public 
    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;
        color := 0xffffff;
        height := 200;
        width := 200;
        left := 10;
        top := 10;	
        FTabPosition := alTop;
        FirstViewIndex := 0;
        FCurrentid := -1;
        FPrevid := -1;
        FTabItems := new tnumindexarray();        
    end 

    Function SetCurSel(id);
    begin
        if id is class(tcustomtabsheet) then 
        begin
            return SetCurSel(GetPageID(id));
        end 
        if ifnumber(id) then 
        begin
            iid := integer(id);
            setselidx(iid);
        end 
    end 

    
    function paint();override; //绘制
    begin
        PaintTabs();
        PaintScroll();   
    end 
    function MouseUp(o,e);override;
    begin
        ps := e.pos();
        if e.button()=mbRight then return ;
        if FScrollBtnRect and  pointinrect(ps,fnextrect) then 
        begin
            if e.Button() = mbLeft then 
                ScrollNext();
            return ;
        end else 
        if FScrollBtnRect and pointinrect(ps,Fprevrect) then 
        begin
            if e.Button() = mbLeft then 
                scrollprev();
            return ;
        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 e.Button() = mbLeft then 
                begin 
                    
                    CallMessgeFunction(Onclick,o,e);
                end else 
                if e.Button() = mbRight then
                begin
                    CallMessgeFunction(onrclick,o,e);
                end  
            end 
            e.skip := true;
        end 
    end 
    function doonSelChange(o,e);virtual;
    begin
        CallMessgeFunction(OnSelChange,o,e);
    end 
    function doonSelChanging(o,e);virtual;
    begin
        CallMessgeFunction(OnSelChanging,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);
    begin
        r := "";
        if AIndex<FTabItems.Count and AIndex>0 then return FTabItems[AIndex].Caption;
        return r;
    end 
    function IsContainer(cd);override;
    begin
        if cd is class(tcustomtabsheet) then return true;
        return false;
    end 
    function GetPageID(page);
    begin
        {**
        @explan(说明)获取page的序号 %%
        **}
        r := -1;
        if page is class(tcustomtabsheet) 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
        CalcTabs();        
        for i := 0 to FTabItems.length()-1 do 
        begin
            it := FTabItems[i];
            if it and it.PageSheet then 
            begin
                pg := it.PageSheet;
                if i=FCurrentid then
                begin
                    pg.Visible := true;
                    rc := getsheetrect(); 
                    if not rc then return ;
                    rc[1]+=1;
                    if csDesigning in ComponentState then 
                    begin
                        rc[0]+=2;
                        rc[2]-=2;
                        rc[3]-=2;
                    end 
                    pg.SetBoundsrect(rc);
                end else 
                    pg.Visible := false;
            end 
        end 		
    end 
    function RemovePageTab(id);
    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;        
                 end 
             end 
             return setselidx(id-1);     
         end else 
         if id<FCurrentid then 
         begin
             FCurrentid--;    
         end 
         CalcTabs();
         InvalidateRect(nil,false);                    
    end 
    function RemovePage(i);
    begin
        {**
        @explan(说明)移除page %%
        @param(i)(integer) page序号 %%;
        **}
        ii := -1;
        if ifnumber(i) then ii := i;
        else 
            ii := GetPageID(i);	
        if ii<0 or ii>=FTabItems.length() then return ;
        item := FTabItems[ii];
        if ifobj(item) then 
        begin
            pg := item.PageSheet;
            if pg then pg.parent := nil;
        end 
        //setselidx(0); //移除
    end 
    function addcontrol(page);
    begin
        {**
        @explan(说明) 添加控件 %%
        @param(page)(tcustomtabsheet) sheet;
        **}
        if not(page is class(tcustomtabsheet)) then return -1;
        add := true;
        for i := 0 to Controls.count-1 do 
        begin
            if Controls[i]=page then  add := false;
        end 
        if add then
        begin
            page.Visible := false;
            page.parent := self;
        end 
    end 
    function addtabitem(page);//添加sheet 
    begin
        if not(page is class(tcustomtabsheet)) then return -1;	
        add := true;
        for i := 0 to FTabItems.length()-1 do 
        begin
            if FTabItems[i].PageSheet = page then add := false;
        end 
        add1 := false;
        for i := 0 to Controls.count-1 do 
        begin
            if Controls[i]=page then  add1 := true;
        end 
        if add and add1	 then 
        begin
            it := CreateTableItem(page.caption);
            FTabItems.Push(it);
            if FTabItems.length()>1 then page.visible := false;
            it.PageSheet := Page;            
            if {HandleAllocated() and} FCurrentid=-1 then 
            begin
                setselidx(0);
            end 
        end 
    end 
    function InitializeWnd();override;
    begin
        inherited;
    end 	
    
    function AppendPage(page);
    begin
        {**
        @explan(说明)添加pagesheet %%
        @param(page)(tcustomtabsheet)sheet %%;
        **}
        if not(page is class(tcustomtabsheet)) then return -1;
        addcontrol(page);
    end 
    function SetTabText(i,Value);
    begin
        {**
        @explan(说明)修改tab标签文字 %%
        @param(i)(integer)序号 %%;
        @param(Value)(string)文本 %%;
        **}
        it := FTabItems[i];
        if it then 
        begin
            if Value = it.caption then 
            begin
                CalcTabs();
                InvalidateRect(nil,false);    
            end else 
            begin
                it.Caption := Value;
            end 
        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(AIndex,AIndexnew);
            CalcTabs();
            InvalidateRect(nil,false);            
        end 
    end 
    function Recycling();override;
    begin	
        FTabItems.splice(0,FTabItems.length());
        inherited;
        
    end 
    		{**
    			@param(cursel)(integer) 当前选中序号 %%
    			@param(TabCount)(integer) page数量 %%
    			@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
    			@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
    			@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
    		**}
    property cursel:lazyinteger read FCurrentid write SetCurSel;
    property OnSelChange:eventhandler read FOnSelChange write  FOnSelChange;
    property OnSelChanging:eventhandler read FOnSelChanging write  FOnSelChanging;
    //property onrclick:eventhandler read Fonrclick write Fonrclick;
    property TabCount read GetTabCount;
    property TabPosition:tabalign read FTabPosition write SetTabPosition;
end 

implementation
initialization

end.