tslediter/funcext/tvclib/utslvclpage.tsf

1016 lines
32 KiB
Plaintext

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