tslediter/funcext/tvclib/utslvclpage.tsf

709 lines
22 KiB
Plaintext

unit utslvclpage;
interface
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type tcustomtabitem = class() //TTCITEMA
{**
@explan(说明)tab控件标签对象 %%
**}
private
FPageCtrl;
FCaption;
FVisible;
FPageSheet;
function SetVisible(v);
begin
nv := v?true:false;
if nv<>FVisible then
begin
FVisible := v;
end
end
function SetCaption(s);
begin
if ifstring(s) and s<>FCaption then
begin
FCaption := s;
psztext := FCaption;
if PageSheet is class(tcustomtabsheet) then PageSheet.Caption := s;
end
end
public
function Create();
begin
FVisible:= true;
end
property Caption read FCaption write SetCaption;
property PageSheet read FPageSheet Write FPageSheet;
end
type tcustomtabsheet = class(TCustomControl)
{**
@explan(说明)page控件页面 %%
**}
private
FImageIndex;
protected
function RealSetText(s);override;
begin
inherited;
if ifstring(s) and Parent then
begin
id := parent.GetPageID(self(true));
Parent.SetTabText(id,s);
end
end
function SetParent(p);override;
begin
if (P is class(tcustompagecontrol) ) and parent<>p then
begin
oldparent := Parent;
if oldparent then
begin
oldparent.RemovePage(self);
end
inherited;
parent.addtabitem(self);
end else
if not(p is class(TWincontrol)) then
begin
if Parent then
begin
id := Parent.GetPageID(self);
Parent.RemovePageTab(id);
end
inherited;
end
end
public
function paint();override;
begin
drawdesigninggrid();
end
function DesigningMove();override;
begin
return false;
end
function DesigningSizer();override;
begin
return false;
end
function create(AOwner);override;
begin
inherited;
Caption := "tab";
Visible := false;
FTabVisible := True;
end
function CreateParams(p);override;
begin
inherited;
p.exstyle := 0x101;
end
end
type tcustompagecontrol = class(TCustomControl)
private
FirstViewIndex;
FCurrentid;
FPrevid;
FTabItems; //
FOnSelChange;
FOnSelChanging;
//FOnrclick;
FTabPosition;
FTabHeight;
FTabItemswidth;
FScrollBtnRect;
Fprevrect;
fnextrect;
FTabRects;
FClientarea;
function SetTabPosition(v);
begin
if FTabPosition=v then exit;
if not(v in array(alTop,alBottom,alLeft,alRight)) then exit;
FTabPosition := v;
InvalidateRect(nil,false);
DoControlAlign();
end
function GetTabCount();
begin
return FTabItems.length();
end
function CreateTableItem(cp);
begin
r := new tcustomtabitem();
r.caption := cp;
return r;
end
function CalcTabs(); //计算区域
begin
rec := ClientRect; //区域
ft := font;
fw := ft.width;
fh := ft.height;
FTabHeight := fh+7;
FTabItemswidth := array();
for i := 0 to FTabItems.length()-1 do
begin
pg := FTabItems[i];
ta := pg.Caption;
FTabItemswidth[i] := max(20, length(ta)*fw+8 );
end
FMaxsize := 0;
if FTabPosition in array(alLeft,alRight) then
begin
FTabItemswidth := zeros(length(FTabItemswidth))+maxvalue(FTabItemswidth);
FMaxsize := length(FTabItemswidth)*FTabHeight;
end else
begin
FMaxsize := sum(FTabItemswidth);
end
FClientarea := rec;
FScrollBtnRect := 0;
Fprevrect := 0;
fnextrect := 0;
FTabRects := array();
case FTabPosition of
alLeft:
begin
if FTabItemswidth then
begin
FClientarea[0] :=rec[0]+FTabItemswidth[0];
if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then
begin
FScrollBtnRect := array(rec[0],rec[3]-FTabHeight*2,rec[0]+FTabItemswidth[0],rec[3]);
Fprevrect := array(rec[0],rec[3]-FTabHeight*2,rec[0]+FTabItemswidth[0],rec[3]-FTabHeight);
Fnextrect := array(rec[0],rec[3]-FTabHeight,rec[0]+FTabItemswidth[0],rec[3]);
end else
begin
FirstViewIndex := 0;
end
ybase := 0;
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
begin
FTabRects[i] := array(0,ybase,FTabItemswidth[0],ybase+FTabHeight);
ybase+=FTabHeight;
if xbase>(rec[3]-FTabHeight-FTabHeight) then break;
end
else FTabRects[i] := nil;
end
end
end
alRight:
begin
if FTabItemswidth then
begin
FClientarea[2] :=rec[2]-FTabItemswidth[0];
if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then
begin
FScrollBtnRect := array(rec[2]-FTabItemswidth[0],rec[3]-FTabHeight*2,rec[2],rec[3]);
Fprevrect := array(rec[2]-FTabItemswidth[0],rec[3]-FTabHeight*2,rec[2],rec[3]-FTabHeight);
Fnextrect := array(rec[2]-FTabItemswidth[0],rec[3]-FTabHeight,rec[2],rec[3]);
end else
FirstViewIndex := 0;
ybase := 0;
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
begin
FTabRects[i] := array(rec[2]-FTabItemswidth[0],ybase,rec[2],ybase+FTabHeight);
ybase+=FTabHeight;
if xbase>(rec[3]-FTabHeight-FTabHeight) then break;
end
else FTabRects[i] := nil;
end
end
end
alTop:
begin
if FTabItemswidth then
begin
FClientarea[1] :=rec[1]+FTabHeight;
if length(FTabItemswidth)>1 and (FMaxsize>(rec[2]-rec[0])) then
begin
FScrollBtnRect := array(rec[2]-FTabHeight*2,rec[1],rec[2],rec[1]+FTabHeight);
Fnextrect := array(rec[2]-FTabHeight,rec[1],rec[2],rec[1]+FTabHeight);
Fprevrect := array(rec[2]-FTabHeight*2,rec[1],rec[2]-FTabHeight,rec[1]+FTabHeight);
end else FirstViewIndex := 0;
xbase := 0;
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
begin
FTabRects[i] := array(xbase,0,xbase+FTabItemswidth[i],FTabHeight);
xbase+=FTabItemswidth[i];
if xbase>(rec[2]-FTabHeight-FTabHeight) then break;
end else
FTabRects[i] := nil;
end
end
end
alBottom:
begin
if FTabItemswidth then
begin
FClientarea[3] :=rec[3]-FTabHeight;
if length(FTabItemswidth)>1 and (FMaxsize>(rec[2]-rec[0])) then
begin
FScrollBtnRect := array(rec[2]-FTabHeight*2,rec[3]-FTabHeight,rec[2],rec[3]);
Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]);
Fprevrect := array(rec[2]-FTabHeight*2,rec[3]-FTabHeight,rec[2]-FTabHeight,rec[3]);
end else FirstViewIndex := 0;
xbase := 0;
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
begin
FTabRects[i] := array(xbase,rec[3]-FTabHeight,xbase+FTabItemswidth[i],rec[3]);
xbase+=FTabItemswidth[i];
if xbase>(rec[2]-FTabHeight-FTabHeight) then break;
end else
FTabRects[i] := nil;
end
end
end
end
end
function InsureIdxVisible(id); //确保可见
begin
if FScrollBtnRect and (not FTabRects[id]) then
begin
if id>FirstViewIndex then
begin
while(not FTabRects[min(id+1,(FTabItems.length()-1))]) do
begin
FirstViewIndex++;
CalcTabs();
end
end else
if id<FirstViewIndex then
begin
while(not FTabRects[id]) do
begin
FirstViewIndex--;
CalcTabs();
end
end
end
end
function setselidx(id); //选择序号
begin
if FCurrentid= id then return ;
if id>=0 and id<FTabItems.length() then
begin
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
InvalidateRect(nil,false);
DoControlAlign();
if OnSelChanging then
doonSelChanging(self(true),new tuieventbase(0,0,0,0));
if OnSelChange then
doonSelChange(self(true),new tuieventbase(0,0,0,0));
end else
if FTabItems.length()=0 then
begin
FPrevid := FCurrentid;
FCurrentid := -1;
end
end
function PaintTabs();
begin
dc := Canvas;
for i := 0 to FTabItems.length()-1 do
begin
rec := FTabRects[i];
dc.pen.color := rgb(200,200,200);
if rec then
begin
if FCurrentid=i then
begin
dc.brush.color := rgb(100,192,250);//rgb(230,240,250);//rgb(200,200,200);
end else dc.brush.color := rgb(254,254,254);
dc.draw("roundrect",array(rec[0:1],rec[2:3],array(2,2)));
//dc.draw("rectangle",array(rec[0:1],rec[2:3],array(5,5)));
rec[1]+=2;
dc.drawtext(FTabItems[i].Caption,rec,DT_CENTER .|DT_VCENTER);
end
end
end
function PaintScroll(); //绘制滚动
begin
dc := Canvas;
if FScrollBtnRect then
begin
case FTabPosition of
alTop,alBottom:
begin
rc1 := array(FScrollBtnRect[0:1]+1,(FScrollBtnRect[0]+FTabHeight-1,FScrollBtnRect[3]-1));
dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLLEFT);
rc1 := array((FScrollBtnRect[0]+FTabHeight+1,FScrollBtnRect[1]+1),FScrollBtnRect[2:3]-1);
dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLRIGHT);
end else
begin
rc1 := array(FScrollBtnRect[0:1]+1,(FScrollBtnRect[2]-1,FScrollBtnRect[3]-FTabHeight-1));
dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLUP);
rc1 := array((FScrollBtnRect[0]+1,FScrollBtnRect[3]-FTabHeight+1),FScrollBtnRect[2:3]-1);
dc.draw("framecontrol",rc1,DFC_SCROLL,DFCS_SCROLLDOWN);
end
end
end
end
function ScrollPrev(); //滚动到下一个
begin
if FScrollBtnRect and FirstViewIndex>0 then
begin
FirstViewIndex-- ;
CalcTabs();
InvalidateRect(nil,false);
end
end
function scrollnext(); //滚动到上一个
begin
if FScrollBtnRect and FirstViewIndex<FTabItems.length()-1 then
begin
rec := FTabRects[FTabItems.length()-1];
case FTabPosition of
alTop,alBottom:
begin
if rec and (rec[2]<Fprevrect[0]) then return ;
end
alLeft,alRight :
begin
if rec and (rec[3]<Fprevrect[1]) then return ;
end
end ;
FirstViewIndex++ ;
CalcTabs();
InvalidateRect(nil,false);
end
end
public
function getsheetrect(); //获得sheet
begin
{**
@explan(说明) 获得sheet可视区域 %%
@return(array) array(左,上,右,下) %%
**}
if not FClientarea then CalcTabs();
return FClientarea;
end
function DesigningClick();override;
begin
return true;
end
function create(aowner);
begin
inherited;
end
function AfterConstruction();override;
begin
inherited;
color := 0xffffff;
height := 200;
width := 200;
left := 10;
top := 10;
FTabPosition := alTop;
FirstViewIndex := 0;
FCurrentid := -1;
FPrevid := -1;
FTabItems := new tnumindexarray();
end
Function SetCurSel(id);
begin
if id is class(tcustomtabsheet) then
begin
return SetCurSel(GetPageID(id));
end
if ifnumber(id) then
begin
iid := integer(id);
setselidx(iid);
end
end
function paint();override; //绘制
begin
PaintTabs();
PaintScroll();
end
function MouseUp(o,e);override;
begin
ps := e.pos();
if e.button()=mbRight then return ;
if FScrollBtnRect and pointinrect(ps,fnextrect) then
begin
if e.Button() = mbLeft then
ScrollNext();
return ;
end else
if FScrollBtnRect and pointinrect(ps,Fprevrect) then
begin
if e.Button() = mbLeft then
scrollprev();
return ;
end
if not FTabRects then return ;
for i := 0 to length( FTabRects)-1 do
begin
v := FTabRects[i];
if v and pointinrect(ps,v) then
begin
setselidx(i);
if e.Button() = mbLeft then
begin
CallMessgeFunction(Onclick,o,e);
end else
if e.Button() = mbRight then
begin
CallMessgeFunction(onrclick,o,e);
end
end
e.skip := true;
end
end
function doonSelChange(o,e);virtual;
begin
CallMessgeFunction(OnSelChange,o,e);
end
function doonSelChanging(o,e);virtual;
begin
CallMessgeFunction(OnSelChanging,o,e);
end
function TabRect(AIndex: Integer);
begin
r := FTabRects[AIndex];
if r then return r;
return array(0,0,0,0);
end
function GetTabText(AIndex);
begin
r := "";
if AIndex<FTabItems.Count and AIndex>0 then return FTabItems[AIndex].Caption;
return r;
end
function IsContainer(cd);override;
begin
if cd is class(tcustomtabsheet) then return true;
return false;
end
function GetPageID(page);
begin
{**
@explan(说明)获取page的序号 %%
**}
r := -1;
if page is class(tcustomtabsheet) then
begin
for it := 0 to FTabItems.length()-1 do
begin
if FTabItems[it].PageSheet = page then
begin
return it;
end
end
end
return r;
end
function DoControlAlign();override;
begin
CalcTabs();
for i := 0 to FTabItems.length()-1 do
begin
it := FTabItems[i];
if it and it.PageSheet then
begin
pg := it.PageSheet;
if i=FCurrentid then
begin
pg.Visible := true;
rc := getsheetrect();
if not rc then return ;
rc[1]+=1;
if csDesigning in ComponentState then
begin
rc[0]+=2;
rc[2]-=2;
rc[3]-=2;
end
pg.SetBoundsrect(rc);
end else
pg.Visible := false;
end
end
end
function RemovePageTab(id);
begin
if not(id>=0) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
end
end
return setselidx(id-1);
end else
if id<FCurrentid then
begin
FCurrentid--;
end
CalcTabs();
InvalidateRect(nil,false);
end
function RemovePage(i);
begin
{**
@explan(说明)移除page %%
@param(i)(integer) page序号 %%;
**}
ii := -1;
if ifnumber(i) then ii := i;
else
ii := GetPageID(i);
if ii<0 or ii>=FTabItems.length() then return ;
item := FTabItems[ii];
if ifobj(item) then
begin
pg := item.PageSheet;
if pg then pg.parent := nil;
end
//setselidx(0); //移除
end
function addcontrol(page);
begin
{**
@explan(说明) 添加控件 %%
@param(page)(tcustomtabsheet) sheet;
**}
if not(page is class(tcustomtabsheet)) then return -1;
add := true;
for i := 0 to Controls.count-1 do
begin
if Controls[i]=page then add := false;
end
if add then
begin
page.Visible := false;
page.parent := self;
end
end
function addtabitem(page);//添加sheet
begin
if not(page is class(tcustomtabsheet)) then return -1;
add := true;
for i := 0 to FTabItems.length()-1 do
begin
if FTabItems[i].PageSheet = page then add := false;
end
add1 := false;
for i := 0 to Controls.count-1 do
begin
if Controls[i]=page then add1 := true;
end
if add and add1 then
begin
it := CreateTableItem(page.caption);
FTabItems.Push(it);
if FTabItems.length()>1 then page.visible := false;
it.PageSheet := Page;
if {HandleAllocated() and} FCurrentid=-1 then
begin
setselidx(0);
end
end
end
function InitializeWnd();override;
begin
inherited;
end
function AppendPage(page);
begin
{**
@explan(说明)添加pagesheet %%
@param(page)(tcustomtabsheet)sheet %%;
**}
if not(page is class(tcustomtabsheet)) then return -1;
addcontrol(page);
end
function SetTabText(i,Value);
begin
{**
@explan(说明)修改tab标签文字 %%
@param(i)(integer)序号 %%;
@param(Value)(string)文本 %%;
**}
it := FTabItems[i];
if it then
begin
if Value = it.caption then
begin
CalcTabs();
InvalidateRect(nil,false);
end else
begin
it.Caption := Value;
end
end
end
function SetTabIndex(AIndex,AIndexnew);
begin
{**
@explan(说明) 修改标签的次序 %%
@param(AIndex)(integer) 位置 %%
@param(AIndexnew)(integer) 新位置 %%
**}
if (AIndex<>AIndexnew) and (AIndex>=0) and
(AIndex<FTabItems.length()) and (AIndexnew>=0) and (AIndexnew<FTabItems.length()) then
begin
FTabItems(AIndex,AIndexnew);
CalcTabs();
InvalidateRect(nil,false);
end
end
function Recycling();override;
begin
FTabItems.splice(0,FTabItems.length());
inherited;
end
{**
@param(cursel)(integer) 当前选中序号 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**}
property cursel:lazyinteger read FCurrentid write SetCurSel;
property OnSelChange:eventhandler read FOnSelChange write FOnSelChange;
property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging;
//property onrclick:eventhandler read Fonrclick write Fonrclick;
property TabCount read GetTabCount;
property TabPosition:tabalign read FTabPosition write SetTabPosition;
end
implementation
initialization
end.