liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

界面库 

优化表格控件
This commit is contained in:
JianjunLiu 2022-11-07 17:36:30 +08:00
parent 4519cff2a0
commit 9755b27f72
11 changed files with 582 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
designer/utslvcldcomponents.tsf
View File

@ -570,7 +570,7 @@ type TDComponent = class()
end
return nn;
end
function SetDefalutEvent(ev);
function SetDefalutEvent(ev,ndf);
begin
if ifarray(ev) then
hs := createtslfunction(ev);
@ -583,7 +583,8 @@ type TDComponent = class()
if CheckTslCode(r,err) then
begin
feventnametable[ev["event"]] := ev;
FDefaultEvent := ev["event"];
if not ndf then
FDefaultEvent := ev["event"];
end
end
public
@ -2517,7 +2518,7 @@ type TDListView = class(TDComponent)
DefaultEvent := array(
"event":"onselchanged",
"name":"sel",
"param":array("o"),
"param":array("o","e"),
"virtual":true,
"body":
"
@ -2532,6 +2533,68 @@ type TDListView = class(TDComponent)
end
end
type TDgridctl = class(TDComponent)
{**
@explan(说明) 自绘制网格 设计器控件 %%
**}
function HitTip();override;
begin
return inherited;
end
function bitmapinfo();override;
begin
return getgridctlbitmapinfo();
end
function WndClass();override;
begin
return Class(TGridCtl);
end
function Create(AOwner);override;
begin
inherited;
fiscontainerdcmp := false;
fiscontainerdcmp := false;
DefaultEvent := array(
"event":"ondrawcell",
"name":"drawcell",
"param":array("o","e"),
"virtual":true,
"body":
"
{**
@explan(说明) 绘制表格 %%
@param(o)(tlistview) grid对象 %%
@param(e)(tuieventbase) 消息对象包括,row,col,rec,cavas等属性提供绘制信息 %%
**}
//绘制表头
i := e.row;
j := e.col;
rec := e.rec;
cvs := e.canvas;
if i<o.FixedRows or j<o.FixedColumns then
begin
cvs.Draw('FrameControl',array(rec[0:1],rec[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH); //DFCS_CHECKED DFCS_FLAT
end
//绘制网格线
cvs.moveto(rec[array(2,1)]);
cvs.LineTo(rec[array(2,3)]);
cvs.LineTo(rec[array(0,3)]);
if j=0 then
begin
cvs.LineTo(rec[array(0,1)]);
end
if i=0 then
begin
cvs.MoveTo(rec[array(0,1)]);
cvs.LineTo(rec[array(2,1)]);
end
//绘制文本
cvs.drawtext(format('%d,%d',i,j),rec,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);
inherited;
");
end
end
type TDedit= class(TDComponent)
function HitTip();override;
@ -2936,6 +2999,38 @@ type TDListBox=class(TDComponent)
function Create(AOwner);override;begin
inherited;
fiscontainerdcmp := false;
DefaultEvent := array(
"event":"onselchanged",
"name":"sel",
"virtual":true,
"param":array("o","e"),
"body":
" {**
@explan(说明) item选择改变回调 %%
@param(o)(listbox) 列表控件 %%
@param(e)(tuieventbase) 消息对象 %%
**}
echo '\\r\\n',tostn(o.ItemIndex);
inherited;");
ev := array(
"event":"ondrawlist",
"name":"draw",
"virtual":true,
"param":array("o","e"),
"body":
" {**
@explan(说明) 自绘制 %%
@param(o)(listbox) 列表控件 %%
@param(e)(tlistdrawevent) 消息对象 %%
**}
id := e.idx;
cvs := e.canvas;
rec := e.rec;
sel := e.sel;
cvs.drawtext( o.getItemText(id),rec);
inherited;");
SetDefalutEvent(ev,1);
end
function bitmapinfo();override;begin
return "0502000000060400000074797065000203000000696D670006040000006461746
@ -3521,6 +3616,7 @@ begin
class(TDListBox),
class(TDListView),
class(TDTreeView),
class(TDgridctl),
class(TDProgressBar),
class(TDDateTimePicker),
class(TDTimePicker),

11
designer/utslvcldesignerresource.tsf
View File

@ -71,6 +71,7 @@ function getcoolbarbitmapinfo();
function gettoolbarbitmapinfo();
function getlabelbitmapinfo();
function getlistviewbitmapinfo();
function getgridctlbitmapinfo();
implementation
function getexamplesbmpinfo();
begin
@ -1503,6 +1504,16 @@ CF7F527EA1C3DA7875C10207E7AA366E2C20907118F56AE3DA023E0ECE2A78100
4FA02DDADA8831B0B9AD8BCB2A0297CA9A0F59F7E7B0FE20F1D79BA1B7D429BC4
0000000049454E44AE42608200";
end
function getgridctlbitmapinfo();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746
10002A800000089504E470D0A1A0A0000000D4948445200000012000000120806
00000056CE8E57000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000003D49444154
384F63F84F25403B83A2BDB64059C4B16180FA068124C9C13030EA35125C04031
41B04922407C3C0A8D74870110C50CD207201950CFAFF1F001BE56DAD54559407
0000000049454E44AE42608200";
end
function getsplitterbitmapinfo();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746

11
funcext/tvclib/tcontrol.tsf
View File

@ -753,12 +753,7 @@ type tcontrol = class(tcomponent)
e.SetButton(mbLeft);
e.setshiftdouble(ssDouble);
CallMessgeFunction(FOnMouseDown,o,e);
MouseDown(o,e);
return;
if not(e.skip)then
begin
CallMessgeFunction(FOnDblClick,o,e);
end
MouseDown(o,e);
end
function WMRButtonDBLCLK(o,e):LM_RBUTTONDBLCLK;virtual;
begin
@ -796,10 +791,6 @@ type tcontrol = class(tcomponent)
e.SetButton(mbRight);
CallMessgeFunction(FOnMouseUp,o,e);
MouseUp(o,e);
if not e.skip then
begin
CallMessgeFunction(FOnrbuttonup,o,e); //右键点击
end
end
function WMMButtonUp(o,e):LM_MBUTTONUP;virtual;
begin

54
funcext/tvclib/tslvcl.tsf
View File

@ -1474,7 +1474,7 @@ type TVCForm = class(TScrollingWinControl)
"onsize","onmove","onmousemove",
"onmousedown","onmouseup",
"onactivate","onclose",
"onsetfocus","onkillfocus",
"onsetfocus","onkillfocus","onpopupmenu",
"onkeyup","onkeydown","onkeypress","onnotification"
);
end
@ -2228,10 +2228,11 @@ type TListBox = class(TcustomListBox)
begin
return array("name","caption","anchors","align","enabled",
"font","visible","border","color",
"height","width","left","top","items",
"multisel","checkbox","popupmenu","wsdlgmodalframe",
"onmousedown","onmouseup",
"onselchange","onnotification"
"height","width","left","top",
"itemheight","items","itemindex","selbkcolor",
"multisel","checkbox","ownerdraw","itemcount","popupmenu","wsdlgmodalframe",
"onpopupmenu","onmousedown","onmouseup","ondrawlist",
"onselchanged","onnotification"
);
end
@ -2330,7 +2331,7 @@ type TColorbox=class(TcustomListBox)
"visible","border","enabled",
"height","width","left","top",
"wsdlgmodalframe","popupmenu","parentcolor","parentfont",
"onmousedown","onmouseup",
"onpopupmenu","onmousedown","onmouseup",
"onselchanged","onnotification"
);
end
@ -2976,7 +2977,7 @@ type tpagecontrol = class(tcustompagecontrol)
begin
return array("name","left","top","width","height",
"align","anchors","color","font","parentcolor","parentfont","border","caption","popupmenu","enabled","visible","cursel","cursor",
"wsdlgmodalframe","wssizebox","onselchange","onnotification");
"wsdlgmodalframe","wssizebox","onpopupmenu","onselchange","onnotification");
end
end
//¶þ·Ö¿Ø¼þ
@ -3009,7 +3010,7 @@ type TPairSplitterSide=class(TCustomControl)
end
function publishs();override;
begin
return array("name","border","caption","color","font","parentcolor","parentfont","popupmenu","bkbitmap","wsdlgmodalframe","onsize","onnotification");
return array("name","border","caption","color","font","parentcolor","parentfont","popupmenu","bkbitmap","wsdlgmodalframe","onpopupmenu","onsize","onnotification");
end
end
type TPairSplitter=class(tcustomcontrol) //
@ -3324,17 +3325,20 @@ type TTlvnActiveEvent=class(tuieventbase)
FNmList;
function _getvalue_(n);
begin
return FNmList._getvalue_(n);
//return FNmList._getvalue_(n);
return FNmList[n];
end
function _setvalue_(n,v);
begin
return FNmList._setvalue_(n,v);
//return FNmList._setvalue_(n,v);
FNmList[n] := v;
end
public
function create(m,w,l,h);override;
begin
inherited;
FNmList := new ttagNMLISTVIEW(l);
FNmList := array();
//FNmList := new ttagNMLISTVIEW(l);
end
property hdr index "hdr" read _getvalue_ write _setvalue_;
property iitem index "iitem" read _getvalue_ write _setvalue_;
@ -3345,7 +3349,7 @@ type TTlvnActiveEvent=class(tuieventbase)
property ptaction index "ptaction" read _getvalue_ write _setvalue_;
property lparam index "lparam" read _getvalue_ write _setvalue_;
end
type ttagNMLISTVIEW=class(tslcstructureobj)
{type ttagNMLISTVIEW=class(tslcstructureobj)
private
static SSTRUCT;
class function getstruct()
@ -3371,12 +3375,22 @@ type ttagNMLISTVIEW=class(tslcstructureobj)
begin
inherited create(getstruct(),ptr);
end
end
end}
type TGridCtl = class(TcustomGridCtl)
function create(AOwner);override;
begin
inherited;
end
function publishs();override;
begin
return array("name","height","width","left","top","border","anchors","align","font","color","parentcolor","parentfont",
"autoscroll","columncount","itemcount",
"itemheight","mousesizecell","fixedrows","fixedcolumns",
"columnheader","columns",
"ondrawcell","onmousewheel","onmousemove",
"onmousedown","onmouseup","ondblclick",
"onkeyup","onkeydown","onkeypress","onnotification");
end
end
type TGRidBase = class(TGridCtl)
@ -3389,6 +3403,9 @@ type TGRidBase = class(TGridCtl)
FonColumnClick;
FColumTexts;
private
function setcolumncount(n);override;
begin
end
function SetGridLine(v);
begin
nv := v?true:false;
@ -3640,8 +3657,7 @@ type TGRidBase = class(TGridCtl)
begin
if not HandleAllocated()then return;
//¹¹ÔìÏûÏ¢¶ÔÏó
hd := self.Handle;
e := new TGRIDMDRAWITEM(WM_DRAWITEM,0,0,hd);
e := new TGRIDMDRAWITEM(WM_DRAWITEM,0,0,0);
e.canvas := cvs;
if FColumHeader then e.itemid := i-1;
else e.itemid := i;
@ -3664,7 +3680,7 @@ type TGRidBase = class(TGridCtl)
begin
rc := e.rcitem;
dc := e.canvas;
dc.Pen.Color := rgb(200,200,200);
dc.Pen.Color := 0xc8c8c8;
dc.moveto(array(rc[2],rc[1]));
dc.LineTo(array(rc[2],rc[3]));
dc.LineTo(array(rc[0],rc[3]));
@ -4367,9 +4383,9 @@ type TListView = class(TDrawGrid)
function publishs();override;
begin
return array("name","height","width","left","top","border","anchors","align","font","color","parentcolor","parentfont",
"autoscroll","itemcount","itemheight","mousesizecell",
"fixedrows","fixedcolumns","columncount",
"gridline","columnheader","columns",
"autoscroll","itemheight","columns","columncount","itemcount","mousesizecell",
"fixedrows","fixedcolumns",
"gridline","columnheader",
"selectedid","selbkcolor","mouseonbkcolor",
"onmousewheel","onmousemove",
"onmousedown","onmouseup","ondblclick",

25
funcext/tvclib/utslvclevent.tsf
View File

@ -166,8 +166,30 @@ type TMDRAWITEM=class(tuieventbase,TtageDrawItem)
end
canvas;
end
type TGRIDMDRAWITEM=class(TMDRAWITEM)
type TGRIDMDRAWITEM = class(tuieventbase)
{**
@explan(说明) 表格控件绘制消息 %%
**}
function create(m,w,l,h);override;
begin
inherited;
end
canvas;
itemid;
Subitemid;
rcitem;
SubItemRect;
{**
@param(canvas)(tcanvas) 画板对象 %%
@param(itemid)(integer) 行号 %%
@param(Subitemid)(integer) 列号 %%
@param(SubItemRect)(array(左上右下) ) 区域%%
@param(rcitem)(array(左上右下) ) 区域%%
**}
end
type TGRIDMDRAWITEM2=class(TMDRAWITEM)
{**
@ignore(忽略) %%
@explan(说明) 控件绘制消息类 %%
**}
private
@ -183,6 +205,7 @@ type TGRIDMDRAWITEM=class(TMDRAWITEM)
end
type TMMEASUREITEM=class(tuieventbase,tslcstructureobj)
{**
@ignore(忽略) %%
@explan(说明) 系统控件测量消息
**}
static SFSTRUCT;

5
funcext/tvclib/utslvclgdi.tsf
View File

@ -2527,10 +2527,11 @@ type TcustomCanvas = class(TSLUIBASE)
DT_SINGLELINE：单行显示文本，回车和换行符都不断行。
%%
**}
if not ifstring(str)then return-1;
if not ifstring(str)then return -1;
if not ifnumber(uft)then uft := DT_NOPREFIX; //默认忽略 &占位符
if not ifarray(rec)then rec := nil;
if HandleAllocated()then
if not str then return 0;
if HandleAllocated() then
begin
requiregdi();
if FTabLength then

268
funcext/tvclib/utslvclgrid.tsf
View File

@ -6,7 +6,7 @@ uses utslvclauxiliary,utslvclmemstruct,utslvclgdi;
@date(20220510)
**}
type TcustomGridCtl = class(tcustomscrollcontrol) //自绘制表格基类
{**
{**
@explan(说明) 自绘制表格控件 %%
**}
protected
@ -80,11 +80,13 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
end
function Create(AOwner);override; //构造
begin
inherited;
inherited;
fcxy := array(-1,-1);
end
function AfterConstruction();override;
begin
inherited;
fcellsizerstate := 0;
Width := 300;
Height := 260;
FMouseSizeColumnWidth := 1;
@ -262,6 +264,28 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
if rec1[1]>rec[3]or rec1[3]<rec[1]or rec1[0]>rec[2]or rec1[2]<rec[0]then return false;
InvalidateRect(rec1,false);
end
function getindexbypos(x,y);//根据位置获得行列
begin
{**
@explan(说明) 根据位置获得行列%%
@param(x)(integer) x坐标 %%
@param(y)(integer) y坐标 %%
@return(0|array(r,c)) 行列 %%
**}
c := GetColIndexByPos(x);
if not(r>=0) then return 0;
r := GetRowIndexByPos(y);
if not(c>=0) then return 0;
for ii,v in FMergers do
begin
if v.CellInMerge(r,c)then
begin
cs := v.FCells ;
return array(cs[0],cs[1]);
end
end
return array(r,c);
end
function GetRowIndexByPos(y);virtual;
begin
{**
@ -270,30 +294,36 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
@return(integer) 行号
**}
r :=-1;
if y <= FMarginTop then return-1;
if y <= FMarginTop then return -1;
if FVariableRows then
begin
basex := FMarginTop-FRowWidth * GetYpos();
x2 := FMarginTop;
if y<FYfiexed then
begin
vi := FMarginTop;
for i:= 0 to FFixedRows do
begin
vi += FRowsHeight[i];
if vi>=y then return i;
end
end
basex := FMarginTop-FRowHeight * GetYpos();
for i := 0 to FRowsHeight.length()-1 do
begin
vi := FRowsHeight[i];
x2 += vi;
basex += vi;
if x2 >= x then return i;
if basex >= x then return i;
if basex >= y then return i;
end
end else
begin
r := integer((y-FMarginTop)/FRowHeight);
if y <= FYfiexed then
begin
if r >= FItemCount then return-1;
if r >= FItemCount then return -1;
return r;
end
ybase := GetYPos();
r += ybase;
if r >= FItemCount then return-1;
if r >= FItemCount then return -1;
return r;
end
return r;
@ -353,16 +383,31 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
@param(i)(integer) 行号 %%
@param(j)(integer) 列号 %%
**}
dr := array(rec[0:1],rec[2:3]);
if Fondrawcell then
begin
e := new tgriddrawcellevent(i,j,rec,cvs);
CallMessgeFunction(Fondrawcell,self(true),e);
return ;
end
//绘制表头
if i<FFixedRows or j<FColumFixed then
begin
cvs.Draw("FrameControl",dr,DFC_BUTTON,DFCS_BUTTONPUSH); //DFCS_CHECKED DFCS_FLAT
cvs.Draw("FrameControl",array(rec[0:1],rec[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH); //DFCS_CHECKED DFCS_FLAT
end
else
//绘制网格线
cvs.moveto(rec[array(2,1)]);
cvs.LineTo(rec[array(2,3)]);
cvs.LineTo(rec[array(0,3)]);
if j=0 then
begin
cvs.brush.Color := color;
cvs.Draw("rectangle",dr,DFC_BUTTON,DFCS_BUTTONPUSH);
cvs.LineTo(rec[array(0,1)]);
end
if i=0 then
begin
cvs.MoveTo(rec[array(0,1)]);
cvs.LineTo(rec[array(2,1)]);
end
//绘制文本
cvs.drawtext(format("%d,%d",i,j),rec,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);
end
function GetRowHeight(idx);
@ -488,6 +533,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
end
end
end
cvs.pen.color := 0xc8c8c8;
if parta or merga then
begin
DrawAllParts(cvs,parta,merga,array(FMarginLeft,FMarginTop,FXfiexed,FYfiexed));
@ -505,42 +551,58 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
DrawAllParts(cvs,partd,mergd,array(FXfiexed,FYfiexed,ps[2],ps[3]));
end
end
function MouseDown(o,e);override;
function WMLButtonDown(o,e);override;
begin
fcellsizerstate := 0;
if csDesigning in ComponentState then return false;
if e.button()<> mbLeft then return false;
fmouseleftdown := true;
if FC_CURRENT=FC_SIZE then //调整大小
begin
FSizeColum := 1;
_wapi.ClipCursor(FCursorRect);
fcellsizerstate := 1;
return true;
end else
if FC_CURRENT=FC_SIZE2 then
begin
FSizeColum := 2;
_wapi.ClipCursor(FCursorRect);
fcellsizerstate := 1;
return true;
end
end
function MouseUp(o,e);override;
end else
begin
//x := e.xPos;
//y := e.ypos;
//fleftdownpos := array(x,y);
//fleftdowncell := getindexbypos(x,y);
end
inherited;
end
function WMLButtonUp(o,e);override;
begin
fmouseleftdown := false;
fleftdownpos := nil;
fleftdowncell := nil;
if FSizeColum then
begin
FSizeColum := false;
_wapi.ClipCursor(0);
fcellsizerstate := 3;
return true;
end
end
function MouseMove(o,e);override;
return inherited;
end
function WMMouseMove(o,e);override;
begin
if csDesigning in ComponentState then return false;
if not FMouseSizeColumnWidth then
begin
setcursornormal();
return 0;
end
if csDesigning in ComponentState then return false;
y := e.yPos;
X := e.xpos;
if (FMouseSizeColumnWidth=0) then
begin
setcursornormal();
return inherited;
end
if FMouseSizeColumnWidth .& 1>0 then
begin
if x<FXfiexed then
@ -561,11 +623,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
basey := FMarginTop-FRowHeight * xdx;
end
end
if(FMouseSizeColumnWidth=0)then
begin
setcursornormal();
return 0;
end
if FColsWidths.length()>0 and GetItemCount()>0 and x>(FMarginLeft+5)and y>(FMarginTop+5) {and y<(FMarginTop+FRowHeight*FFixedRows) }then
begin
if FSizeColum=1 then
@ -573,6 +631,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
wd := FColsWidths[FCurrentSizeId];
UpDateColumWidth(FCurrentSizeId,wd+x-FCurrentSizePos);
FCurrentSizePos := x;
fcellsizerstate := 2;
return true;
end else
if FSizeColum=2 then
@ -580,21 +639,29 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
wd := FRowsHeight[FCurrentSizeId];
UpDateRowWidth(FCurrentSizeId,wd+y-FCurrentSizePos);
FCurrentSizePos := y;
fcellsizerstate := 2;
return true;
end else
begin
if fmouseleftdown then return inherited ;
bx := basex;
rc := ClientRect;
if FMouseSizeColumnWidth .& 1>0 then
begin
for i,v in FColsWidths.Data do
begin
if (x-bx-v)<-4 then
begin
break;
end
if abs(x-bx-v)<3 then
begin
if isinmergedcolmn(i,y+5) then break;
FCurrentSizeId := i;
FCurrentSizePos := x;
FCursorRect := array(clientToScreen(max(bx+6,rc[0]+6),y-10),clientToScreen(rc[2],y+10));
setcursorsize();
fcellsizerstate := 2;
return true;
end
bx += v;
@ -605,12 +672,18 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
bx := basey;
for i,v in FRowsHeight.Data do
begin
if (y-bx-v)<-4 then
begin
break;
end
if abs(y-bx-v)<3 then
begin
if isinmergedrow(i,x+5) then break;
FCurrentSizeId := i;
FCurrentSizePos := y;
FCursorRect := array(clientToScreen(x-10,max(rc[1]+6,bx+6)),clientToScreen(x+10,rc[3]));
setcursorsize2();
fcellsizerstate := 2;
return true;
end
bx += v;
@ -619,8 +692,8 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
end
end
setcursornormal();
return false;
end
return inherited;
end
function MergeCells(cells);
begin
{**
@ -654,20 +727,68 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
**}
FMergers := array();
end
function Recycling();override;
begin
Fondrawcell := nil;
FMergers := array();
inherited;
end
//*******************
property ItemCount read GetItemCount write SetItemCount;
property ItemHeight read FRowHeight write SetRowHeigt;
property MouseSizeCell read FMouseSizeColumnWidth write FMouseSizeColumnWidth;
property FixedRows read FFixedRows write SetFixedRows;
property FixedColumns read FColumFixed write SetFixedColumns;
property ColumnCount read GetColumnCount;
property ItemCount:integer read GetItemCount write SetItemCount;
property ItemHeight:integer read FRowHeight write SetRowHeigt;
property MouseSizeCell:bool read FMouseSizeColumnWidth write setmousesizetype;
property FixedRows:integer read FFixedRows write SetFixedRows;
property FixedColumns:integer read FColumFixed write SetFixedColumns;
property ColumnCount:integer read GetColumnCount write setcolumncount;
property VariableRows read FVariableRows write SetVariableRows;
property ondrawcell:eventhandler read Fondrawcell write Fondrawcell;
{**
@param(ItemCount)(integer) 行数 %%
@param(MouseSizeCell)(bool) 鼠标改变列宽 %%
@param(FixedRows)(integer) 固定的行数作为列标 %%
**}
**}
protected
property cellsizerstate read fcellsizerstate;//调整大小
private
function isinmergedcolmn(i,y);
begin
for idx,v in FMergers do
begin
if v.c_inmerge(i,1) then
begin
r := GetRowIndexByPos(y);
if v.r_inmerge(r) then
begin
return true;
end
end
end
end
function isinmergedrow(i,x);
begin
for idx,v in FMergers do
begin
if v.r_inmerge(i,1) then
begin
c := GetColIndexByPos(x);
if v.c_inmerge(c) then
begin
return true;
end
end
end
end
function setmousesizetype(v);
begin
if v in array(0,1,2,3) then
begin
if v<>FMouseSizeColumnWidth then
begin
FMouseSizeColumnWidth := v;
end
end
end
function GetGridMargin();
begin
return array(FMarginLeft,FMarginTop,FMarginRight,FMarginBottom);
@ -785,18 +906,35 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
DoControlAlign();
end
end
function clearselect();
begin
FSelBegin := 0;
fselend := 0;
end
function GetColumnCount();
begin
return FColsWidths.length();
end
function setcolumncount(n);virtual;
begin
if n>=0 and FColsWidths.length()<>n then
begin
vs := array();
for i := 0 to n-1 do
begin
vs[i] := 100;
end
setcolumns(vs);
clearselect();
end
end
function SetItemCount(ct);
begin
if FItemCount <> ct and ct >= 0 then
begin
FItemCount := ct;
if not FVariableRows then DoControlAlign();
clearselect();
end
end
function SetRowHeigt(h);
@ -895,6 +1033,17 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
FC_CURRENT := FC_NORMAL;
end
end
private
//选中
fleftdownpos;
fleftdowncell;
FSelBegin;
fselend;
fselbkcolor;
//
Fondrawcell;
fmouseleftdown;
fcellsizerstate; // 0 调整大小无关 ,1 准备拖拽 ,2 拖拽中 3 结束拖拽
FScroolChanged;
FMergers;
FAutoScroll;
@ -932,6 +1081,27 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
FCurrentSizeId;
FCurrentSizePos;
end
type tgriddrawcellevent = class(tuieventbase)
{**
@explan(说明)单元格绘制消息对象 %%
@param(row)(integer) 行号 %%
@param(col)(integer) 列号 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(r,c,rc,cvs);
begin
inherited create(0,0,0,0);
row := r;
col := c;
rec := rc;
canvas := cvs;
end
row;
col;
rec;
canvas;
end
implementation
type TPAINTCOUNT=class()//绘制标记
function create(v);
@ -957,6 +1127,16 @@ type TMerger=class()//
begin
return length(FCells);
end
function c_inmerge(i,f);
begin
if f then return i>=fcells[1] and i<fcells[3];
return i>=fcells[1] and i<=fcells[3];
end
function r_inmerge(i,f);
begin
if f then return i>=fcells[0] and i<fcells[2];
return i>=fcells[0] and i<=fcells[2];
end
function mergeid(i,j);//是否合并
begin
i := FCells[0];

4
funcext/tvclib/utslvclmenu.tsf
View File

@ -24,7 +24,7 @@ private
FCommand :integer;
FOnclick;
fonchanged;
FOwnerDraw;
// FOwnerDraw;
FOnselect;
FOnDrawItem; //»æÖÆ
FOnMeasureItem; //²âÁ¿
@ -610,7 +610,7 @@ private
FItems.clean();
FOnDesignClick := nil;
FOnclick := nil;
FOwnerDraw := nil;
// FOwnerDraw := nil;
FOnselect := nil;
FOnDrawItem := nil;
FOnMeasureItem := nil;

36
funcext/tvclib/utslvclpage.tsf
View File

@ -133,8 +133,7 @@ type tcustompagecontrol = class(TCustomControl)
alRight:
begin
if FTabItemswidth then
begin
begin
FClientarea[2] :=rec[2]-FTabItemswidth[0];
if length(FTabItemswidth)>1 and (FMaxsize>(rec[3]-rec[1])) then
begin
@ -211,9 +210,10 @@ type tcustompagecontrol = class(TCustomControl)
begin
if FScrollBtnRect and (not FTabRects[id]) then
begin
tl := (FTabItems.length()-1);
if id>FirstViewIndex then
begin
while(not FTabRects[min(id+1,(FTabItems.length()-1))]) do
while(not FTabRects[min(id+1,tl)]) do
begin
FirstViewIndex++;
CalcTabs();
@ -221,7 +221,7 @@ type tcustompagecontrol = class(TCustomControl)
end else
if id<FirstViewIndex then
begin
while(not FTabRects[id]) do
while(not FTabRects[min(max(0,id),tl)]) do
begin
FirstViewIndex--;
CalcTabs();
@ -234,9 +234,9 @@ type tcustompagecontrol = class(TCustomControl)
if FCurrentid= id then return ;
if id>=0 and id<FTabItems.length() then
begin
if fOnSelChanging then
if FCurrentid<>-1 and fOnSelChanging then
begin
e := new tuieventbase(0,FPrevid,FCurrentid,0); //m,w,l,h
e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
doonSelChanging(self(true),e);
if e.skip then return ;
end
@ -252,11 +252,11 @@ type tcustompagecontrol = class(TCustomControl)
end else
if FTabItems.length()=0 then
begin
FPrevid := FCurrentid;
FCurrentid := -1;
FPrevid := -1;
FCurrentid := -1;
end
end
function PaintTabs();
function PaintTabs();//»æÖÆtab
begin
dc := Canvas;
dc.font := font;
@ -338,15 +338,29 @@ type tcustompagecontrol = class(TCustomControl)
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FCurrentid := -1;
FPrevid := -1;
end
end
return setselidx(id-1);
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;
CalcTabs();
InvalidateRect(nil,false);
end

257
funcext/tvclib/utslvclstdctl.tsf
View File

@ -3120,7 +3120,7 @@ type TCustomListBoxbase=class(TCustomScrollControl)
@param(ItemCount)(integer) 项数量 %%
**}
protected
function SetItemCount(n);override;
function SetItemCount(n);
begin
if not(n >= 0)then return;
nn := integer(n);
@ -3148,20 +3148,59 @@ type TCustomListBoxbase=class(TCustomScrollControl)
return 1;
end
end
type tlistdrawevent = class(tuieventbase)
{**
@explan(说明)列表绘制消息对象 %%
@param(id)(integer) 序号 %%
@param(rec)(array(左上右下)) 区域 %%
@param(sel)(bool) 选择状态 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(i,s,r,c);
begin
inherited create(0,0,0,0);
idx := i;
sel := s;
rec := r;
Canvas := c;
end
rec;
idx;
sel;
canvas;
end
type TcustomListBox=class(TCustomListBoxbase)
{**
@explan(说明) listbox控件 %%
**}
private
FListitemheigt;
protected
function GetYScrollDelta();override;
begin
if ownerdraw and FListitemheigt>0 then
begin
return FListitemheigt;
end else return inherited;
end
public
function Create(AOwner);override;
begin
inherited;
FOwnerDraw := false;
border := true;
FitemData := new tnumindexarray();
FSelBegin :=-1;
FSelEnd :=-1;
FMultisel := false;
fcheckbox := false;
fselbkcolor := 0xFFE7CB;
end
function FontChanged(o);override;
begin
if fownerdraw then return ;
return inherited;
end
function MouseUp(o,e);override;
begin
if FIsMouseDown then //已经按下过
@ -3262,9 +3301,9 @@ type TcustomListBox=class(TCustomListBoxbase)
**}
r := PaintIdxBkg(idx,rc,cvs);
rc1 := rc;
rc1[4]:=r;
if fcheckbox then
begin
begin
h := rc[3]-rc[1];
nh := min(h,16);
nnh := integer((h-nh)/2);
@ -3276,6 +3315,12 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function PaintIdexText(idx,rc,cvs);virtual;
begin
if fownerdraw and Fondrawlist then
begin
e := new tlistdrawevent(idx,rc[4],rc,cvs);
CallMessgeFunction(Fondrawlist,self(true),e);
return ;
end
cvs.DrawText(getItemText(idx),rc,DT_NOPREFIX);
end
function getCurrentSelection();virtual;
@ -3446,10 +3491,11 @@ type TcustomListBox=class(TCustomListBoxbase)
if CheckListItems(ari)then
begin
FitemData.Pushs(ari);
class(TCustomListBoxbase).ItemCount := FitemData.length();
inherited SetItemCount(FitemData.length());
//class(TCustomListBoxbase).ItemCount := ;
return ItemCount-1;
end
return-1;
return -1;
end
function insertItem(item,n);virtual;
begin
@ -3535,50 +3581,7 @@ type TcustomListBox=class(TCustomListBoxbase)
if FSelBegin >= 0 and FSelEnd >= FSelBegin then deleteItems(const FSelBegin,FSelEnd-FSelBegin+1);
end
end
function findStrBeginwith(str,b,n);virtual;
begin
{**
@explan(说明)在列表框中指定项之后查找以字符串开头的项，到达末尾即从头开始%%
@param(str)(string)给定字符串%%
@param(b)(bool)1:不区分大小写，0:区分大小写%%
@param(n)(integer)指定项下标，默认为-1%%
@return(integer)返回找到的项的下标，未找到则返回-1%%
**}
if ifnil(b)then b := 0;
if ifnil(n)then n :=-1;
if CheckListItem(str)and ifnumber(n)then
begin
if not isValidIndex(n)then n :=-1;
if b then
begin
return findBeginwithCaseIndepent(str,n);
end else
return findBeginwith(str,n);
end
ShowErrorMessage("function findStrBeginwith:ErrorParameter(s)");
return-1;
end
function findStrExact(str,b,n);virtual;
begin
{**
@ignore(忽略) %%
@explan(说明)在列表框中指定项之后查找与字符串相同的项，到达末尾即从头开始%%
@param(str)(string)给定字符串%%
@param(b)(bool)1:不区分大小写，0:区分大小写，默认为0%%
@param(n)(integer)指定项下标，默认为-1%%
@return(integer)匹配项的索引，查找失败则返回-1%%
**}
if ifnil(b)then b := 0;
if ifnil(n)then n :=-1;
if CheckListItem(str)and ifnumber(n)then
begin
if not isValidIndex(n)then n :=-1;
if b then return findExactCaseIndepent(str,n);
else return findExact(str,n);
end
ShowErrorMessage("function findStrExact:ErrorParameter(s)");
return -1;
end
function setData(ari);virtual;
begin
IncPaintLock();
@ -3641,14 +3644,21 @@ type TcustomListBox=class(TCustomListBoxbase)
function Recycling();override;
begin
FselectionChange := nil;
Fondrawlist := nil;
return inherited;
end
property ItemCount read GetItemCount;
property ItemHeight:integer read GetYScrollDelta write setItemHeight;
property ItemCount:integer read GetItemCount write SetItemCount;
property Multisel:bool read FMultisel write SetMultisel;
property checkbox:bool read fcheckbox write setcheckbox;
property onSelectionChange read FselectionChange write FselectionChange;
property selbkcolor:color read fselbkcolor write setselbkcolor;
property onSelchanged:eventhandler read FselectionChange write FselectionChange;
property ondrawlist:eventhandler read Fondrawlist write Fondrawlist;
property Items:strings read GetData write setData;
property itemindex:tsl read getCurrentSelection write setCurrentSelection;
property ownerdraw:bool read fownerdraw write setownerdraw;
protected
function CheckListItems(s);
begin
@ -3664,7 +3674,8 @@ type TcustomListBox=class(TCustomListBoxbase)
{**
@explan(说明) 项检查,重写该方法可以控制项的类型 %%
**}
return ifstring(s);
return true;
//return ifstring(s);
end
function isValidIndex(n);
begin
@ -3679,15 +3690,53 @@ type TcustomListBox=class(TCustomListBoxbase)
@explan(说明)(TMyarrayB) list数据数据,不要试图修改该变量
**}
private
function setItemHeight(h);
begin
if h>0 and h<>FListitemheigt then
begin
FListitemheigt := integer(h);
if FOwnerDraw then
begin
doControlALign();
InvalidateRect(nil,false);
end
end
end
function setselbkcolor(v);
begin
if (v>0 or v<0) and v<>fselbkcolor then
begin
fselbkcolor := v;
end
end
function SetItemCount(n);
begin
if fownerdraw and (n>=0) and ItemCount<>n then
begin
d := nils(n);
setData(d);
end
end
function setownerdraw(v);
begin
nv := v?true:false;
if FOwnerDraw<>nv then
begin
FOwnerDraw := nv;
if not(FListitemheigt>0) then
begin
FListitemheigt := font.Height+4;
end
end
end
function PaintIdxBkg(idx,rc,cvs);
begin
if(idx >= min(FSelBegin,FSelEnd)and idx <= max(FSelBegin,FSelEnd))or(FMultisel=2 and FMultisel3Data[idx])then
begin
r := true;
cvs.brush.Color := rgb(204,231,255);
end else
cvs.Brush.Color := Color;
cvs.FillRect(rc);
cvs.brush.Color := fselbkcolor;//0xFFE7CB;//rgb(204,231,255);
cvs.FillRect(rc);
end
return r;
end
function setcheckbox(c);
@ -3716,30 +3765,7 @@ type TcustomListBox=class(TCustomListBoxbase)
begin
return FitemData.Data;
end
function findBeginwith(str,n);
begin
len := class(TCustomListBoxbase).ItemCount;
while i++<> len do if AnsiStartsStr(str,getItem((i+n)%len))then return(i+n)%len;
return -1;
end
function findBeginwithCaseIndepent(str,n);
begin
len := class(TCustomListBoxbase).ItemCount;
while i++<> len do if AnsiStartsText(str,getItem((i+n)%len))then return(i+n)%len;
return -1;
end
function findExact(str,n);
begin
len := class(TCustomListBoxbase).ItemCount;
while i++ <> len do if getItem((i+n)%len)=str then return(i+n)%len;
return -1;
end
function findExactCaseIndepent(str,n);
begin
len := class(TCustomListBoxbase).ItemCount;
while i++ <> len do if UpperCase(getItem((i+n)%len))=UpperCase(str)then return(i+n)%len;
return -1;
end
function SelRange(sel);
begin
if FSelBegin >= 0 and FSelEnd >= 0 then
@ -3826,8 +3852,12 @@ type TcustomListBox=class(TCustomListBoxbase)
end
if selchange then CallMessgeFunction(FselectionChange,self(true),nil);
end
private
fselbkcolor;
FOwnerDraw;
// FselectionCancel;
FselectionChange;
Fondrawlist;
FSelBegin;
FSelEnd;
FIsMouseDown;
@ -3854,7 +3884,6 @@ type TCustomComboBoxbase=class(TCustomControl)
FListBox := CreateAlist();
if FListBox is class(TWinControl)then
begin
//FListBox.Parent := self(true);
FListBox.OnClose := function(o,e)
begin
e.skip := true;
@ -3898,15 +3927,25 @@ type TCustomComboBoxbase=class(TCustomControl)
if not((FListBox is class(TWincontrol))and FListBox.WsPopUp)then return;
if flg and not(FListBox.Visible)then
begin
if Fondropdown then
begin
e := new tuieventbase(0,0,0,0);
CallMessgeFunction(Fondropdown,self(true),e);
end
SetListBoxRect();
FListBox.OnActivate := thisfunction(ListActivate);
FListBox.show(5);
CallMessgeFunction(ondropdown,self(true),e);
end else
if not(flg) and FListBox.Visible then
begin
if Foncloseup then
begin
e := new tuieventbase(0,0,0,0);
CallMessgeFunction(Foncloseup,self(true),e);
end
FListBox.Visible := false;
CallMessgeFunction(oncloseup,self(true),e);
end
end
function Recycling();override;
@ -3994,14 +4033,15 @@ type TCustomComboBoxbase=class(TCustomControl)
end
function getlistitemcount();virtual; //获得项目
begin
return FListBox.ItemCount;
return 0;
end
function getlistitemheight();virtual; //获得项目高
begin
return FListBox.ItemHeight;
return 20;
end
function GetItemIndex();virtual;//获得选中的序号
begin
return -1;
end
function SetItemIndex();virtual;//设置选中的序号
begin
@ -4250,6 +4290,14 @@ type TcustomComboBox=class(TCustomComboBoxbase)
FEdit.Readonly := nv;
end
end
function getlistitemcount();override; //获得项目
begin
return FListBox.ItemCount;
end
function getlistitemheight();override; //获得项目高
begin
return FListBox.ItemHeight;
end
function GetItemIndex();override;
begin
//if FMultisel and (csDesigning in ComponentState) then return -1;
@ -4602,8 +4650,7 @@ type TcustomToolBar=class(TCustomControl)
**}
function Create(AOwner);override;
begin
inherited;
inherited;
end
function AfterConstruction();override;
begin
@ -4620,6 +4667,11 @@ type TcustomToolBar=class(TCustomControl)
FTimer.Interval := 200;
FTimer.Ontimer := thisfunction(DoTimerShowTip);
end
function FontChanged(o);override;
begin
inherited;
if fmainmenu then doControlALign();
end
function MouseDown(o,e);override;
begin
if csDesigning in ComponentState then return;
@ -4867,21 +4919,29 @@ type TcustomToolBar=class(TCustomControl)
begin
if fmainmenu then
begin
c.brush.Color := 0xe0e0e0;
c.brush.Color := 0xffffbb;
c.FillRect(ci);
end
else
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK);
end else
begin
if bi.enabled then
if fmainmenu then
begin
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH);
end else
begin
c.brush.Color := 0x8c8c8c;////0xc0c0cc;
c.brush.Color := Color;////;
c.FillRect(ci);
end
end
else
begin
if bi.enabled then
begin
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH);
end else
begin
c.brush.Color := 0x8c8c8c;////0xc0c0cc;
c.FillRect(ci);
end
end
end
if fmainmenu then
begin
@ -5072,11 +5132,7 @@ type TcustomToolBar=class(TCustomControl)
InvalidateRect(nil,false);
end
end
function FontChanged(o);override;
begin
inherited;
if fmainmenu then doControlALign();
end
private
function mainmenuchanged();
begin
@ -5132,8 +5188,9 @@ type TcustomToolBar=class(TCustomControl)
begin
s := mu.Caption;
wh := GetTextWidthAndHeightWidthFont(s,self.font,0);// wh
fmenubtnrects[i]:= array(x,y,x+wh[0]+5,rc[3]);
x:=x+wh[0]+15;
nwh := x+wh[0]+15;
fmenubtnrects[i]:= array(x,y,nwh,rc[3]);
x:=nwh;
if x>rc[2] then break; //只有一行
end else
begin

2
funcext/tvclib/utslvcltree.tsf
View File

@ -1801,7 +1801,7 @@ type TcustomTreeCtl = class(TVirtualList)
begin
it.UnExpand();
end else
CallMessgeFunction(ondblclick,o,e);
CallMessgeFunction(ondblclick,o,e);
end
end
function MouseUp(o,e);override;