界面库

优化一些接口

designer/utslvcldcomponents.tsf

@@ -928,6 +928,7 @@ type TDVirutalWindow = class(TCustomControl) //
         width := 30;
         height := 30;
         FWindowFileds := array("left","top","height","width"); 
+        ParentFont := true;
     end 
     function paint();override;
     begin
@@ -3639,6 +3640,25 @@ type TDTabSheet = class(TDComponent)
         inherited;
     end 
 end 
+type tdtabctl = class(TDComponent)
+    function HitTip();override;
+    begin
+        return inherited;
+    end 
+    function bitmapinfo();override;
+    begin
+        return gettabctlbitmapinfo();
+
+    end 
+    function WndClass();override;
+    begin
+        return Class(ttabctl);
+    end 
+    function Create(AOwner);override;
+    begin
+        inherited;
+    end 
+end 
 type TDPage = class(TDComponent)
     function HitTip();override;
     begin
@@ -3705,7 +3725,7 @@ begin
         class(TDForm),class(TDPanelForm),
         class(TDPanel),class(TDGroupBox),
         class(TDPairSplitter),class(TDPairSplitterSide),
-        class(TDPage),class(TDTabSheet),
+        class(tdtabctl),class(TDPage),class(TDTabSheet),
         class(TDTimer),
         class(tdworkerctl),
         class(TDImageList),

designer/utslvcldesignerresource.tsf

@@ -72,6 +72,7 @@ function gettoolbarbitmapinfo();
 function getlabelbitmapinfo();
 function getlistviewbitmapinfo();
 function getgridctlbitmapinfo();
+function gettabctlbitmapinfo();
 implementation
 function getexamplesbmpinfo();
 begin
@@ -1477,4 +1478,20 @@ BFC6105000000097048597300000EC300000EC301C76FA864000000A849444154
 0EF0594008906401B620220406970F686A01C850644C2C20CA024A008D2DF8FF1
 F0006015AA04B38837B0000000049454E44AE42608200";
 end
+function gettabctlbitmapinfo();
+begin
+    return "0502000000060400000074797065000203000000696D670006040000006461746
+100025F01000089504E470D0A1A0A0000000D4948445200000014000000140806
+0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0
+BFC6105000000097048597300000EC300000EC301C76FA864000000F449444154
+384FD595A10E84301044EF93F9051CC18244D460B120B128122C966FC0F6F236E
+CD123A55072E626D96C774A67A785949731C62649E28D711C6D2C5E2CCCB2CCB6
+6D2BD1759D64152DCBF276B04E04191CC1033EC1B346CA07057D3C3B60EE088EE
+7A782F33C5F0BEA1C811001E7E3790F4141757237B4D1A9602CD4FD9F0852B8A0
+41DFF736CF733B4D938CAF1074B8AEAB08354DB3313BE09765D9AA1D41878026C
+3306CD50E78BEB923820E415555B210376CB9AE6BE18BA290466417970ED33495
+8C20DBD45A33E7EB22E810017875E73A24E3FC781C970E631174F8045F82EE05F
+B343E9743E817101BC618FB068D943D91A4D430F90000000049454E44AE426082
+00";
+end      
 end.

designer/utslvcldpropertytypes.tsf

@@ -2537,6 +2537,26 @@ type tGridCellAlignPos3BoxEdit=class(TOneSelectCell ,TPropertyAlign3)
         return SelRange;
     end 
 end
+type tGridCelllistseltypeEdit=class(TOneSelectCell ,TPropertylistseltype)
+    function CellDrawLabel(dc,rect,d);override;
+    begin
+        if ifarray(d)    then 
+        begin 
+            dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
+        end     
+    end 
+    function create(AOwner);override; 
+    begin
+        inherited;    
+        class(TPropertylistseltype).Create();
+    end 
+    private 
+    function SelPalRange();virtual;
+    begin
+        return SelRange;
+    end 
+end
+
 type tGridCellDayOfWeekBoxEdit=class(TOneSelectCell,TPropertyDayOfWeek)
     function CellDrawLabel(dc,rect,d);override;
     begin
@@ -4506,6 +4526,7 @@ begin
         
         class(tGridCellDayOfWeekBoxEdit),
         class(TGridCellPairIntEdit),
+        class(tGridCelllistseltypeEdit),
         class(TGridCellPairSpliterTypeEdit),
         class(tGridCellAlignPosBoxEdit),
         class(TGridCellTreeViewDataEdit),

funcext/tvclib/tcontrol.tsf

@@ -66,6 +66,7 @@ type tcontrol = class(tcomponent)
     FOnShowHint;
     FOnStartDock;
     FOnStartDrag;  
+    fonfontchanged;  
     //FOnTripleClick;  
     autoref  
     protected //可以重写的函数以及使用的成员变量
@@ -679,6 +680,8 @@ type tcontrol = class(tcomponent)
     procedure FontChanged(Sender:TObject);virtual;
     begin
         //if parent then parent.FontChanged(Sender);
+        e := new tuieventbase();
+        CallMessgeFunction(fonfontchanged,self(true),e);
     end
     function GetClientRect();virtual; // //type_tcontrol visual size of client area  
     begin
@@ -1460,6 +1463,7 @@ type tcontrol = class(tcomponent)
     	@param(Visible)(bool) 是否可见 %%
     **}
     property OnMouseUp:eventhandler read FOnMouseUp write FOnMouseUp;
+    property onfontchanged:eventhandler read fonfontchanged write fonfontchanged;
     property OnClick:eventhandler	read FOnClick write FOnClick;
     property onrclick:eventhandler read Fonrclick write Fonrclick;
     property OnDblClick:eventhandler	read FOnDblClick write FOnDblClick;

funcext/tvclib/tslvcl.tsf

@@ -2411,6 +2411,12 @@ type tpagecontrol = class(tcustompagecontrol)
         inherited;
     end 
 end 
+type ttabctl = class(t_custom_tab_ctl)
+    function create(AOwner);
+    begin
+        inherited;
+    end
+end 
 //二分控件
 type TPairSplitterSide=class(TCustomControl)
     {**

funcext/tvclib/twincontrol.tsf

@@ -793,6 +793,7 @@ type TWinControl = class(tcontrol)
     end 
     procedure FontChanged(Sender:TObject);override;
     begin
+        inherited;
         for i := 0 to ControlCount-1 do
         begin
             it := Controls[i];            
@@ -803,6 +804,7 @@ type TWinControl = class(tcontrol)
             //InvalidateRect(nil,false);
             //it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
         end 
+        
     end
     function CMPARENTFONTCHANGED(o,e):CM_PARENTFONTCHANGED;virtual;
     begin

funcext/tvclib/utslmemo.tsf

@@ -640,6 +640,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     private
     FSymchars;
     [weakref]fongutterclick;//点击 
+    [weakref]fonchanged;//Îı¾¸Ä±ä 
+    [weakref]foncaretposchanged;//¹â±êλÖøıä 
     ftmemlockv;
     fundoing; //清空unredo标记
     fredoing; //清空unredo标记
@@ -1315,9 +1317,19 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     function DoTextChanged(p);virtual;//文本改变
     begin
         //改变 
+        if fonchanged then 
+        begin
+            e := new tuieventbase(0,0,0,0);
+            CallMessgeFunction(fonchanged,self(true),e);  
+        end    
     end
     function DoCaretPosChanged();virtual;//caret位置改变
     begin
+        if foncaretposchanged and  fcaretcreated then  
+        begin
+            e := new tuieventbase(0,0,0,0);
+            CallMessgeFunction(foncaretposchanged,self(true),e);            
+        end    
     end
     function ClearUndo(); //清空undo
     begin
@@ -1700,6 +1712,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
     property guttercolor:color read fguttercolor write setguttercolor;  //行标颜色
     property selectbkcolor:color read fselectbkcolor  write setselectbkcolor; //选中的颜色
     property ongutterclick:eventhandler read fongutterclick write fongutterclick;
+    property onchanged:eventhandler read fonchanged write fonchanged;
+    property oncaretposchanged:eventhandler read foncaretposchanged write foncaretposchanged;
     {**
     @param(ReadOnly)(bool) 是否只读%%
     @param(Text)(string) 文本%%

funcext/tvclib/utslvclpage.tsf

@@ -1,6 +1,564 @@
 unit utslvclpage;
 interface
 uses utslvclauxiliary,utslvclbase,utslvclgdi;
+type t_custom_tab_ctl = class(TCustomControl)
+    private 
+    fclocker;//锁
+    FirstViewIndex; //第一个展示的序号
+    FCurrentid; //当前
+    FPrevid;   //上一个
+    FTabItems; //    
+    [weakref]FOnSelChanged;
+    [weakref]FOnSelChanging; //正在改变
+    //FOnrclick;
+    FTabPosition;
+    FTabHeight;
+    FTabItemswidth;
+    FScrollBtnRect;
+    Fprevrect;
+    fnextrect;
+    FTabRects;
+    FClientarea;
+    private 
+    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 CalcTabs(); //计算区域
+    begin
+        rec := ClientRect;  //区域
+        FTabItemswidth := array();
+        for i := 0 to FTabItems.length()-1 do 
+        begin
+            wd := FTabItems[i].width;
+            FTabItemswidth[i] := wd;             
+        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 ybase>(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 ybase>(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 not(id>=0 and id<FTabItems.length()) then return 0;
+        while FScrollBtnRect and (not FTabRects[id]) do 
+        begin
+            if id>FirstViewIndex then 
+            begin
+                FirstViewIndex++;
+            end else 
+            begin
+                FirstViewIndex--;
+            end 
+            CalcTabs();
+        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);
+            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
+        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
+                    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)));
+                rec[1]+=2;
+                it := FTabItems[i];
+                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 
+    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() 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 HitTesttabat(xy);
+    begin
+        r := array();
+        {if pointinrect(xy,fnextrect) then 
+        begin
+            r["idx"] :=-1;
+            return r; 
+        end 
+        if pointinrect(xy,Fprevrect) then 
+        begin
+            r["idx"] := -2;
+        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 inserttab(tbs,idx);virtual;
+    begin
+        nitem := array();
+        ti := 0;
+        ftw := font.width;
+        for i,v in tbs do 
+        begin
+            if not ifstring(v) then return 0;
+            it := new t_tab_item(v);
+            it.width := ftw*length(v)+10;
+            nitem[ti++] := it;            
+        end 
+        if not nitem then return 0;
+        len := FTabItems.length();
+        if not(idx>=0 and idx<=len) then 
+        begin 
+            nidx := len;
+        end else nidx := idx;
+        n := length(nitem);
+        if FCurrentid >=idx then FCurrentid+=n;
+        FTabItems.splices(nidx,0,nitem);
+        lk := new tcountlocker(fclocker);
+        for i:= nidx to nidx+n do 
+            measureidx(i);
+        CalcTabs();
+        InvalidateRect(nil,false);
+    end 
+    function deltab(idx,n); virtual;//删除
+    begin
+        len := FTabItems.length()-1;
+        if not( n>0) then n := 1;
+        nidx := idx;
+        if not(idx>=0 and idx<=len) then 
+        begin 
+            return 0;
+        end
+        if not(idx>=0 and idx<=len) then 
+        begin 
+            nidx := len;
+        end else nidx := idx;
+        FTabItems.splice(nidx,n);
+        CalcTabs();
+        if FCurrentid >(idx+n-1)   then 
+        begin
+            FCurrentid -=n;   
+            InvalidateRect(nil,false);
+        end else 
+        if FCurrentid>=idx and FCurrentid<(idx+n-1) then 
+        begin
+            FCurrentid := -1;
+            setselidx( max(0,idx-1));
+        end 
+    end 
+    function DesigningClick();override;
+    begin
+        return true;
+    end 
+    function create(aowner);
+    begin
+        inherited;  
+        fownerdraw := 0;
+        tabheight := 25;       
+    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 SetCurSel(id); //设置当前序号
+    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 csDesigning in ComponentState then return;
+        if e.skip then return ;
+        ps := e.pos();
+        mb := e.button();
+        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 DoControlAlign();override;//调整位置
+    begin
+        CalcTabs();        
+    end  
+    function gettabbyidx(idx);
+    begin
+        return FTabItems[idx];    
+    end        
+    		{**
+    			@param(tabindex)(integer) 当前选中序号 %%
+    			@param(tabsheet)(tcustomtabsheet) 通过下标获得页面 %%
+    			@param(TabCount)(integer) page数量 %%
+    			@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
+    			@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
+    		**}
+    published		
+    property tabs:strings read gettabs write settabs;
+    property tabindex:lazyinteger read FCurrentid write SetCurSel;
+    property OnSelChanged:eventhandler read FOnSelChanged write  FOnSelChanged;
+    property OnSelChanging:eventhandler read FOnSelChanging write  FOnSelChanging;
+    property ondrawtab:eventhandler read Fondrawtab write fondrawtab;
+    property ownerdraw:bool read fownerdraw write fownerdraw;
+    property onmeasuretabwidth:eventhandler read fonmeasuretabwidth write fonmeasuretabwidth;
+    property tabcount:integer read gettabcount ;
+    property tabheight:integer read ftabheight write settabheight;
+    property TabPosition read FTabPosition write SetTabPosition;
+    property tabwidth read gettabwidth write  settabwidth;
+    private 
+    function gettabs();
+    begin
+        r := array();
+        for i := 0 to FTabItems.length()-1 do 
+        begin
+            r[i] := FTabItems[i].caption;
+        end 
+        return r;
+    end 
+    function gettabcount();
+    begin
+        return ftabitems.length();    
+    end 
+    function settabwidth(idx,w);
+    begin
+        if idx>0 and idx<ftabitems.length() and w>=0 and ftabitems[idx].width<>w then 
+        begin
+            ftabitems[idx].width := w;
+        end 
+    end 
+    function gettabwidth(idx);
+    begin
+        tb := ftabitems[idx];
+        if tb then 
+            return tb.width;
+        return nil;
+    end 
+    function settabheight(h);
+    begin
+        if h>0 and h<>FTabHeight then 
+        begin
+            ftabheight := h;
+            CalcTabs();
+        end 
+    end 
+    function settabs(tbs);
+    begin
+        if not ifarray(tbs) then return 0;  
+        if tbs=gettabs() then return 0;
+        mtabitems := new tnumindexarray();  
+        ftw := font.width;
+        for i,v in tbs do 
+        begin
+            if not ifstring(v) then return 0;
+            it := new t_tab_item(v);
+            it.width := ftw*length(v)+10;
+            mtabitems.Push(it);
+        end 
+        FTabItems := mtabitems;
+        FirstViewIndex := 0;
+        FCurrentid := -1;
+        FPrevid := -1;
+        lk := new tcountlocker(fclocker);
+        for i :=0 to n-1 do 
+        begin                
+            measureidx(i);    
+        end 
+        CalcTabs();  
+        InvalidateRect(nil,false);        
+    end 
+    function measureidx(i);//测量
+    begin    
+        if onmeasuretabwidth then 
+        begin 
+            e := new tuieventbase(0,0,i,0);  
+            CallMessgeFunction(onmeasuretabwidth,e);  //wparam 为序号 
+            if e.lparam>=0 then
+            begin
+                FTabItems[i].width := e.lparam;
+            end                   
+        end
+    end 
+    private 
+    fownerdraw;
+    [weakref]fondrawtab;
+    [weakref]fonmeasuretabwidth;    
+end 
+ 
+
+
 type tcustomtabsheet = class(TCustomControl) //控件页面
     {**
     @explan(说明)page控件页面 %%
@@ -670,6 +1228,38 @@ type tcustomtabitem = class() //
     property Caption read FCaption write SetCaption;
     property PageSheet read FPageSheet Write FPageSheet;
 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 
+type t_tab_item = class()
+    function create(s);
+    begin
+        if ifstring(s) then 
+            caption := s;
+        else caption := "";
+    end 
+    _Tag;
+    caption;
+    width;
+end 
 initialization
 
 end.

funcext/tvclib/utslvclstdctl.tsf

@@ -3785,7 +3785,7 @@ type TcustomListBox=class(TCustomListBoxbase)
     published
     property ItemHeight:integer read GetYScrollDelta write setItemHeight;
     property ItemCount:integer read GetItemCount write SetItemCount;
-    property Multisel:bool read FMultisel write SetMultisel;
+    property Multisel:listseltype read FMultisel write SetMultisel;
     property checkbox:bool read fcheckbox write setcheckbox;
     property onSelectionChange read FselectionChange write FselectionChange;
     property selbkcolor:color read fselbkcolor write setselbkcolor;

funcext/tvclib/uvcpropertytypespersistence.tsf

@@ -1580,7 +1580,9 @@ type UniObjectMember=class(UniSelProperty)
                 end
                 return r;
             end
-            return FNameMap[d];
+            r := FNameMap[d];
+            if ifnil(r) then return FNameMap2[d];
+            return r;
         end
         return nil;
     end
@@ -1591,6 +1593,7 @@ type UniObjectMember=class(UniSelProperty)
     protected FInfoObj;
     FValueMap;
     FNameMap;
+    FNameMap2;
     fMultisel;
     private
     function CreateSelValues();override;
@@ -1598,6 +1601,7 @@ type UniObjectMember=class(UniSelProperty)
         //FNameMap := FValueMap := array();
         FNameMap := New tstrindexarray();
         FValueMap := New tstrindexarray();
+        FNameMap2 := array();
         FInfoObj := CreateInfoOBJ();
         r := array();        
         if not ifobj(FInfoObj)then return array();                
@@ -1607,6 +1611,7 @@ type UniObjectMember=class(UniSelProperty)
             vi := invoke(FInfoObj,ni);
             r[i]:= array(ni,vi);
             FNameMap[ni]:= vi;
+            FNameMap2[vi] := vi;
             FValueMap[vi]:= ni;
         end
         return r;
@@ -1831,6 +1836,31 @@ type TPropertyTabAlign=class(UniObjectMember)
         return new TAlign123();
     end
 end
+type TPropertylistseltype=class(UniObjectMember)
+    type TAlign123=class
+        single;
+        multisel;
+        inmultisel;
+        function create();
+        begin
+            single := 0;
+            multisel := 1;
+            inmultisel := 2;
+        end
+    end
+    function EditType();override;
+    begin
+        return "listseltype";
+    end
+    function Create();
+    begin
+        inherited;
+    end
+    function CreateInfoOBJ();override;
+    begin
+        return new TAlign123();
+    end
+end
 type TPropertyAlign=class(UniObjectMember)
     type TAlign123=class
         alNone;
@@ -2345,6 +2375,7 @@ begin
         "tpropertytreeviewdata",
         "tpropertyalign",
         "tpropertytabalign",
+        "TPropertylistseltype",
         "tpropertytext",
         "tpropertystrings",
         "tpropertytsl",