tslediter/funcext/tvclib/utslvclgrid.tsf

1241 lines
35 KiB
Plaintext

unit utslvclgrid;
interface
uses utslvclauxiliary,utslvclmemstruct,utslvclgdi;
{**
@explan(说明) 表格控件相关 %%
@date(20220510)
**}
type TcustomGridCtl = class(tcustomscrollcontrol) //自绘制表格基类
{**
@explan(说明) 自绘制表格控件 %%
**}
protected
function GetClientXCapacity();virtual; //宽度容量
begin
r := integer(ClientRect[2]/GetXScrollDelta());
return r;
end
function GetClientYCapacity();virtual; //高度容量
begin
r := integer(ClientRect[3]/GetYScrollDelta());
return r;
end
function GetClientXCount();virtual; //宽度间隔
begin
r := integer(0.99+ allwidth()/FColWidth);
return r;
end
function GetClientYCount();virtual; //高度项
begin
return integer(0.99+allheigth()/FRowHeight);
end
function GetXScrollDelta();override;
begin
return FColWidth;
end
function GetYScrollDelta();override;
begin
return FRowHeight;
end
function PositionChanged();virtual;
begin
InvalidateRect(nil,false);
end
property cellsizerstate read fcellsizerstate;//调整大小
public
function IncPaintLock();
begin
BeginUpdate();
end
function DecPaintLock();
begin
EndUpdate();
end
function DoEndUpDate();override;
begin
if not(IsUpDating())then
begin
if FScroolChanged then
begin
FScroolChanged := false;
DoControlAlign();//UpDateScrollBar();
end
end
inherited;
end
// function UpDateScrollBar();
// begin
// DoControlAlign();
// end
function DoControlAlign();override;
begin
if(IsUpDating())then
begin
FScroolChanged := true;
end else
begin
UpDateFixed();
pt := New TPAINTCOUNT(self);
InitialScroll();
end
end
function Create(AOwner);override; //构造
begin
inherited;
fcxy := array(-1,-1);
end
function AfterConstruction();override;
begin
inherited;
fcellsizerstate := 0;
Width := 300;
Height := 260;
FMouseSizeColumnWidth := 1;
AutoScroll := 3;
FItemCount := 0;
FFixedRows := 1;
FColumFixed := 0;
FColWidth := 5; //10;
FRowWidth := 10;
FC_NORMAL := OCR_NORMAL;
FC_SIZE := OCR_SIZEWE;
FC_SIZE2 := OCR_SIZENS;
FMarginLeft := 1;
FMarginTop := 1;
FMarginRight := 0;
FMarginBottom := 0;
FRowHeight := 30;
FColsWidths := new tnumindexarray();
FRowsHeight := new tnumindexarray();
FVariableRows := false;
ThumbTrack := true;
FScroolChanged := false;
end
function GetItemRect(i);virtual; //根据行号获得其区域
begin
{**
@explan(说明) 获得行的区域 %%
@param(i)(integer) 行号 %%
@return(array) array(左,上,右,下);
**}
yrct := GetItemYBound(i);
if not yrct then return nil;
basex := FMarginLeft-FColWidth * GetXpos();
//r := array(basex,yrct[0],yrct[1],0);
r := array(basex,yrct[0],0,yrct[1]);
for ii := 0 to FColsWidths.length()-1 do
begin
basex += FColsWidths[ii];
end
r[2]:= basex;
return r;
end
function GetItemStartY(i);virtual; //获得行的top
begin
{**
@explan(说明) 获得行的区域范围 %%
@param(i)(integer) 行号 %%
@return(array) array(上,下);
**}
if(i<0 or i >= GetItemCount())then return nil;
yb := FMarginTop;
itv := FRowHeight;
if FVariableRows then
begin
for ii := 0 to i-1 do
begin
yb += FRowsHeight[ii];
end
//itv := FRowWidth;
end else
yb += i * FRowHeight;
if i<FFixedRows then
begin
return yb;
end
yp := GetYPos();
yb -= yp * itv;
return yb;
end
function GetItemYBound(i);virtual; //获得行的
begin
{**
@explan(说明) 获得行的区域范围 %%
@param(i)(integer) 行号 %%
@return(array) array(上,下);
**}
r := GetItemStartY(i);
if ifnil(r)then return nil;
return array(r,r+GetRowHeight(i));
end
function GetSubItemRect(i,j);virtual;
begin
{**
@explan(说明) 获得cell的范围%%
@param(i)(integer) 行号 %%
@param(j)(integer) 列号 %%
@return(array) array(左,上,右,下);
**}
if not(j >= 0 and j<FColsWidths.length())then return nil;
yrct := GetItemYBound(i);
if not yrct then return nil;
r := array(0,yrct[0],0,yrct[1]);
basex := FMarginLeft-FColWidth * GetXpos();
x2 := FMarginLeft;
for ii := 0 to FColsWidths.length()-1 do
begin
if j=ii then
begin
if j<FColumFixed then
begin
r[0]:= x2;
r[2]:= x2+FColsWidths[ii];
end else
begin
r[0]:= basex;
r[2]:= basex+FColsWidths[ii];
end
return r;
end
vi := FColsWidths[ii];
basex += vi;
x2 += vi;
end
return r;
end
function GetTureSubItemRect(i,j);
begin
{**
@explan(说明) 获得真实的格子区域 ,在有合并表格中使用 %%
**}
for ii,v in FMergers do
begin
if v.CellInMerge(i,j)then
begin
return GetMergRect(v);
end
end
return GetSubItemRect(i,j);
end
function GetColIndexByPos(x);virtual;
begin
{**
@explan(说明) 通过坐标获得 列号 %%
@param(x)(integer) 坐标 %%
@return(integer) 行号
**}
r :=-1;
if x <= FMarginLeft then return r;
basex := FMarginLeft-FColWidth * GetXpos();
x2 := FMarginLeft;
for i := 0 to FColsWidths.length()-1 do
begin
vi := FColsWidths[i];
x2 += vi;
basex += vi;
if i<FColumFixed and x2 >= x then return i;
if basex >= x then return i;
end
return r;
end
function hititemat(xy); //命中
begin
r := array();
if not(ifarray(xy) and ifnumber(xy[0]) and ifnumber(xy[1])) then return r;
x := xy[0];
y := xy[1];
ri := GetRowIndexByPos(y);
if ri>=0 then
begin
ci := GetColIndexByPos(x);
if ci>=0 then
begin
r["ridx"]:=ri;
r["cidx"]:=ci;
rc := GetTureSubItemRect(ri,ci);
r["x"]:= x-rc[0];
r["y"] := y-rc[1];
end
end
return r;
end
function InvalidateItem(i);virtual;
begin
{**
@explan(说明) 刷新行%%
@param(i)(integer) 行号 %%
**}
bd := GetItemYBound(i);
if not bd then return false;
rec := ClientRect;
if bd[1]>rec[3]or bd[0]<rec[1]then return false;
rec[1]:= bd[0];
rec[3]:= bd[1];
InvalidateRect(rec,nil);
end
function InvalidateSubItem(i,j);virtual;
begin
{**
@explan(说明) 刷新cell的范围%%
@param(i)(integer) 行号 %%
@param(j)(integer) 列号 %%
**}
rec1 := GetSubItemRect(i,j);
if not rec1 then return false;
rec := ClientRect;
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
{**
@explan(说明) 通过坐标获得 行号 %%
@param(y)(integer) 坐标 %%
@return(integer) 行号
**}
r :=-1;
if y <= FMarginTop then return -1;
if FVariableRows then
begin
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];
basex += vi;
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;
return r;
end
ybase := GetYPos();
r += ybase;
if r >= FItemCount then return -1;
return r;
end
return r;
end
function SetColumns(cls,beg,len);virtual;
begin
{**
@explan(说明) 设置列宽信息 %%
@param(cls)(array of integer) 列宽 %%
@param(beg)(integer) 开始位置 %%
@param(len)(integer) 替代长度 %%
**}
clsa := array();
for i,v in cls do
begin
if v >= 0 then clsa[length(clsa)]:= v;
end
FColsWidths.splices(beg>0?beg:0,len >= 0?len:FColsWidths.Length(),clsa);
DoControlAlign();
end
function SetRows(rows,beg,len);virtual;
begin
if not FVariableRows then return;
clsa := array();
for i,v in rows do
begin
if v>0 then clsa[length(clsa)]:= v;
end
FRowsHeight.splices(beg>0?beg:0,len >= 0?len:FRowsHeight.Length(),clsa);
DoControlAlign();
end
function GetColumnWidth(i);
begin
{**
@explan(说明) 获得第i列宽度 %%
@param(i)(integer) 列号 %%
@return(integer) 宽度 %%
**}
return FColsWidths[i];
end
function SetColumnWidth(i,w);
begin
{**
@explan(说明) 设置列宽 %%
@param(i)(integer) 列序号 %%
@param(w)(integer) 新宽度 0 %%
**}
vi := FColsWidths[i];
if vi >= 0 and w >= 0 and vi <> w then UpDateColumWidth(i,w);
end
function DrawCell(cvs,rec,i,j);virtual;
begin
{**
@explan(说明) 绘制单元格 %%
@param(cvs)(tcustomcanvas) 画布 %%
@param(rec)(array) array(左上右下) %%
@param(i)(integer) 行号 %%
@param(j)(integer) 列号 %%
**}
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",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);
end
function GetRowHeight(idx);
begin
{**
@explan(说明) 获得行高 %%
**}
if FVariableRows then return FRowsHeight[idx];
else return FRowHeight;
end
function Paint();override;
begin
cvs := Canvas;
xPos := GetXpos();
ypos := GetYpos();
// 计算需要重绘的区域
ps := PAINTSTRUCT().rcPaint;
if FMarginRight>0 then ps[2]:= min(ClientRect[2]-FMarginRight,ps[2]);
if FMarginBottom>0 then ps[3]:= min(ClientRect[3]-FMarginBottom,ps[3]);
FValidateRect := ps;
tp := ps[1];
bo := ps[3];
//***************计算表头区域*******************
basex := FMarginLeft-xpos * FColWidth;
x := basex;
x2 := FMarginLeft;
cvs.Font := font;
drawcol := array();
for i,v in FColsWidths.Data do
begin
if i<FColumFixed then
begin
if(x2+v >= ps[0])and x2<ps[2]then
begin
drawcol[i]:= array(x2,x2+v);
end
end
if i >= FColumFixed then
begin
if(x+v >= ps[0])and x<ps[2]then
begin
drawcol[i]:= array(x,x+v);
end
end
x2 += v;
x += v;
end
y2 := FMarginTop;
drawrow := array();
if FVariableRows then
begin
FRowsTemp := FRowsHeight.Data;
basey := FMarginTop-ypos * FRowHeight;//FRowWidth;
end else
begin
basey := FMarginTop-ypos * FRowHeight;
FRowsTemp := zeros(FItemCount)+FRowHeight;
end
y := basey;
for i,v in FRowsTemp do
begin
if i<FFixedRows then
begin
if(y2+v >= ps[1])and y2<ps[3]then
begin
drawrow[i]:= array(y2,y2+v);
end
end
if i >= FFixedRows then
begin
if(y+v >= ps[1])and y<ps[3]then
begin
drawrow[i]:= array(y,y+v);
end
end
y2 += v;
y += v;
end
parta := array();
partal := 0;
partb := array();
partbl := 0;
partc := array();
partcl := 0;
partd := array();
partdl := 0;
merga := array();
mergb := array();
mergc := array();
mergd := array();
for j,vj in drawcol do
begin
if vj[0]>= vj[1]then continue;
for i,vi in drawrow do
begin
if i<FFixedRows and j<FColumFixed then
begin
if FindMerge(i,j,merga)then
begin
end else
parta[partal++]:= array(array(vj[0],vi[0],vj[1],vi[1]),i,j);
end else
if i<FFixedRows and j >= FColumFixed then
begin
if FindMerge(i,j,mergb)then
begin
end else
partb[partbl++]:= array(array(vj[0],vi[0],vj[1],vi[1]),i,j);
end else
if i >= FFixedRows and j<FColumFixed then
begin
if FindMerge(i,j,mergc)then
begin
end else
partc[partcl++]:= array(array(vj[0],vi[0],vj[1],vi[1]),i,j);
end else
if i >= FFixedRows and j >= FColumFixed then
begin
if FindMerge(i,j,mergd)then
begin
end else
partd[partdl++]:= array(array(vj[0],vi[0],vj[1],vi[1]),i,j);
end
end
end
cvs.pen.color := 0xc8c8c8;
if parta or merga then
begin
DrawAllParts(cvs,parta,merga,array(FMarginLeft,FMarginTop,FXfiexed,FYfiexed));
end
if partb or mergb then
begin
DrawAllParts(cvs,partb,mergb,array(FXfiexed,FMarginTop,ps[2],FYfiexed));
end
if partc or mergc then
begin
DrawAllParts(cvs,partc,mergc,array(FMarginLeft,FYfiexed,FXfiexed,ps[3]));
end
if partd or mergd then
begin
DrawAllParts(cvs,partd,mergd,array(FXfiexed,FYfiexed,ps[2],ps[3]));
end
end
function WMLButtonDown(o,e);override;
begin
fcellsizerstate := 0;
if csDesigning in ComponentState 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 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
return inherited;
end
function WMMouseMove(o,e);override;
begin
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
begin
basex := FMarginLeft;
end else
begin
xdx := GetXpos();
basex := FMarginLeft-FColWidth * xdx;
end
end
if(FMouseSizeColumnWidth .& 2>0)and FVariableRows then
begin
basey := FMarginTop;
if y >= FYfiexed then
begin
xdx := GetYpos();
basey := FMarginTop-FRowHeight * xdx;
end
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
begin
wd := FColsWidths[FCurrentSizeId];
UpDateColumWidth(FCurrentSizeId,wd+x-FCurrentSizePos);
FCurrentSizePos := x;
fcellsizerstate := 2;
return true;
end else
if FSizeColum=2 then
begin
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;
if callondragcellsize(i,2) 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;
end
end
if FVariableRows and(FMouseSizeColumnWidth .& 2>0)then
begin
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;
if callondragcellsize(i,1) 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;
end
end
end
end
setcursornormal();
return inherited;
end
function MergeCells(cells);
begin
{**
@explan(说明) 单元格 %%
@param(cells)(array) array(开始行,开始列,结束行,结束列) %%
**}
nm := new TMerger();
nm.SetMergeCells(cells);
if nm.isok then
begin
if not ifarray(FMergers)then FMergers := array();
FMergers[length(FMergers)]:= nm;
end
end
function GetMergeInfo();
begin
{**
@explan(说明) 获得合并信息 %%
**}
r := array();
for i,v in FMergers do
begin
r[i]:= v.FCells;
end
return r;
end
function CleanMergeCells(rc);
begin
{**
@explan(说明) 清空合并信息 %%
@param(rc)(array(行,列))指定清除的合并格子 %%
**}
if ifarray(rc) and rc[0]>=0 and rc[1]>=0 then
begin
di := -1;
for i,v in FMergers do
begin
if v.CellInMerge(rc[0],rc[1])then
begin
di:=i;
break;
end
end
if di>=0 then deleteindex(FMergers,di,1);
return ;
end
FMergers := array();
end
function Recycling();override;
begin
Fondrawcell := nil;
fonhitcellsizer := nil;
FMergers := array();
inherited;
end
//*******************
published
property ItemCount:integer read GetItemCount write SetItemCount;
property ItemHeight:integer read FRowHeight write SetRowHeigt;
property MouseSizeCell:tsl 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:bool read FVariableRows write SetVariableRows;
property ondrawcell:eventhandler read Fondrawcell write Fondrawcell;
property onhitcellsizer:eventhandler read fonhitcellsizer write fonhitcellsizer;
property mergeinfo:tsl read GetMergeInfo write setmergeinfo;
property ColumnWidth read GetColumnWidth write SetColumnWidth;
property rowheight read GetRowHeight write UpDateRowWidth;
property topline:lazyinteger read GetYPos write SetYpos;
{**
@param(ItemCount)(integer) 行数 %%
@param(ColumnCount)(integer) 列数 %%
@param(ItemHeight)(integer) 行高,固定高度情况下使用 %%
@param(MouseSizeCell)(bool) 鼠标改变列宽 %%
@param(FixedRows)(integer) 固定的行数作为列标 %%
@param(FixedColumns)(integer) 固定的列数作为列标 %%
@param(mergeinfo)(array) 合并信息,二维数组,每行为一个合并信息array(开始行,开始列,截止行,截止列) %%
@param(onhitcellsizer)(function[o,e]) 鼠标移动到边线时候回调,e.wparam 1,2 表示行列,e.lparam 代表对于序号,e.skip是的值作为返回表示是否忽略调整大小 %%
@param(ondrawcell)(function[o,e]) 绘制回调,e.row 行号,e.col 列号,e.rec 绘制区域,e.canvas 绘画对象 %%
@param(ColumnWidth)(integer) 通过索引号获取设置列宽 %%
@param(rowheight)(integer) 通过索引号获取设置行高,在可变高度下有用 %%
**}
private
function setmergeinfo(rcs);
begin
FMergers := array();
for i,v in rcs do
begin
MergeCells(v);
end
InvalidateRect(nil,false);
end
function callondragcellsize(i,r);
begin
if fonhitcellsizer then
begin
e := new tuieventbase(0,r,i,0);
CallMessgeFunction(fonhitcellsizer,self(true),e);
return e.skip;
end
end
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);
end
function SetGridMargin(l,t,r,b);
begin
if l >= 0 then nl := integer(l);
if t >= 0 then nt := integer(t);
if r >= 0 then nr := integer(r);
if b >= 0 then nb := integer(b);
f := false;
if nl >= 0 and nl <> FMarginLeft then
begin
f := true;
FMarginLeft := nl;
end
if nt >= 0 and nt <> FMarginTop then
begin
f := true;
FMarginTop := nt;
end
if nr >= 0 and nr <> FMarginRight then
begin
//f := true;
FMarginRight := nr;
end
if nb >= 0 and nb <> FMarginBottom then
begin
//f := true;
FMarginBottom := nb;
end
if f then DoControlAlign();
end
function allwidth();
begin
return FxWidth;
end
function allheigth();
begin
return FyHeight;
end
function DrawAllParts(cvs,part,merg,rec);
begin
bcvs := new TCanvsRgnClipAutoSave(cvs,rec);
for i,v in part do DrawCell(cvs,v[0],v[1],v[2]);
drawmerge(cvs,merg);
return;
end
function drawmerge(cvs,merga);
begin
for i,v in merga do
begin
rec := GetMergRect(v);
if not rec then return;
v.mergeid(ri,ci);
DrawCell(cvs,rec,ri,ci);
end
end
function GetMergRect(mr);
begin
rg := mr.GetRange();
rec := GetSubItemRect(rg[0],rg[1]);
rec2 := GetSubItemRect(rg[2],rg[3]);
if rec and rec2 then
begin
rec[2:3]:= rec2[2:3];
return rec;
end
return array();
end
function FindMerge(i,j,ret);
begin
for ii,v in FMergers do
begin
if v.CellInMerge(i,j)then
begin
f := true;
for k := 0 to length(ret)-1 do
begin
if ret[k]=v then
begin
f := false;
break;
end
end
if f then
begin
ret[length(ret)]:= v;
end
return v;
end
end
end
function GetItemCount();
begin
if FVariableRows then return FRowsHeight.Length();
return FItemCount;
end
function SetVariableRows(v);
begin
nv := v?true:false;
if nv <> FVariableRows then
begin
if not FVariableRows then
begin
if FItemCount>0 then
begin
FRowsHeight.splices(0,FRowsHeight.length(),(zeros(FItemCount)+FRowHeight));
end
end else
begin
FItemCount := FRowsHeight.Length();
end
FVariableRows := nv;
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);
begin
if FRowHeight <> h and h >= 5 then
begin
FRowHeight := h;
DoControlAlign();
end
end
function SetFixedColumns(rs);
begin
if rs >= 0 and FColumFixed <> rs then
begin
FColumFixed := rs;
DoControlAlign();
end
end
function SetFixedRows(rs);
begin
if rs >= 0 and FFixedRows <> rs then
begin
FFixedRows := rs;
DoControlAlign();
end
end
function UpDateColumWidth(idx,value);
begin
if idx >= 0 and value >= 0 then
begin
if FColsWidths[idx]=value then return;
FColsWidths[idx]:= value;
DoControlAlign();
end
end
function UpDateRowWidth(idx,value);
begin
if FVariableRows and idx >= 0 and value>=0 then
begin
if FRowsHeight[idx]=value then return;
FRowsHeight[idx]:= value;
DoControlAlign();
end
end
function UpDateFixed(); //更新固定宽度
begin
xfix := 0;
FxWidth := 0;
nx := min(FColumFixed,FColsWidths.length())-1;
for i := 0 to FColsWidths.length()-1 do
begin
vi := FColsWidths[i];
if i <= nx then xfix += vi;
FxWidth += vi;
end
if FVariableRows then
begin
FyHeight := FMarginTop;
FYfiexed := FMarginTop;
ny := min(FFixedRows,FRowsHeight.length())-1;
for i := 0 to FRowsHeight.length()-1 do
begin
vi := FRowsHeight[i];
if i <= ny then FYfiexed += vi;
FyHeight += vi;
end
end else
begin
FyHeight := FRowHeight*FItemCount;
FYfiexed := FMarginTop+FFixedRows * FRowHeight;
end
FXfiexed := FMarginLeft+xfix;
end
function setcursorsize2();
begin
IF FC_CURRENT <> FC_SIZE2 then
begin
cursor := FC_SIZE2;
FC_CURRENT := FC_SIZE2;
end
end
function setcursorsize();
begin
IF FC_CURRENT <> FC_SIZE then
begin
cursor := FC_SIZE;
FC_CURRENT := FC_SIZE;
end
end
function setcursornormal();
begin
if FC_CURRENT <> FC_NORMAL then
begin
cursor := FC_NORMAL;
FC_CURRENT := FC_NORMAL;
end
end
private
//选中
fleftdownpos;
fleftdowncell;
FSelBegin;
fselend;
fselbkcolor;
//
[weakref]Fondrawcell;
[weakref]fonhitcellsizer;
fmouseleftdown;
fcellsizerstate; // 0 调整大小无关 ,1 准备拖拽 ,2 拖拽中 3 结束拖拽
FScroolChanged;
FMergers;
FAutoScroll;
//固定***********
FXfiexed;
FYfiexed;
//********鼠标*************
FC_NORMAL;
FC_SIZE;
FC_SIZE2;
FC_CURRENT;
//******位置***************
FMarginLeft;
FMarginTop;
FMarginRight;
FMarginBottom;
//*******表头***********
FColWidth;
FRowWidth; // 变高基础高度
FxWidth;
FyHeight;
FFixedRows;
FColsWidths;
FRowsHeight;
FColumFixed;
FRowHeight;
FVariableRows; //列高可变
//****************表体*******************
FItemCount;
//*******滚动条*******
//调整列宽
FMouseSizeColumnWidth;
FSizeColum;
FCursorRect;
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);
begin
FPainter := v;
v.IncPaintLock();
end
function Destroy();
begin
FPainter.DecPaintLock();
FPainter := nil;
end
FPainter;
end
type TMerger=class()//合并单元格类型
public
FCells;
function Create();
begin
FCells := array(); // r,c value
end
function isok();
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];
j := FCells[1];
end
function CellInMerge(i,j);//是属于某个合并
begin
if isok()then
begin
if i >= FCells[0]and i <= FCells[2]and j >= FCells[1]and j <= FCells[3]then return true;
end
return false;
end
function GetRange();//获得合并的区域
begin
r := array();
if isok()then
begin
return FCells;
end
return r;
end
function SetMergeCells(rec);//合并区域
begin
FCells := array();
if not ifarray(rec)then return;
if(rec[2]>= rec[0]and rec[3]>rec[1])or(rec[2]>rec[0]and rec[3]>= rec[1])then FCells := rec;
end
end
end.