界面库

优化一些接口
This commit is contained in:
JianjunLiu 2023-05-15 17:52:30 +08:00
parent 3b568e2664
commit d71f0753f1
10 changed files with 711 additions and 6 deletions

View File

@ -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),

View File

@ -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.

View File

@ -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),

View File

@ -65,7 +65,8 @@ type tcontrol = class(tcomponent)
//FOnResize; //
FOnShowHint;
FOnStartDock;
FOnStartDrag;
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;

View File

@ -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)
{**

View File

@ -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

View File

@ -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) 文本%%

View File

@ -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.

View File

@ -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;

View File

@ -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",