From d71f0753f1908d709b08dfcbe1483bfde8a6fa1c Mon Sep 17 00:00:00 2001 From: JianjunLiu Date: Mon, 15 May 2023 17:52:30 +0800 Subject: [PATCH] =?UTF-8?q?=E7=95=8C=E9=9D=A2=E5=BA=93?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 优化一些接口 --- designer/utslvcldcomponents.tsf | 22 +- designer/utslvcldesignerresource.tsf | 19 +- designer/utslvcldpropertytypes.tsf | 21 + funcext/tvclib/tcontrol.tsf | 6 +- funcext/tvclib/tslvcl.tsf | 6 + funcext/tvclib/twincontrol.tsf | 2 + funcext/tvclib/utslmemo.tsf | 16 +- funcext/tvclib/utslvclpage.tsf | 590 ++++++++++++++++++ funcext/tvclib/utslvclstdctl.tsf | 2 +- .../tvclib/uvcpropertytypespersistence.tsf | 33 +- 10 files changed, 711 insertions(+), 6 deletions(-) diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index 63a1885..e1ed0b4 100644 --- a/designer/utslvcldcomponents.tsf +++ b/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), diff --git a/designer/utslvcldesignerresource.tsf b/designer/utslvcldesignerresource.tsf index 08a8932..7962f93 100644 --- a/designer/utslvcldesignerresource.tsf +++ b/designer/utslvcldesignerresource.tsf @@ -72,6 +72,7 @@ function gettoolbarbitmapinfo(); function getlabelbitmapinfo(); function getlistviewbitmapinfo(); function getgridctlbitmapinfo(); +function gettabctlbitmapinfo(); implementation function getexamplesbmpinfo(); begin @@ -1476,5 +1477,21 @@ BFC6105000000097048597300000EC300000EC301C76FA864000000A849444154 12E4B502CC89C700EAB666231483F3AA0AF0F4080A6710003344D453040D37C80 0EF0594008906401B620220406970F686A01C850644C2C20CA024A008D2DF8FF1 F0006015AA04B38837B0000000049454E44AE42608200"; -end +end +function gettabctlbitmapinfo(); +begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100025F01000089504E470D0A1A0A0000000D4948445200000014000000140806 +0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000000F449444154 +384FD595A10E84301044EF93F9051CC18244D460B120B128122C966FC0F6F236E +CD123A55072E626D96C774A67A785949731C62649E28D711C6D2C5E2CCCB2CCB6 +6D2BD1759D64152DCBF276B04E04191CC1033EC1B346CA07057D3C3B60EE088EE +7A782F33C5F0BEA1C811001E7E3790F4141757237B4D1A9602CD4FD9F0852B8A0 +41DFF736CF733B4D938CAF1074B8AEAB08354DB3313BE09765D9AA1D41878026C +3306CD50E78BEB923820E415555B210376CB9AE6BE18BA290466417970ED33495 +8C20DBD45A33E7EB22E810017875E73A24E3FC781C970E631174F8045F82EE05F +B343E9743E817101BC618FB068D943D91A4D430F90000000049454E44AE426082 +00"; +end end. \ No newline at end of file diff --git a/designer/utslvcldpropertytypes.tsf b/designer/utslvcldpropertytypes.tsf index 6002d8a..4a2352b 100644 --- a/designer/utslvcldpropertytypes.tsf +++ b/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), diff --git a/funcext/tvclib/tcontrol.tsf b/funcext/tvclib/tcontrol.tsf index afb0ad8..2cf4175 100644 --- a/funcext/tvclib/tcontrol.tsf +++ b/funcext/tvclib/tcontrol.tsf @@ -65,7 +65,8 @@ type tcontrol = class(tcomponent) //FOnResize; // FOnShowHint; FOnStartDock; - FOnStartDrag; + FOnStartDrag; + fonfontchanged; //FOnTripleClick; autoref protected //дĺԼʹõijԱ @@ -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; diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 3a50a38..ef1eb7a 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/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) {** diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index fe4a67d..4e20683 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/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 diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 760b2ff..8f7a9ca 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/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 @@ -1314,10 +1316,20 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // end 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) ı%% diff --git a/funcext/tvclib/utslvclpage.tsf b/funcext/tvclib/utslvclpage.tsf index a87794d..2177c93 100644 --- a/funcext/tvclib/utslvclpage.tsf +++ b/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 idFirstViewIndex 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-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=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=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. \ No newline at end of file diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index a3e9531..d8767e8 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/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; diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index baef6df..bdbdb15 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/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",