tslediter/funcext/tvclib/utslvcltree.tsf

2048 lines
59 KiB
Plaintext

unit utslvcltree;
interface
{**
@explan(说明) 树控件相关 %%
@date(20220510)
**}
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type ttreelistwnd = class(TCustomScrollControl)
{**
@explan(说明) tree控件窗口基类 %%
**}
protected //滚动窗口相关
function GetClientXCapacity();virtual; //宽度容量
begin
r := integer(ClientRect[2]/GetXScrollDelta());
return r;
end
function GetClientYCapacity();virtual; //高度容量
begin
return integer(ClientRect[3]/GetYScrollDelta());
end
function GetClientYCount();override; //高度项
begin
return FItems.Count;
end
function GetClientXCount();override; //宽度间隔
begin
return integer(FxClientMax/fColWidth);
end
function GetXScrollDelta();override;
begin
return FColWidth;
end
function GetYScrollDelta();override;
begin
return FItemHeight;
end
function PositionChanged();virtual;
begin
InvalidateRect(nil,false);
end
function UpDateScrollBar();
begin
DoControlAlign();
end
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;
UpDateScrollBar();
end
end
inherited;
end
function paint();override;
begin
xpos := GetXpos();
ypos := GetYPos();
// 计算需要重绘的区域
ps := PAINTSTRUCT().rcPaint;
tp := ps[1];
bo := ps[3];
FirstLine := integer(max(0,yPos+(tp)/FItemHeight));
LastLine := integer(min(ItemCount-1,yPos+(bo)/FItemHeight));
FirstCol := integer(max(0,xPos+ps[0]/FColWidth));
LastCol := integer(min(FColCount-1,xPos+ps[2]/FColWidth));
x := FColWidth *(0-xPos);
cvs := Canvas;
cvs.Font := font;
PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol);
end
function GetClientItemIndexs();
begin
rc := ClientRect;
r := GetRectItemIndexs(rc);
return r[0]-> r[1];
end
function doControlALign();override;
begin
if(IsUpDating())then
begin
FScroolChanged := true;
end else
begin
InitialScroll();
end
end
public //常用方法
function Create(AOwner);override;
begin
inherited;
end
function AfterConstruction();override;
begin
inherited;
FHashItems := array();
FItems := new tnumindexarrayex();
FColWidth := 10;
FColCount := 0;
FItemHeight := font.height+2;
FxClientMax := fColWidth;
FItemMinWidth := FxClientMax;
height := 400;
width := 300;
border := true;
autoscroll := 3;
ThumbTrack := true;
FScroolChanged := false;
end
function ExecuteCommand(cmd,pm);override;
begin
case cmd of
"itemupdated":
begin
return itemupdated();
end
end
return inherited;
end
function GetItemByIndex(idx);
begin
{**
@explan(说明) 通过id获得序号 %%
@param(idx)(integer) 序号 %%
@return(TcustomTreeCtlNode) 项 %%
**}
if idx >= 0 and Idx<FItems.Count then return FItems[idx];
end
function GetItemIndexByYpos(y);
begin
{**
@explan(说明) 通过y轴位置获得item序号 %%
@param(y)(integer) y轴位置 %%
@return(integer) 序号 %%
**}
py := GetYPos();
idx := integer(y/GetYScrollDelta())+py;
if idx>FItems.Count-1 then idx :=-1;
return idx;
end
Function GetItemByYPos(y);
begin
{**
@explan(说明) 通过y轴位置获得item %%
@param(y)(integer) y轴位置 %%
@return(TcustomTreeCtlNode) 项 %%
**}
idx := GetItemIndexByYpos(y);
if idx >= 0 then return FItems[idx];
end
function GetItemIndex(item,guess);
begin
{**
@explan(说明) 获得item序号 %%
@param(item)(TcustomTreeCtlNode) item %%
@return(integer) 序号 %%
**}
for i :=(guess>0?guess:0) to FItems.Count-1 do
begin
if item=FItems[i] then return i;
end
return -1;
return FItems.Indexof(item);
end
function GetItemRect(item);
begin
{**
@explan(说明) 获得item区域 %%
@param(item)(TcustomTreeCtlNode) item %%
@return(array) array(左,上,右,下) %%
**}
idx := GetItemIndex(item);
if idx >= 0 then return GetItemRectByIndex(idx);
return array();
end
function GetItemRectByIndex(idx);
begin
{**
@explan(说明) 通过id获得item区域 %%
@param(idx)(integer) 序号 %%
@return(array) array(左,上,右,下) %%
**}
if idx >= 0 and idx<FItems.Count then
begin
rc := GetIndexRect(idx);
rc[0]:= 0;
rc[2]:= ClientRect[2];
return rc;
end
return array();
end
function GetIndexRect(idx);
begin
{**
@explan(说明) 通过id获得item区域 %%
@param(idx)(integer) 序号 %%
@return(array) array(左,上,右,下) %%
**}
if idx >= 0 and idx<FItems.Count then
begin
r := GetIndexClientRect(idx);
if r then
begin
r[0]:= FColWidth *(0-GetXpos());
return r;
end
end
return array();
end
function DeleteItemByBounds(b,e);
begin
idx := b;
ei := e;
if not(idx >= 0{ and idx})then return false;
Try
IncPaintLock();
while idx <= ei do
begin
ei--;
if FItemMaxItemIndex>idx then FItemMaxItemIndex -= 1;
else if FItemMaxItemIndex=idx then FItemMaxItemIndex := nil;
it := FItems[idx];
if it then reindex(FHashItems,array(it.Handle:nil));
FItems.Deli(idx);
end
ItemUpDated();
finally
DecPaintLock();
end
end
function DeleteItemByIndex(idx);
begin
{**
@explan(说明) 删除位置的项 %%
@param(idx)(integer) 位置 %%
**}
if idx >= 0 and idx<FItems.Count then
begin
IncPaintLock();
try
if FItemMaxItemIndex>idx then FItemMaxItemIndex -= 1;
else if FItemMaxItemIndex=idx then FItemMaxItemIndex := nil;
it := FItems[idx];
if it then reindex(FHashItems,array(it.Handle:nil));
FItems.Deli(idx);
ItemUpDated();
finally
DecPaintLock();
end;
return true;
end
return false;
end
function InsertItems(its,idx);virtual;
begin
{**
@explan(说明) 在位置出入项 %%
@param(it)(array of TcustomTreeCtlNode) item %%
@param(idx)(integer) 位置 %%
**}
idx0 :=(idx >= 0 and idx<FItems.Count)?idx:FItems.Count;
idx1 := idx0;
try
IncPaintLock();
for i,it in its do
begin
if(it is class(TcustomTreeCtlNode))and(it.Owner=self)then
begin
if FHashItems[it.handle]then continue;
if it.Width>FxClientMax then
begin
FItemMaxItemIndex := idx0;
FxClientMax := it.Width;
end else
begin
if FItemMaxItemIndex >= idx0 then FItemMaxItemIndex++;
end
FItems.InsertBefor(it,idx0);
idx0++;
FHashItems[it.handle]:= it;
end
end
ItemUpDated();
finally
DecPaintLock();
end;
end
function InsertItem(it,idx);virtual;
begin
{**
@explan(说明) 在位置出入项 %%
@param(it)(TcustomTreeCtlNode) item %%
@param(idx)(integer) 位置 %%
**}
//idx0 := FItems.Count;
try
IncPaintLock();
idx0 :=(idx >= 0 and idx<FItems.Count)?idx:FItems.Count;
if(it is class(TcustomTreeCtlNode))and(it.Owner=self)then
begin
if FHashItems[it.handle]then r := false;
else
begin
if it.Width>FxClientMax then
begin
FItemMaxItemIndex := idx0;
FxClientMax := it.Width;
end else
begin
if FItemMaxItemIndex >= idx0 then FItemMaxItemIndex++;
end
FItems.InsertBefor(it,idx0);
FHashItems[it.handle]:= it;
r := true;
end
end
ItemUpDated();
finally
DecPaintLock();
end;
return r;
end
function AppendItem(v);virtual;
begin
{**
@explan(说明) 追加项 %%
@param(v)(TcustomTreeCtlNode) item %%
**}
return InsertItem(v,FItems.Count);
end
function AppendItems(vs);virtual;
begin
{**
@explan(说明) 批量追加项 %%
@param(v)(array of TcustomTreeCtlNode) 项集 %%
**}
id := FItems.count;
try
IncPaintLock();
for i,v in vs do
begin
if v is class(TcustomTreeCtlNode)then
begin
if FHashItems[v.handle]then continue;
wd := v.width;
if not(FItemMaxItemIndex >= 0)then
begin
FxClientMax := CalcMaxItemWidth();
owd := FxClientMax;
end
if FxClientMax<wd then
begin
FxClientMax := wd;
FItemMaxItemIndex := FItems.Count;
end
FItems.Append(v);
FHashItems[v.handle]:= v;
end
end
ItemUpDated();
finally
DecPaintLock();
end;
end
function PaintRect(cvs,yPos,ht,FirstLine,LastLine,xPos,wd,FirstCol,LastCol);
begin
x := wd *(0-xPos);
rc := ClientRect;
PrevPaint(FirstLine,LastLine);
for i := FirstLine to LastLine do
begin
nrc := GetIndexRect(i);
it := FItems[i];
it.paint(cvs,x,nrc[1],rc[2]-rc[1]-x,ht);
end
end
function SetTopLine(idx);virtual;
begin
{**
@explan(说明) 将idx行放入client区域 %%
@param(idx)(integer) 行号 %%
**}
if idx >= 0 and idx<FItems.count then
begin
SetYpos(idx);
end
end
function Recycling();override;
begin
Clean();
inherited;
end
function Clean();virtual;
begin
{**
@explan(说明) 清空 %%
**}
FItems.Clean();
FHashItems := array();
FxClientMax := fColWidth;
FItemMaxItemIndex := nil;
InitialScroll();
end
function ItemInList(it);
begin
if it is class(TcustomTreeCtlNode)then return FHashItems[it.Handle];
return nil;
end
function InvalidateItem(it,flag);
begin
{**
@explan(说明) 刷新项 %%
@param(it)(TcustomTreeCtlNode) 项 %%
@param(flag)(bool) 是否立刻刷新 %%
**}
if not ItemInList(it)then return ;
for i,v in GetClientItemIndexs() do
begin
if it=FItems[v]then
begin
rec := GetItemRectByIndex(v);
if rec then InvalidateRect(rec,flag);
return;
end
end
end
function GetClientItems();
begin
{**
@explan(说明) 获得 客户区的items %%
@return(array of TcustomTreeCtlNode) %%
**}
r := array();
for i,v in GetClientItemIndexs() do
begin
r[i]:= FItems[v];
end
return r;
end
published //属性
property Items read GetItems;
property ItemCount read GetItemCount;
property ItemHeight read FItemHeight write SetItemHeight;
property ItemMaxWidth read FxClientMax;
property ItemMinWidth read FItemMinWidth write SetItemMinWidth;
{**
@param(Items)(array of TcustomTreeCtlNode) 项 %%
@param(ItemMaxWidth)(integer) 最大宽度 %%
@param(ItemHeight)(integer) 项高度 %%
**}
private //其他中间函数
function GetIndexClientRect(idx);virtual;
begin
if idx >= 0 then
begin
rc := ClientRect;
yp := GetYPos();
rc[1]:=(idx-yp)* FItemHeight;
rc[3]:= rc[1]+FItemHeight;
return rc;
end
end
private //属性变量
FHashItems;
FItemHeight; //项高
FColCount; //列数
FColWidth; //列宽
FScroolChanged; //滚动条修改
FItemMinWidth;
FItemMaxItemIndex;
FItems; //项目
FxClientMax; //水平宽度
private //属性设置
function ItemUpDated();
begin
{**
@explan(说明) 更新状态 %%
@param(flag)(bool) 是否强制刷新,默认当项宽度不变的时候不刷新 %%
@param(idx)(integer) 更新id以后的序号 %%
**}
mx := CalcMaxItemWidth();
IncPaintLock();
if(FxClientMax <> mx)then
begin
FxClientMax := mx;
end
UpDateScrollBar();
DecPaintLock();
end
function GetRectItemIndexs(rc);
begin
yp := GetYPos();
tp := rc[1];
bo := rc[3];
FirstLine := integer(tp/GetYScrollDelta())+yp;
LastLine := integer((bo)/GetYScrollDelta())+yp;
return array(FirstLine,LastLine);
end
function SetItemHeight(v);
begin
nv := ((v>0)?integer(v):0);
if FItemHeight <> nv then
begin
FItemHeight := nv;
UpDateScrollBar();
end
end
function SetItemMinWidth(w);
begin
{**
@explan(说明) 设置最大宽度
**}
if w>5 and FItemMinWidth <> w then
begin
FItemMinWidth := w;
if FItemMinWidth>FxClientMax then
begin
FxClientMax := FItemMinWidth;
end
end
end
function CalcMaxItemWidth();
begin
{**
@explan(说明)计算最大的item宽度 %%
**}
mx := FItemMinWidth;
if ifnil(FItemMaxItemIndex)then
begin
FItemMaxItemIndex := 0;
for i := 0 to FItems.Count-1 do
begin
nwd := FItems[i].Width;
if nwd>mx then
begin
mx := nwd;
FItemMaxItemIndex := i;
end
end
end else
begin
return FxClientMax;
end
return mx;
end
function PrevPaint(begid,endid);virtual;
begin
end
function GetItemCount();override;
begin
return FItems.Count;
end
function GetItems();
begin
r := array();
for i := 0 to FItems.Count-1 do r[i]:= FItems[i];
return r;
end
end
type TTreeSelCHngedEvent=class(tuieventbase)
{**
@explan(说明) 导航选择改变消息%%
**}
function create(m,w,l,h);override;
begin
inherited;
end
ItemOld;
ItemNew;
Item;
{**
@param(ItemOld)(TcustomTreeCtlNode) 旧的节点 %%
@param(ItemNew)(TcustomTreeCtlNode) 新节点 %%
@param(Item)(TcustomTreeCtlNode) 当前节点 %%
**}
end
type TcustomTreeCtlNode = class(tsluibase) //树结点
{**
@explan(说明) 树结点 %%
**}
private //绘制信息
FBasePos;//周边基准位置
FCheckPos; //checkbox位置
FExpandPos; //展开按钮位置
FExpandWidth; //展开按钮宽度
FCheckWidth; //checkbox宽度
//FFocusColor;
FHierarchyWidth;
function DrawCheckBox(cvs,x,rec,sz,flag); //绘制checkbox
begin
y := rec[1];
h := rec[3];
ys := y+(h-sz)/2;
dr := array((x,ys),(x+sz,ys+sz));
ow := Owner;
dflg := flag;
if ow.OnlyLeafNodeCheckMark and ItemCount>0 then dflg := false;
cvs.Draw("FrameControl",dr,DFC_BUTTON,dflg?DFCS_CHECKED:DFCS_BUTTONCHECK);
if(not dflg)and(ItemCount>0)then
begin
if allChildChecked()then
begin
cvs.Draw("FrameControl",dr,DFC_BUTTON,DFCS_CHECKED);
end else
if ChildChecked()then
begin
cvs.brush.color :=0x0a0a0a ;//rgb(10,10,10);
cvs.fillrect(dr[0]+8 union dr[1]-4);
ow := Owner;
if self=ow.CurrentNode then cvs.brush.color := ow.selectionColor;//FFocusColor[ow.hasFocus()];
else cvs.brush.color := ow.Color;
end
end
end
function DrawExpand(cvs,x,rec,sz,flag); //绘制展开按钮
begin
ow := Owner;
if not ow then return ;
sz2 := integer(sz/2);
y := rec[1];
h := rec[3];
ys := y+(h-sz)/2;
bc := cvs.brush.color;
cvs.Pen.Color := ow.expandsigncolor;//rgb(50,50,50);
cvs.Pen.style := PS_SOLID;
case ow.expandsigntype of
tvestTheme:
begin
cvs.Pen.width := 2;
if flag then
begin
cvs.MoveTo(array(x,ys));
cvs.LineTo(array(x+sz2,ys+sz-2));
cvs.LineTo(array(x+sz,ys));
end else
begin
cvs.MoveTo(array(x,ys));
cvs.LineTo(array(x+sz-2,ys+sz2));
cvs.LineTo(array(x,ys+sz));
end
end
tvestArrow:
begin
cvs.Pen.width := 2;
if flag then
begin
ps := array((x,ys),(x+sz2,ys+sz-2),(x+sz,ys),(x,ys));
end else
begin
ps := array((x,ys),(x+sz-2,ys+sz2),(x,ys+sz),(x,ys));
end
cvs.brush.color := ow.color;
cvs.draw("polygon",ps);
end
tvestArrowFill:
begin
if flag then
begin
ps := array((x,ys),(x+sz2,ys+sz-2),(x+sz,ys),(x,ys));
end else
begin
ps := array((x,ys),(x+sz-2,ys+sz2),(x,ys+sz),(x,ys));
end
cvs.brush.color := cvs.pen.color;
cvs.draw("polygon",ps);
end
else
//tvestPlusMinus:
begin
dr := array(array(x,ys),array(x+sz,ys+sz));
cvs.brush.color := ow.color;
cvs.draw("rectangle",dr);
cvs.MoveTo(array(x+2,ys+sz/2));
cvs.LineTo(array(x+sz-2,ys+sz/2));
if not flag then
begin
cvs.MoveTo(array(x+sz/2,ys+2));
cvs.LineTo(array(x+sz/2,ys+sz-2));
end
end
end;
cvs.brush.color := bc;
cvs.pen.Width := 1;
end
function ChildChecked();
begin
for i := 0 to FItems.Count-1 do
begin
it := FItems[i];
ow := Owner;
if ow and ow.OnlyLeafNodeCheckMark then
begin
if it.checked and it.ItemCount<1 then return true;
if it.ChildChecked()then return true;
end else
begin
if it.Checked then return true;
if it.ChildChecked()then return true;
end
end
return false;
end
function allChildChecked();
begin
if FItems.Count<1 then return false;
for i := 0 to FItems.Count-1 do
begin
it := FItems[i];
if it.ItemCount<1 then
begin
if not it.Checked then return false;
end else
begin
if not it.allChildChecked()then return false;
end
end
return true;
end
public //常用函数
function Create(List);override;
begin
inherited create();
initnodehandle();
if(List is class(TcustomTreeCtl))then
begin
FOwner := List;
end
FWidth := 30;
FVisible := true;
FMouseCanChecked := true;
FModifyChildrenChecked := true;
//FFocusColor := array(0xfaf0e6,0xfac000) ;//array(rgb(230,240,250),rgb(0,192,250));
FCheckWidth := 16;
FExpandWidth := 12;
FBasePos := 10;
FHierarchyWidth := 20;
FItems := new tnumindexarrayex(); //子项
FHierarchy :=-1;
FEexpanded := false;
FChecked := false;
FExpandImgId :=-1;
end
function Paint(cvs,x,y,w,h);override; //绘制
begin
{**
@explan(说明)绘制节点%%
**}
ow := Owner;
if not ow then return;
//cvs.Pen.Color := 0x323232;//rgb(50,50,50);
//cvs.Pen.style := PS_SOLID;
//cvs.Pen.width := 1;
inv := 3;
BasePos := FBasePos+x;
FCheckPos := BasePos;
fitemcountflg := ItemCount or FDirtype;
for i := 1 to Hierarchy do
BasePos += FHierarchyWidth;
cbase := BasePos;
//itc := 0;
ExpWidth := FExpandWidth;
ifsel := false;
if self=ow.CurrentNode then
begin
ifsel := true;
cvs.brush.Color := ow.selectionColor;//FFocusColor[ow.hasFocus()];
end else
cvs.brush.Color := ow.Color;
if fitemcountflg then
begin
//itc := true;
BasePos += inv;
FExpandPos := BasePos;
//DrawExpand(cvs,BasePos,array(x,y,w,h),ExpWidth-2,FExpanded);
dexpinfo := array(cvs,BasePos,array(x,y,w,h),ExpWidth-2,FExpanded);
BasePos += ExpWidth;
end else //else ExpWidth := 0;
begin
BasePos += ExpWidth+inv;
end
CheckWidth := FCheckWidth;
if ow.CheckBox then
begin
BasePos += inv;
FCheckPos := BasePos;
DrawCheckBox(cvs,BasePos,array(x,y,w,h),CheckWidth,FChecked);
BasePos += CheckWidth;
BasePos += inv;
end else
CheckWidth := false;
img := ow.ImageList;
iwidth := 0;
if(img and img.HandleAllocated())then
begin
if(ifsel and FSelImgId >= 0)or(FImgId >= 0)or(FExpandImgId >= 0 and fitemcountflg>0 and FExpanded)then //绘制selimage
begin
if(FExpandImgId >= 0)and fitemcountflg>0 and FExpanded then
begin
img.Draw(FExpandImgId,cvs,BasePos,y+1,nil);
end else
if(ifsel and FSelImgId >= 0)then
begin
img.Draw(FSelImgId,cvs,BasePos,y+1,nil);
end else
if FImgId >= 0 then
begin
img.Draw(FImgId,cvs,BasePos,y+1,nil);
end
BasePos += img.Height;
BasePos += inv;
end
//echo "\r\nimg";
end
FCaptionRect := array(BasePos,y,BasePos+w,y+h); //修正宽度处理20240820
cvs.FillRect(FCaptionRect);
cvs.drawtext(FCaption,FCaptionRect,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
if ow.HasLine then
begin
cvs.Pen.Color := ow.LineColor;
cvs.Pen.style := ow.Linestyle;
for i,v in ow.ExecuteCommand("gethierarchybyhandle",self.Handle) do
begin
nx := cbase+FHierarchyWidth *(i-FHierarchy-1)+6;
if nx>cbase-5 then break;
cvs.MoveTo(array(nx,y));
if i=FHierarchy and Parent.LastChild=self then
cvs.LineTo(array(nx,y+h/2+1));
else cvs.LineTo(array(nx,y+h));
end
cvs.MoveTo(array(cbase+ExpWidth,y+h/2));
cvs.LineTo(array(cbase-FHierarchyWidth+6,y+h/2));
end
if dexpinfo then
DrawExpand(cvs,dexpinfo[1],dexpinfo[2],dexpinfo[3],dexpinfo[4]);
end
function MouseUp(o,e);
begin
{**
@explan(说明) 点击消息处理
**}
//ps := e.pos;
px := e.xpos;//ps[0];
rec := o.GetIndexRect(o.GetItemIndexByYpos(e.ypos)); //获得位置
recx := rec[0];
if(FItems.Count or FDirtype)and px >= FExpandPos and px <=(FExpandPos+FExpandWidth)then //点击展开
begin
if mbLeft=e.button()then
begin
if FExpanded then UnExpand();
else Expand();
end else
begin
e.skip := true;
end
end else
if Owner.CheckBox and MouseCanChecked and px >= FCheckPos and px <=(FCheckPos+FCheckWidth)then //点击checkbox
begin
//setprofiler(1+2+4);
if mbLeft=e.button()then
begin
Checked := not FChecked;
p := parent;
while p and(p is class(TcustomTreeCtlNode)) do
begin
Owner.InvalidateItem(p,0);
p := p.parent;
end
end else
e.skip := true;
//exportfile(ftstream(),"","d:\\tst\\abc.stm",getprofilerinfo(true));
end else
if px>FCheckPos then //点击文本
begin
return true;
end
return false;
end
function GetNodeByIndex(idx);
begin
{**
@explan(说明) 通过序号获得子节点%%
@param(idx)(TcustomTreeCtlNode) %%
**}
if idx >= 0 then return FItems[idx];
return nil;
end
function indexof(v); //获得序号
begin
return FItems.indexof(v);
end
function UpDateHierarchy(); //更新层级
begin
if not Parent then return;
ph := Parent.Hierarchy;
nh := ph+1;
if FHierarchy <> nh then
begin
FHierarchy := nh;
for i := 0 to FItems.Count-1 do
begin
FItems[i].UpDateHierarchy();
end
end
UpDateWidth();
end
function AppendNodeStr(s);override;
begin
{**
@explan(说明) 追加一个节点 %%
@param(s)(string) 字符串 %%
@return(TcustomTreeCtlNode) 新节点 %%
**}
ow := Owner;
idx := FItems.Count;
return InsertNodeStr(s,idx);
end
function InsertNodeStr(s,idx);override;
begin
{**
@explan(说明) 插入一个节点 %%
@param(s)(string) 字符串 %%
@param(idx)(integer) 序号 %%
@return(TcustomTreeCtlNode) 新节点 %%
**}
if not(idx >= 0)then idx := 0;
ow := Owner;
if not ow then return;
it := ow.CreateTreeNode(ow); //new TcustomTreeCtlNode(ow);
it.Caption := s;
InsertNode(it,idx);
return it;
end
function GetIndex();virtual;
begin
{**
@explan(说明) 获得在父节点中的序号 %%
@return(integer) 序号 %%
**}
if Parent then Parent.indexof(self);
end
function AncestorIsExpand();virtual;
begin
{**
@explan(说明) 是否一致展开 %%
@return(bool) 展开为true,否则为false %%
**}
r := Expanded;
if not(r)then return false;
if Parent then return Parent.AncestorIsExpand();
return r;
end
function AppendNode(it);virtual;
begin
{**
@explan(说明) 插入一个节点 %%
@param(it)(TcustomTreeCtlNode) 节点 %%
@return(bool) 是否成功 %%
**}
return InsertNode(it,FItems.Count);
end
function HasNode(nd);virtual;
begin
{**
@explan(说明) 是否为某个节点的祖先节点 %%
@param(nd)(TcustomTreeCtlNode) 子节点 %%
@return(TcustomTreeCtlNode|0) 如果为祖先节点,就返回查询节点的父节点 %%
**}
if not(nd is class(TcustomTreeCtlNode))then return 0;
ow := Owner;
if not ow then return;
if ow <> nd.Owner then return 0;
p1 := nd.Parent;
p := p1;
while p do
begin
if p=self then return p1;
if p is class(TcustomTreeCtlNode)then p := p.Parent;
end
return 0;
end
function DeleteNode(nd);virtual;
begin
{**
@explan(说明) 删除节点 %%
@param(nd)(TcustomTreeCtlNode) 待删除节点 %%
**}
if nd=self then return 0;
pn := HasNode(nd);
if not pn then return;
return pn.DeleteChildNode(nd);
end
function DeleteChildNode(nd);
begin
{**
@explan(说明) 删除子节点%%
@param(nd)(TcustomTreeCtlNode) 节点 %%
**}
idx :=-1;
idx := indexof(nd);
if idx=-1 then return 0;
return DeleteNodeByIndex(idx);
end
function DeleteNodeByIndex(idx);
begin
{**
@explan(说明) 根据位置删除节点%%
@param(idx)(integer) 序号 %%
**}
nd := FItems[idx];
if not nd then return;
try
Owner.IncPaintLock();
nd.UnExpand();
if Owner.NodeInList(nd)then //在显示
begin
Owner.DeleteItemByIndex(Owner.GetItemIndex(nd));
end
FItems.Deli(idx);
FCurrentDeleteNode := nd;
nd.parent := self(true);
FCurrentDeleteNode := nil;
if nd = Owner.CurrentNode then
begin
Owner.SetSel(nil);
end
finally
Owner.DecPaintLock();
end
return true;
end
function DeleteChildren();virtual; //
begin
{**
@explan(说明) 删除所有的子节点%%
**}
try
Owner.IncPaintLock();
r := true;
if self=Owner.RootNode then
begin
while ItemCount>0 DO
begin
DeleteNodeByIndex(0);//DeleteChildNode(FItems[0]);
end
r := false;
end
if r then
begin
UnExpand(); //折叠
while ItemCount>0 do
begin
idx := 0; //ItemCount-1;
it := FItems[idx];
FCurrentDeleteNode := it;
it.parent := self(true);
FCurrentDeleteNode := nil;
FItems.Deli(idx);
end
end
finally
Owner.DecPaintLock();
end
end
function GetLastShowNode();
begin
{**
@explan(说明) 获得展示的最后第一个节点 %%
@return(TcustomTreeCtlNode) %%
**}
if FItems.Count<1 or not(FExpanded)then return self;
for i := FItems.Count-1 downto 0 do
begin
it := FItems[i];
if it.Visible then return it.GetLastShowNode();
end
return self;
return it.GetLastShowNode();
end
function InsertNodes(its,idx);virtual;
begin
{**
@explan(说明) 插入一个节点 %%
@param(it)( array of TcustomTreeCtlNode) 字符串 %%
@param(idx)(integer) 序号 %%
**}
idx0 := idx;
if not(idx >= 0)then idx0 := 0;
if idx>FItems.Count then idx0 := FItems.Count;
nits := array();
nitsi := 0;
flag := false;
bidx := idx0;
for i,it in its do
begin
if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
begin
odexp := it.Expanded;
it.UnExpand();
FItems.InsertBefor(it,idx0);
FCurrentAddNode := it;
it.Parent := self(true);
FCurrentAddNode := nil;
it.UpDateHierarchy();
nits[nitsi++]:= it;
idx0++;
flag := true;
end
end
if flag and Expanded and Owner.NodeInList(self)then
begin
preItem := FItems[bidx-1];
bx := 0;
//if preItem then bx := Owner.GetItemIndex( preItem.GetLastShowNode())+1;
if preItem then bx := Owner.GetItemIndex(preItem.GetLastShowNode(),bidx)+1;
else bx := owner.GetItemIndex(self)+1;
owner.InsertItems(nits,bx);
end
end
function InsertNode(it,idx);virtual;
begin
{**
@explan(说明) 插入一个节点 %%
@param(it)(TcustomTreeCtlNode) 字符串 %%
@param(idx)(integer) 序号 %%
**}
if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
begin
if idx<0 then idx := 0;
if idx>FItems.Count then idx := FItems.Count;
if not(idx >= 0)then idx := 0;
odexp := it.Expanded;
it.UnExpand();
FItems.InsertBefor(it,idx);
FCurrentAddNode := it;
it.Parent := self(true);
FCurrentAddNode := nil;
it.UpDateHierarchy();
if Expanded and Owner.NodeInList(self) and it.Visible then //处理节点visibe 的问题
begin
/////////////////处理隐藏节点导致插入次序显示问题/////////////////////
tidx := idx;
while tidx>0 do
begin
tidx--;
preItem := FItems[tidx];
if preItem and preItem.Visible then
begin
break;
end else preItem := 0;
end
///////////////////////////////
bx := 0;
if preItem then bx := Owner.GetItemIndex(preItem.GetLastShowNode())+1;
else bx := owner.GetItemIndex(self)+1;
owner.InsertItem(it,bx);
end
return true;
end
end
function Expand();virtual; //展开
begin
{**
@explan(说明) 展开节点 %%
**}
ow := Owner;
if ow and ow.RootNode=self then return;
if FExpanded then return;
if ItemCount<1 then //空节点展开
begin
if FDirtype then
begin
ow.ExecuteCommand("emptynodeexpanding",self(true));
end
return;
end
//if not Owner.NodeInList(self) then return;
idx :=-1;
if(Owner.NodeInList(self))then
begin
its := GetShowNodes();
idx := Owner.GetItemIndex(self);
Owner.InsertItems(its,idx+1);
end
FExpanded := true;
//return true;
if Owner.SingleExpand then
begin
p := Parent;
if p is class(TcustomTreeCtlNode)then
begin
PItems := p.FItems;
ct := PItems.Count;
if ct>1 then
begin
Owner.UpDateWindow();
for i := 0 to ct-1 do
begin
vi := PItems[i];
if vi=self then continue;
vi.UnExpand();
end
end
end
end
if idx >= 0 then
begin
owner.InvalidateItem(self,flag);
end
return true;
end
function UnExpand();virtual; //折叠
begin
{**
@explan(说明) 折叠节点 %%
**}
if Owner and Owner.RootNode=self then return;
if not FExpanded then return;
if ItemCount<1 then return;
idx :=-1;
idx := Owner.GetItemIndex(self);
it := GetLastShowNode();
idx2 := Owner.GetItemIndex(it,idx);
owner.DeleteItemByBounds(idx+1,idx2);
//父节点为展开
FExpanded := false;
if idx >= 0 then
begin
Owner.InvalidateItem(self,flag);
end
end
function RecyclingChildren();virtual;
begin
while ItemCount>0 do
begin
it := FItems[0];
//echo "\r\n删除",it.Caption;
it.Recycling();
end
end
function Recycling();override;
begin
p := FParent;
if p then
begin
p.DeleteNode(self);
end
while ItemCount>0 do
begin
it := FItems[0];
it.Recycling();
end
//if self<>Owner.RootNode then
FOwner := nil;
inherited;
end
function GetShowItemCount();
begin
r := 1;
if not FExpanded then return r;
for i := 0 to FItems.Count-1 do
begin
it := FItems[i];
if it.Visible then //可见
begin
r++;
if it.ItemCount and it.Expanded then r += it.GetShowItemCount();
end
end
return r;
end
function GetShowNodes();
begin
{**
@explan(说明) 获得展开的所有子节点 %%
@return(array of TcustomTreeCtlNode) %%
**}
lst := array();
for i := 0 to FItems.Count-1 do
begin
it := FItems[i];
if it.Visible then
begin
lst union=array(it);
if it.ItemCount and it.Expanded then lst union=it.GetShowNodes();
end
end
return lst;
end
function toarray();virtual;
begin
{**
@explan(说明) 转换为数组 %%
**}
r := array();
r["type"]:= "treenode";
r["caption"]:= FCaption;
mid := FImgId;
smid := FSelImgId;
r["imgid"]:= mid >= 0?mid:(-1);
r["selimgid"]:= smid >= 0?smid:(-1);
if _tag then r["tag"]:= _tag;
if Checked then r["checked"]:= true;
if ItemCount then
begin
r["nodes"]["type"]:= "treenodes";
for i := 0 to ItemCount-1 do
begin
r["nodes"]["items"][i]:= GetNodeByIndex(i).toarray();
end
end
return r;
end
property ImgId read FImgId write SetImgId;
property SelImgId read FSelImgId write SetSelImgId;
property ExpandImgId read FExpandImgId write SetExpandImgId;
property Visible read FVisible write SetVisible;
property ItemCount read GetItemCount; //节点数
property Hierarchy Read FHierarchy; //层次
property Expanded read GetExpanded; //展开
property Parent read FParent write SetParent; //父节点
property Checked read FChecked write SetChecked; //选择
property LastChild read GetLstChild;
property dirtype read FDirtype write FDirtype; //目录类型
property Caption read FCaption write SetCaption; //标题
property MouseCanChecked read FMouseCanChecked write FMouseCanChecked;
property ModifyChildrenChecked read FModifyChildrenChecked write FModifyChildrenChecked;
{**
@param(ItemCount)(integer) 子节点数量 %%
@param(Hierarchy)(integer) 层级 %%
@param(Expanded)(bool) 是否展开 %%
@param(Parent)(TcustomTreeCtlNode) 父节点 %%
@param(LastChild)(TcustomTreeCtlNode) 最后一个子节点 %%
@param(dirtype)(bool) 目录类型 %%
@param(Checked)(bool) 是否勾选 %%
@param(Visible)(bool) 可见 %%
@param(ModifyChildrenChecked)(bool) 勾选的时候是否修改自己的勾选状态 %%
@param(MouseCanChecked)(bool) 能否使用鼠标点击勾选 %%
**}
property Width read FWidth write SetWidth;
property Handle read FHandle;
property Owner read FOwner;
{**
@param(width)(integer) 宽度 %%
@param(Owner)(TcustomTreeCtl) 所有者 %%
**}
protected //父子节点设置相关
property CurrentDeleteNode read FCurrentDeleteNode;
property CurrentAddNode read FCurrentAddNode;
FItems; //子项
[weakref]FParent; //父节点
function Gitems();
begin
return FItems;
end
function SetParent(V);virtual;
begin
ow := Owner;
if not ow then return;
if ow.RootNode=self then return;
tp := Parent;
if(v is class(TcustomTreeCtlNode))and v.Owner=ow then
begin
if v.CurrentAddNode=self then
begin
FParent := v; //新节点
end else
if v.CurrentDeleteNode=self then //从节点移除
begin
FParent := nil;
end else
begin
if tp=v then return;
if tp then
begin
tp.DeleteNode(self(true));
end
v.InsertNode(self(true),v.ItemCount);
end
end else
begin
if tp then tp.DeleteNode(self(true));
end
end
function SetChecked(v);virtual; //设置checked
begin
nv := v?true:false;
if nv <> FChecked then
begin
FChecked := nv;
if ModifyChildrenChecked then
begin
for i := 0 to ItemCount-1 do
begin
FItems[i].Checked := nv;
end
end
ow := Owner;
if ow then ow.InvalidateItem(self,false);
end
end
private //成员变量
FHandle;
FWidth;
[weakref]FOwner;
///////////节点成员
FVisible;
FDirtype;
FImgId;
FMouseCanChecked;
FModifyChildrenChecked;
FSelImgId;
FCurrentDeleteNode;
FCurrentAddNode;
FExpanded;
FExpandImgId;
FHierarchy; //层级
FCaption; //标题
FChecked; //选择
static fnodehandlebase; //////
private //普通属性设置
function initnodehandle();//给当前节点分配一个id
begin
if not(fnodehandlebase>0) then fnodehandlebase:= 0xff;
fnodehandlebase := fnodehandlebase+1;
FHandle := fnodehandlebase;
end
function SetWidth(w);virtual;
begin
if w>0 and w <> FWidth then
begin
ow := Owner;
if ow and(ow.ItemMaxWidth=FWidth)or(ow.ItemMaxWidth<w)then //当前以及最大
begin
tz := true;
end
FWidth := w;
if tz and ow.ItemInList(self)then
begin
ow.ExecuteCommand("itemupdated",true);
end
end
end
function GetLstChild();
begin
return FItems[FItems.Count-1];
end
function SetImgId(id);
begin
if(id>-2)and(id<1000)and id <> FImgId then
begin
FImgId := integer(id);
end
end
function SetExpandImgId(id);
begin
if id>-2 and(id<1000)and id <> FExpandImgId then
begin
FExpandImgId := integer(id);
end
end
function SetSelImgId(id);
begin
if(id>-2)and(id<1000)and id <> FSelImgId then
begin
FSelImgId := id;
end
end
function SetVisible(v); //可见设置
begin
if Owner.RootNode = self then return ;
nv := v?true:false;
if nv<>FVisible then
begin
FVisible := nv;
p := Parent;
if not p then return ; //无父节点
if p<>Owner.RootNode then //非根节点
begin
if not Owner.NodeInList(p) then return 0;// 不在列表中
if not p.Expanded then return 0; //非展开
pidx := Owner.GetItemIndex(p); //获得位置
end else //根节点
begin
pidx := -1;
end
UnExpand(); //折叠
if nv then //变得可见
begin
cidx := p.GetShowNodeidx(self);
idx := pidx+cidx+1;
Owner.InsertItem(self(true),idx);
end else //变得不可见
begin
idx := Owner.GetItemIndex(self);
owner.DeleteItemByBounds(idx,idx);
end
end
end
function GetShowNodeidx(nd); //获得子节点在父节点后面的序号
begin
idx := 0;
for i := 0 to FItems.Count-1 do
begin
it := FItems[i];
if it = nd then return idx;
if it.Visible then
begin
idx++;
if it.ItemCount and it.Expanded then
idx += it.GetShowNodeidx(0);
end
end
return idx;
end
function SetCaption(v);virtual; //设置标题
begin
if ifstring(v)and V <> FCaption then
begin
FCaption := v;
UpDateWidth();
end
end
function UpDateWidth();
begin
bwid := 60;
for i := 1 to FHierarchy do
begin
bwid += FHierarchyWidth;
end
if ifstring(FCaption)and FCaption then
begin
fw := 8;
if Owner then
begin
ft := Owner.Font;
fw := abs(ft.Width);
if fw=0 then fw := integer(abs(ft.Height)/2);
end
bwid += length(FCaption)* fw;
end
width := bwid;
end
function GetExpanded();virtual; //已经展开
begin
if Owner and Owner.RootNode=self then return true;
return FExpanded;
end
function GetItemCount(); //子节点数
begin
return FItems.Count;
end
end
type TcustomTreeCtl = class(ttreelistwnd)
{**
@explan(说明) 树控件 %%
**}
public //常用
function Create(AOwner);override;
begin
inherited;
end
function AfterConstruction();override;
begin
inherited;
fexpandsigntype := tvestPlusMinus;
fexpandsigncolor := 0;
flinecolor := 0x969696;
FselectionColor := 0xfac000;
Linestyle := PS_DOT;
fcountlocker := new tcountkernel();
FSingleExpand := false;
FCheckBox := false;
FHasLine := false;
FNodeHierarchyWidth := 20;
FMulSelected := false;
FMulSelects := array();
fnodecreator := class(TcustomTreeCtlNode);
end
function ExecuteCommand(cmd,pm);override;
begin
case cmd of
"gethierarchybyhandle":
begin
if FPaintArray then return FPaintArray[pm];
return nil;
end
"addlocked":
begin
return new tcountlocker(fcountlocker);
end
"emptynodeexpanding":
begin
if HandleAllocated()then
begin
if FonEmptyNodeExapanding then
begin
e := new TTreeSelCHngedEvent(0,0,0,0);
e.item := pm;
e.ItemNew := pm;
e.ItemOld := pm;
CallMessgeFunction(FonEmptyNodeExapanding,self(true),e);
end
end
return ;
end
end
return inherited;
end
function InsertItem(it,idx);override;
begin
if it is class(TcustomTreeCtlNode)then return inherited;
return false;
end
function InsertItems(its,idx);override;
begin
lst := array();
lsti := 0;
for i,it in its do if it is class(TcustomTreeCtlNode)then lst[lsti++]:= it;
inherited InsertItems(lst,idx);
end
function hasFocus();virtual;
begin
return true;
end
function AppendItem(it);override;
begin
if it is class(TcustomTreeCtlNode) then return inherited;
return false;
end
function SetSel(it);virtual;
begin
{**
@explan(说明) 设置选中节点 %%
@param(it)(TcustomTreeCtlNode) 节点 %%
**}
if fcountlocker.locked then return ;
if it=FCurrentNode then return ;
lk := new tcountlocker(fcountlocker);
if ifnil(it) or ( (it is class(TcustomTreeCtlNode))and (it.Owner=self)) then
begin
r := CallSelChange(it);
if r then return;
if it=RootNode then return ;
IF HandleAllocated()then
begin
GoToNode(it);
end
if not r then InValidateRect(nil,false);
end
end
function GoToNode(it);
begin
if not((it is class(TcustomTreeCtlNode))and (it.Owner=self)) then return ;
if not it.Visible then return ;
if NodeInList(it)then
begin
//return SetTopLine(GetItemIndex(it)); //滚动
idxs := GetClientItemIndexs();
id := GetItemIndex(it);
if(idxs[0]<= id)and(idxs[length(idxs)-1]>= id)then //在可视窗口不需要滚动
begin
return;
end else
begin
return SetTopLine(max(0,id-integer(length(idxs)/2))); //滚动 +integer(length(idxs)/2)
end
end else
begin
p := it.Parent;
while p do
begin
p.Expand();
if NodeInList(p)then
begin
f := true;
break;
end
p := p.parent;
end
if f then return GoToNode(it);
end
end
function InitializeWnd();override;
begin
inherited;
if FCurrentNode then GoToNode(FCurrentNode);
end
function imageChanged();override;
begin
changeitemheight();
inherited;
end
function CreateTreeNode();virtual;
begin
return createobject(fnodecreator,self(true));
end
function NodeInList(it);
begin
{**
@explan(说明)节点是否在窗口中展示 %%
**}
if it=FRootItem then return FRootItem;
return ItemInList(it);
end
function DeleteNode(nd);virtual;
begin
if FRootItem then FRootItem.DeleteNode(nd);
end
function MouseDown(o,e);override;
begin
if e.shiftdouble()and e.button()=mbLeft then //双击
begin
//添加双击折叠展开
it := GetItemByYpos(e.ypos);
if it and(it.ItemCount or it.dirtype)and not(it.Expanded)then it.Expand();
else if it and it.ItemCount and it.Expanded then
begin
it.UnExpand();
end else
CallMessgeFunction(ondblclick,o,e);
end
end
function MouseUp(o,e);override;
begin
{**
@explan(说明)点击%%
**}
if csDesigning in ComponentState then return;
it := GetItemByYpos(e.ypos);
if it then
begin
if it.MouseUp(o,e)then
begin
SetSel(it);
//CallSelChange(it); //单选
//多选
end
end
bt := e.button();
if bt=mbRight then
begin
CallMessgeFunction(onrclick,o,e);
end else
if bt=mbLeft then
begin
CallMessgeFunction(onclick,o,e);
end
//e.skip := true;
end
function WMKEYUP(o,e);override;
begin
if not FCurrentNode then return;
if e.skip then return ;
case e.charcode of
VK_UP,VK_DOWN:
begin
id := GetItemIndex(FCurrentNode);
setsel(GetItemByIndex((VK_UP=e.charcode)?(id-1):(id+1)));
end
VK_LEFT:
begin
if FCurrentNode.Expanded then
begin
FCurrentNode.UnExpand()
end
else
begin
p := FCurrentNode.Parent;
if RootNode=p then return ;
SetSel(p);
end
end
VK_RIGHT:
begin
FCurrentNode.Expand();
end
end;
end
function Clean();override;
begin
if FRootItem then
begin
lk := new tcountlocker(fcountlocker);
FRootItem.DeleteChildren();
end
end
function Recycling();override;
begin
lk := new tcountlocker(fcountlocker);
if FRootItem then FRootItem.Recycling();
FRootItem := nil;
FCurrentNode := nil;
FOnSelChanging := nil;
FonEmptyNodeExapanding := nil;
//fnodecreator := nil;
inherited;
end
procedure FontChanged(Sender:TObject);override;
begin
//if parent then parent.FontChanged(Sender);
changeitemheight();
inherited;
end
function ncpaint(rec);override;
begin
dc := Canvas;
ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0));
dc.pen.color := rgb(171,173,179);
dc.draw("polyline",ls);
end
published //属性
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
property CheckBox:bool read FCheckBox write SetCheckBox;
property HasLine:bool read FHasLine write SetHasLine;
property LineColor:color read Flinecolor write Setlinecolor;
property Linestyle:linestyle read fLinestyle write Setlinestyle;
property OnlyLeafNodeCheckMark read FOnlyLeafNodeCheckMark write FOnlyLeafNodeCheckMark;
//property NodeHierarchyWidth read FNodeHierarchyWidth write SetNodeHierarchyWidth;
property RootNode read GetRootNode;
//property MulSelected read FMulSelected write FMulSelected;
property SingleExpand read FSingleExpand write FSingleExpand;
property expandsigntype:tvexpandsigntype read fexpandsigntype write setexpandsigntype;
property expandsigncolor:color read fexpandsigncolor write setexpandsigncolor;
property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged;
property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging;
property onEmptyNodeExapanding read FonEmptyNodeExapanding write FonEmptyNodeExapanding;
property nodecreator read fnodecreator write setnodecreator;
protected //子类可以用的函数
function GetRootNode();virtual; //获得根节点
begin
if not(FRootItem)or(ifobj(FRootItem)and(FRootItem.ReCycleState <> 0))then
begin
FRootItem := CreateTreeNode();
end
//echo FRootItem.Owner,"\r\n";
return FRootItem;
end
private //成员变量
fcountlocker; //锁定changed回调
fexpandsigntype;
fexpandsigncolor;
flinecolor;
fLinestyle;
FselectionColor;
weakref
fnodecreator;
FOnlyLeafNodeCheckMark;
FOnSelChanging;
FonEmptyNodeExapanding;
FOnSelChanged;
autoref
FCurrentNode;
FNodeHierarchyWidth;
FMulSelected;
FMulSelects;
FSingleExpand;
FRootItem;
FCheckBox;
FHasLine;
FPaintArray;
private //成员方法
function SetselectionColor(v);
begin
if not ifnumber(v) then return ;
vn := int(v);
if (vn<>FselectionColor) then
begin
FselectionColor := nv;
InvalidateRect(nil,false);
end
end
function Setlinestyle(v);
begin
if (v<>fLinestyle) and (v in array(0,1,2,3,4,5,6)) then
begin
fLinestyle := v;
InvalidateRect(nil,false);
end
end
function Setlinecolor(v);
begin
if not ifnumber(v) then return ;
vn := int(v);
if vn=flinecolor then return ;
flinecolor := vn;
InvalidateRect(nil,false);
end
function setexpandsigntype(v);
begin
if not(v in array(0,1,2,3)) then return ;
if v=fexpandsigntype then return ;
fexpandsigntype := v;
InvalidateRect(nil,false);
end
function setexpandsigncolor(v);
begin
if not ifnumber(v) then return ;
vn := int(v);
if vn=fexpandsigncolor then return ;
fexpandsigncolor := vn;
InvalidateRect(nil,false);
end
function changeitemheight();
begin
ft := font;
if not ft then return ;
if imageList is class(TCustomImageList)then
begin
ItemHeight := max(imageList.Height,ft.height) +2;
end else
begin
ItemHeight := max(5,ft.height) +2;
end
end
function setcurrentnode(nd);
begin
setsel(nd);
end
function setnodecreator(nd);
begin
if (fnodecreator<>nd) and (nd is class(TcustomTreeCtlNode)) then
begin
fnodecreator := nd;
if FRootItem then
begin
FRootItem.Recycling();
FRootItem := nil;
end
end
end
function SetNodeHierarchyWidth(v);
begin
if v >= 0 and FNodeHierarchyWidth <> v then
begin
end
end
function CallSelChange(it);
begin
r := 0;
if FCurrentNode <> it then
begin
t1 := FCurrentNode;
//if t1 then InvalidateItem(t1,false);
//InvalidateItem(it,false);
ne := new TTreeSelCHngedEvent(0,0,0,0);
ne.ItemOld := t1;
ne.ItemNew := it;
ne.Item := it;
CallMessgeFunction(FOnSelChanging,self(true),ne);
if ne.Skip then return true;
FCurrentNode := it;
CallMessgeFunction(FOnSelChanged,self(true),ne);
end
return r;
end
function PrevPaint(begid,endid);virtual;
begin
if not FHasLine then return;
currentline := array();
FPaintArray := array();
lasthi := 0;
Chi := 0;
//sh := new TMyArrayB();
for i := ItemCount-1 downto begid do
begin
if not it then
begin
it := GetItemByIndex(i);
lasthi := it.Hierarchy;
if lasthi<1 then continue;
currentline[lasthi]:= 1;
end else
begin
it2 := GetItemByIndex(i);
chi := it2.Hierarchy;
if chi>0 then
begin
currentline[chi]:= 1;
if chi<lasthi then //当前小于原有的
begin
for ii := chi+1 to lasthi do reindex(currentline,array(ii:nil));
end else
if chi >= lasthi then
begin
currentline[chi]:= 1;
end
end
end
lasthi := chi;
if it2 then it := it2;
if i <= endid and it then
begin
FPaintArray[it.Handle]:= currentline;
//sh.unshift( array(array2str(mrows( currentline,1),","),"===>"+inttostr(it.Hierarchy),"%%"+it.caption));
end
end
end
function SetHasLine(v); //hasline
begin
nv := v?true:false;
if nv <> FHasLine then
begin
FHasLine := nv;
InvalidateRect(nil,false);
end
end
function SetCheckBox(v);
begin
bv := v?true:false;
if bv <> FCheckBox then
begin
FCheckBox := bv;
end
end
end
implementation
initialization
end.