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 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 tcustompagecontrol = class(TCustomControl)
    private 
    fclocker;//锁
    FirstViewIndex; //第一个展示的序号
    FCurrentid; //当前
    FPrevid;   //上一个
    FTabItems; //    
    [weakref]FOnSelChanged;
    [weakref]FOnSelChanging; //正在改变
    //FOnrclick;
    FTabPosition;
    FTabHeight;
    FTabItemswidth;
    FScrollBtnRect;
    Fprevrect;
    fnextrect;
    FTabRects;
    FClientarea;
    private 
    function gettabesheet(idx);
    begin
        if idx>=0 then return FTabItems[idx];
    end 
    function getactivetabsheet();
    begin
        id := FCurrentid;
        if id>=0 then return FTabItems[id];
    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 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+10 );             
        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
            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 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();            
            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 PaintTabs();//绘制tab
    begin
        dc := Canvas;
        dc.font := font;
        for i := 0 to  FTabItems.length()-1 do 
        begin            
            rec := FTabRects[i];
            dc.pen.color := 13158600;//rgb(200,200,200);
            if rec then 
            begin                             
                if FCurrentid=i then 
                begin
                    dc.brush.color := 0xf0f0f0;//rgb(100,192,250);//rgb(230,240,250);//rgb(200,200,200);
                end else dc.brush.color := 16711422;//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
    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; 
        CalcTabs();
        InvalidateRect(nil,false);                    
    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  FCurrentid=-1 then 
        begin
            setselidx(0);
        end 
    end   
    public
    function FontChanged(o);override;
    begin
        inherited;
        DoControlAlign();
    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;         
    end 
    function AfterConstruction();override;
    begin
        inherited;
        fclocker := new tcountkernel();
        color := 0xffffff;
        height := 200;
        width := 200;
        left := 10;
        top := 10;	
        FTabPosition := alTop;
        FirstViewIndex := 0;
        FCurrentid := -1;
        FPrevid := -1;
        FTabItems := new tnumindexarray();       
    end 
    function ControlAppended(AControl);override; 
    begin
        if not(AControl is class(tcustomtabsheet)) then return;	
        addtabitem(AControl);
    end
    function ControlDeleted(AControl);override;
    begin
        if not(AControl is class(tcustomtabsheet)) then return;
        id := GetPageID(AControl);
        RemovePageTab(id);
        //fcoolbands.deleteitem(AControl,true);       
    end
    Function SetCurSel(id); //设置当前序号
    begin
        if id is class(tcustomtabsheet) then 
        begin
            return SetCurSel(GetPageID(id));
        end 
        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
        ps := e.pos();
        mb := e.button();
        //if mb=mbRight then return ;
        if (mb=mbLeft) and FScrollBtnRect and  pointinrect(ps,fnextrect) then 
        begin
            if e.Button() = mbLeft then 
                ScrollNext();
            return ;
        end else 
        if (mb=mbLeft) and 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 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 GetPageID(page);//获得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];
            pg := it.PageSheet;
            if it and pg then 
            begin
                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 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 
            CalcTabs();
            InvalidateRect(nil,false);            
        end 
    end 
    function Recycling();override;
    begin	
        FOnSelChanged := nil;
        FOnSelChanging := nil;
        FTabItems.splice(0,nil);
        inherited;  
    end 
    		{**
    			@param(cursel)(integer) 当前选中序号 %%
    			@param(activetabsheet)(tcustomtabsheet) 当前选中的页面 %%
    			@param(tabsheet)(tcustomtabsheet) 通过下标获得页面 %%
    			@param(TabCount)(integer) page数量 %%
    			@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
    			@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
    			@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
    		**}
    published		
    property activetabsheet:tcustomtabsheet read getactivetabsheet write SetCurSel;
    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 TabPosition:tabalign read FTabPosition write SetTabPosition;
    property tabsheet read gettabesheet ;
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 is class(tcustomtabsheet) then PageSheet.Caption := s;
        end 
    end         
    public
    function Create();//构造
    begin
        FVisible:= true;
        FCaption := "";
    end 
    property Caption read FCaption write SetCaption;
    property PageSheet read FPageSheet Write FPageSheet;
end 
initialization

end.