unit UntMaint;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs , ComCtrls, StdCtrls,UntTListCtrl, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
PaintBox1: TPaintBox;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
//返回所选择接点的索引
procedure Draw;
function SelectOne(const Y:integer):integer;
// function SelectOne(const Y: integer): integer;
public
{ Public declarations }
lt:TListCtrl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
lt:=TListCtrl.Create;
FORM1.DoubleBuffered:=true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
lt.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
str:string;
begin
str:= 'Node';
if InputQuery('Input Box', 'Caption:',str)then
lt.NewList(str,'');
button2.Click;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
lt.DrawAllName(PaintBox1.Canvas);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
str:string;
begin
str:= 'Node';
if InputQuery('Input Box', 'Caption:',str)then
lt.NewList(str,lt.GetActiveID);
button2.Click;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
lt.DeleteAll;
PaintBox1.Repaint;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
//ShowMessage(inttostr(lt.FIndAllChild(lt.ActiveIndex)));
lt.DeleteOne(lt.ActiveIndex);
//lt.PfAllName(PaintBox1.Canvas )
Draw;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
showmessage(lt.GetActiveID);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
if OPenDialog1.Execute then
begin
lt.LoadFromFile(OPenDialog1.FileName);
button2.Click;
end;
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
if SaveDialog1.Execute then
lt.SaveToFile(SaveDialog1.FileName );
end;
procedure TForm1.Draw;
var
bmp:TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.width:=PaintBox1.Width;
bmp.Height:=PaintBox1.Height;
with bmp.Canvas do
begin
Brush.color:=clwhite;
FillRect(ClientRect);
end;
lt.DrawAllName(bmp.Canvas);
PaintBox1.Canvas.Draw(0,0,bmp);
finally
bmp.Free;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
draw;
end;
function TForm1.SelectOne(const Y: integer): integer;
var
h:integer;
row:integer;
begin
Result:=-1;
h:=18;
row:=Round((y-10)/h);
if row>lt.Count-1 then row:=-1;
Result:=row;
lt.ActiveIndex:=Result;
PaintBox1.Repaint;
PaintBox1.Canvas.TextOut(300,10,inttostr(result));
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
SelectOne(y);
IF button=mbRight then
lt.ExpandCurrent;
PaintBox1.Repaint;
end;
end.
{
7-7-2004 完成
}
unit UntTListCtrl;
interface
uses
windows,SysUtils, Classes, ComObj,Graphics;
type
PListInfo = ^TListInfo;
TListInfo = packed record
ID: string[38]; // 接点 ID 编号
ParentID: string[38]; //父接点ID
Name: string[255]; //名字
Level: Byte; //接点层次 根节点为0,依次递增
Expand, Visible: Boolean; //展开 ,可见
end;
PBranchState=^TBranchState; //节点状态 ,展开以及可见情况
TBranchState= record
Expand:Boolean;
Visible:Boolean;
end;
PLCFileHead=^TLCFileHead; // 文件头结构
TLCFileHead=packed record
Sign:string[2]; //文件标识 暂为'LC'
RecNum:Word; //节点总数
ActIndex:Word; //活动接点 保存 FActiveIndex
end;
TListCtrl = class
private
QDList: TList; //节点链表,最大个数为 High(Word)-1;
FActiveIndex: integer; //当前活动接点的索引; -1~~~High(Word)-1;
FCount:Word; // 接点总数
FBmp_Small:TBitmap;
procedure SetActiveIndex(const Value: Integer);
//寻找一个接点;返回它在QDList中的位置;
function FindOne(const ID:string):PListInfo;
//寻找和这个接点同父的最后一个子接点,返回这个子接点的在QDLIST中的索引号
function FindLastChild(PNode:PListInfo;const ParentIndex:integer):integer;
//正确的插入一个接点;
function InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
//寻找一个接点的子接点个数。
function FindAllChild(const NodeIndex:integer): integer;
//判断一个接点是不是父接点
function HasChild(const NodeIndex:integer):Boolean;
//设置 EXPAND 成员量。不做展开操作
procedure SetExpand(const NodeIndex: integer;Expanded:Boolean);
function GetParentIndex(const NodeIndex: integer): integer;
function GetShowOrder(const Index:integer):integer;
procedure DrawSmallIcon(const X,Y:integer;canvas:TCanvas);
function GetBoundRect(const NodeIndex:Word;Canvas:TCanvas):TRect;
public
constructor Create;
destructor Destroy;override;
procedure LoadFromFile(FileName: string);
procedure SaveToFile(FileName: string);
procedure NewList(const Name, ParentID: string);
procedure Delete(ID: string);
function GetActiveID:String;
procedure ExpandCurrent;
procedure DeleteAll;
procedure DeleteOne(const NodeIndex:integer);
function GoNext:integer;
function GoBack:integer;
property Count:Word read FCount;
property ActiveIndex: integer read FActiveIndex write SetActiveIndex;
//测试用方法
public
function ValidNum:Word;
procedure DrawAllName(canvas:TCanvas);
procedure DrawOneNode(const Index:Word; canvas: TCanvas);
function HitTest(const X,Y,Index:integer;Canvas:TCanvas):integer;
/
end;
implementation
{$R *.res}
{ TListCtrl }
constructor TListCtrl.Create;
begin
inherited;
QDList := TList.Create;
FActiveIndex:=-1;
FCount:=0;
FBmp_Small:=TBitmap.Create;
FBmp_Small.LoadFromResourceName(hInstance,'SMALLICON');
end;
destructor TListCtrl.Destroy;
begin
DeleteAll;
QDList.Destroy;
FBmp_Small.Free;
inherited;
end;
procedure TListCtrl.Delete(ID: string);
begin
// 首先查找元素,如果找到,则将它设置成为当前活动点,之后,删除当前活动点
if FindOne(ID)<> nil then
begin
DeleteOne(FActiveIndex);
FCount := QDList.Count;
end;
end;
function TListCtrl.FindOne(const ID: string):PListInfo;
var
I:integer;
begin
//直接遍历正个 QDList 炼表,找到就返回 该接点指针;
Result:=nil;
for i:=0 to QDList.Count -1 do
if PListInfo(QDList.Items[I])^.ID=ID then
begin
Result:=QDList.Items[I];
FActiveIndex:=I;
Exit;
end;
end;
procedure TListCtrl.NewList(const Name, ParentID: string);
var
newID: TGUID;
newNode:PListInfo;
PParent:PListInfo;
ParentIndex:integer;
begin
if QDList.Count >= (High(Word)-1) then Exit;//设置最大容量
CreateGUID(newID);
New(newNode); //为新接点开辟足够的内存空间
newNode^.ID:= GUIDToString(newID); //产生新ID
newNode^.Name:=Name;
newNode^.Expand:=true;
newNode^.Visible:=true;
PParent:=FindOne(ParentID);
if PParent<>nil then //如果它的父存在
begin
newNode^.Level:=PParent^.Level+1;
newNode^.ParentID:=ParentID;
ParentIndex:=FActiveIndex;//FindOne(); 方法使得 它就是父
end
else
begin
newNode^.Level:=0;
newNode^.ParentID:='';//如果找不到父,则默认创建一个根接点
ParentIndex:=-1;
end;
//执行插入操作,如果操作失败,则释放由New()分配的空间
if not InsertOne(newNOde,ParentIndex) then Dispose(newNode);
end;
function TListCtrl.InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
var
sfLevel:Word;
parentID:string;
lastChild:integer;
begin
Result:=false;
parentID:=PNode^.ParentID;
sfLevel:=PNode^.Level;
lastChild:=FindLastChild(PNode,ParentIndex);
if (sfLevel=0)or(lastChild=FCount-1) then // 它是根接点 或者它可以放到最后去;
begin
QDList.Add(PNode);
FCount:=QDList.Count;
FActiveIndex:=FCount-1;
Result:=true;
Exit;
end
else //它是某个接点的子
begin
QDList.Insert(lastChild+1,PNode);
FCount:=QDList.Count;
FActiveIndex:=lastChild+1;
Result:=true;
end;
end;
function TListCtrl.FindLastChild(PNode:PListInfo;const ParentIndex: integer): integer;
var
sfLevel:BYte;
I:integer;
begin
Result:=0; //它没有子接点
//指定的父索引或者父ID无效,则退出
if ParentIndex<=-1 then exit;
if PNode^.ParentID<>PListInfo(QDList.items[ParentIndex])^.Id then exit;
Result:=ParentIndex;
if ParentIndex=QDList.Count-1 then Exit;//
sfLevel:=PListInfo(QDList.items[ParentIndex])^.Level;
//从父节点的下一个节点开始判断,直到这个某个节点的LEVEL 值
// 高于或者等于父节点的LEVEL 则退出。
//返回最后一个子节点在QDLIST中的索引号
for I:= ParentIndex+1to QDList.Count-1 do
begin
if PListInfo(QDList.Items[I])^.Level<=sfLevel then EXIT
else inc(Result);
end;
end;
procedure TListCtrl.SetActiveIndex(const Value: integer);
VAR
I:integer;
num:integer;
begin
if (Value<-1)or(Value>QDList.Count-1)then exit;
num:=-1;
for I:=0 to QDList.Count-1 do
if PListInfo(QDList.Items[I])^.Visible then
begin
inc(num);
if Value=num then
begin
FActiveIndex:=I;
Exit;
end;
end;
end;
procedure TListCtrl.DeleteOne(const NodeIndex: integer);
var
I,chdNum:integer;
begin
if (NodeIndex<0)or(NodeIndex>=QDList.Count)then Exit;
FActiveINdex:=-1;
chdNum:=FindAllChild(NodeIndex);
for I:= NodeIndex+chdNum downto NodeIndex do
QDList.Delete(I); //这里必须用倒序循环,否则出错!
FCount:=QDList.Count;
//设置活动节点索引,如果被删除的这个节点前面有节点,则把它前面的节点
//设置成当前活动节点,如果前面没有节点,则设置成QDLIST的最后一个节点
IF NodeIndex>=1 then
begin
for I:=NodeIndex-1 downto 0 do
if PListInfo(QDList[I])^.Visible then
begin
FActiveIndex:=I;
Exit;
end ;
end
else
if QDList.Count>=1 then FActiveIndex:=QDList.Count-1
else
FActiveIndex:=-1;
end;
procedure TListCtrl.DeleteAll;
begin
QDList.Clear;
FCount:=0;
FActiveIndex:=-1;
end;
procedure TListCtrl.DrawAllName(canvas:TCanvas);
var
i:integer;
begin
if FCount=-1 then exit;
for i:=0 to QDList.Count-1 do
if PListInfo(QDList[I])^.Visible then
begin
DrawOneNode(I,canvas);
end;
end;
function TListCtrl.GetActiveID: String;
begin
Result:='';
if (FActiveIndex<= -1 ) then Exit;
Result:=PListInfo(QDList.Items[FActiveIndex])^.ID;
end;
function TListCtrl.FindAllChild(const NodeIndex:integer): integer;
var
I:integer;
sfLV:integer;
begin
Result:=0;
if NodeIndex>=QDList.Count-1 then exit;
sfLV:=PListInfo(QDList.Items[NodeIndex])^.Level;
for I:=NodeIndex+1 to QDList.Count -1 do
if (PListInfo(QDList.Items[I])^.Level>sfLV) then
Inc(Result)
else Exit;
end;
procedure TListCtrl.SaveToFile(FileName: string);
var
LstInfo:TListInfo;
headInfo:TLCFileHead;
DataFile:TFileStream;
I:integer;
begin
if FCount<=0 then Exit;
DataFile:=TFIleStream.Create(FileName,fmCreate);
try
with headInfo do // 做文件头
begin
Sign:='LC';
RecNum:=QDList.Count;
ActIndex:=FActiveIndex;
end;
DataFile.Write(headInfo,SizeOf(TLCFileHead)); // 写文件头
for I:=0 to QDList.Count-1 do
begin
with LstInfo do
begin
ID:=PListInfo(QDList.Items[I])^.ID;
ParentID:=PListInfo(QDList.Items[I])^.ParentID;
Name:=PListInfo(QDList.Items[I])^.Name;
Level:=PListInfo(QDList.Items[I])^.Level;
Expand:=PListInfo(QDList.Items[I])^.Expand;
Visible:=PListInfo(QDList.Items[I])^.Visible;
end;
dataFile.Write (LstInfo,SizeOF(TListInfo));
end;
finally
DataFile.Free;
end;
end;
procedure TListCtrl.LoadFromFile(FileName: string);
var
fileHead:TLCFileHead;
PNewNode:PListInfo;
newNode:TListInfo;
dataFile:TFileStream;
I:integer;
begin //读文件头信息
dataFile:=TFileStream.Create(FileName,fmOpenRead);
try
dataFile.Read(fileHead,SizeOF(TLCFileHead));
if (fileHead.RecNum<=0)or(fileHead.Sign<>'LC') then Exit;
DeleteAll;/
for I:=0 to fileHead.RecNum-1 do
begin
New(PNewNode);
dataFile.Read(newNode,SizeOF(TListInfo));
PNewNode^.ID:=newNode.ID;
PNewNode^.ParentID:=newNode.ParentID;
PNewNode^.Name:=newNOde.Name;
PNewNode^.Level:=newNode.Level;
PNewNode^.Expand:=newNode.Expand;
PNewNode^.Visible:=newNode.Visible;
QDList.Add(PNewNode);
end;
FActiveIndex:=fileHead.ActIndex;
FCount:=QDList.Count;
finally
dataFile.free;
end;
end;
function TListCtrl.GetParentIndex(const NodeIndex: integer): integer;
var
sfLevel:integer;
I:integer;
begin
Result:=-1;
sfLevel:=PListInfo(QDList.Items[NodeIndex])^.Level;
if sfLevel=0 then Exit;//根接点没有父
I:=NodeIndex;
while I>0 do
begin
if PListInfo(QDList.Items[I-1])^.Level=sfLevel-1 then
begin
Result:=I-1;
Exit;
end
else Dec(I); // 继续向左边找;
end;
end;
{
function TListCtrl.GetRootIndex(const NodeIndex: Integer): Integer;
var
sfLevel:integer;
I:integer;
begin
Result:=NodeIndex;
sfLevel:=PListInfo(QDList.Items[I])^.Level;
if sfLevel=0 then Exit;// 自己就是根接点
I:=NodeIndex;
while I>0 do
begin
if PListInfo(QDList.Items[I-1])^.Level=0 then
begin
Result:=I-1;
Exit;
end
else Dec(I); // 继续向左边找;
end;
end;
}
procedure TListCtrl.ExpandCurrent;
var
chdNum:integer;
sfLevel:integer;
curLevel:integer;
I:integer;
exArr:array of TBranchState;
begin
chdNum:=FindAllChild(FActiveIndex);
if chdNum=0 then exit;// 是叶,则退出。
SetExpand(FActiveIndex,not PListInfo(QDList[FActiveIndex])^.Expand );
if PListInfo(QDList[FActiveIndex])^.Expand=false then //关闭全部子
begin
for I:=FActiveIndex+1 to FActiveIndex+chdNum do
PListInfo(QDList[I])^.Visible:=false;
exit;
end; //
//下面做的是打开接点操作
sfLevel:=PListInfo(QDList[FActiveIndex])^.Level;
SetLength(exArr,1);
exArr[0].Expand:=true;
exArr[0].Visible:=true;
for I:=FActiveIndex+1 to FActiveIndex+chdNum do
begin
curLevel:=PListInfo(QDList[I])^.Level;
if HasChild(I) then
begin //如果它是一个枝
PListInfo(QDList[I])^.Visible:=(exArr[curLevel-sfLevel-1].Expand) and
(exArr[curLevel-sfLevel-1].Visible);
SetLength(exArr,curLevel-sfLevel+1);
exArr[curLevel-sfLevel].Expand:=PListInfo(QDList[I])^.Expand;
exArr[curLevel-sfLevel].Visible:=PListInfo(QDList[I])^.Visible;
end
else
begin //如果它是一个叶
PListInfo(QDList[I])^.Visible:=(exArr[curLevel-sfLevel-1].Expand) and
(exArr[curLevel-sfLevel-1].Visible);
end;
end;
end;
function TListCtrl.HasChild(const NodeIndex: integer): Boolean;
var
sfLevel:integer;
begin
Result:=false;
if NodeIndex>=QDList.Count-1 then Exit;//最后一个元素不可能是父;
sfLevel:=PListInfo(QDList[NodeIndex])^.Level;
//如果后面一个元素的Level大于自己,那么肯定是自己的子。它是一个父
if (PListInfo(QDList[NodeIndex+1])^.Level>sfLevel) then Result:=true;
end;
procedure TListCtrl.SetExpand(const NodeIndex: integer;Expanded:Boolean);
begin
PListInfo(QDList[NodeIndex])^.Expand:=Expanded;
end;
procedure TListCtrl.DrawOneNode(const Index:Word;Canvas: TCanvas);
var
par:integer;
parentX,parentY,sfX,sfY:integer;
fW,fH:integer;
begin
fW:=Canvas.TextWidth(PListInfo(QDList[Index])^.Name);
// fH:=Canvas.TextHeight(PListInfo(QDList[Index])^.Name);
if not PListInfo(QDList[Index])^.Visible then exit;
fH:=20;
par:=GetParentIndex(Index);
if (par = -1) then
begin
parentX:=10;
parentY:=10;
end
else
begin
parentX:=PListInfo(QDList[par])^.Level*15+10;
parentY:=GetShowOrder(par)*fH+10;
end;
sfX:=PListInfo(QDList[Index])^.Level*15+10;
sfY:=GetShowOrder(Index)*fH+10;
With Canvas do
begin
// Pen.Style:=psDot;
if par<>-1 then begin
Pen.color:=clGray;
MoveTo(parentX+4,parentY+6);
LineTo(parentX+4,sfY+1);
Lineto(sfX,sfY+1);
end;
if HasChild(Index)or(PListInfo(QDList[Index])^.Level=0) then
begin
Brush.Style:=bsClear;
// pen.style:=psSolid;
pen.color:=clBlack;
Rectangle(sfX,sfY-3,sfX+9,sfY+6);
MoveTo(sfx+8,sfY+1);
LIneTo(sfx+16,sfY+1);
pen.color:=clBlack;
MoveTo(sfX+2,sfY+1);
LineTo(sfx+7,sfY+1);
if not PListInfo(QDList[Index])^.Expand then
begin
MoveTo(sfX+4,sfY-1);
LineTo(sfx+4,sfY+4);
end;
inc(sfX,15);
DrawSmallIcon(sfx,sfy-6,canvas);
inc(sfx,17);
end;
if FActiveIndex=Index then
begin
Brush.Style:=bsSolid;
Brush.Color:=clBlue;//$00EBEBEB;
pen.color:=clBlack;
// Pen.Style:=psDOt;
Rectangle(Rect(sfx,sfy-6,sfx+fW+4,sfy+8));
Font.color:=clWhite;
end
else font.color:=clBlack;
Pen.Style:=psSolid;
Brush.Style:=bsClear;
TextOut(sfX+2,sfY-6,PListInfo(QDList[Index])^.Name);
end;
end;
function TListCtrl.GetShowOrder(const Index: integer): integer;
var
I:integer;
begin
Result:=-1;
for i:= 0 to Index do
if PListInfo(QDList[I])^.Visible then Inc(Result);
end;
procedure TListCtrl.DrawSmallIcon(const X,Y:integer; canvas: TCanvas);
var
src,drc:TRect;
begin
src:=Rect(0,0,15,13);
drc:=Rect(x,y,x+15,y+13);
canvas.BrushCopy(drc,FBmp_Small,src,clWhite);
end;
function TListCtrl.GoBack: integer;
var
I:integer;
begin
Result:=FActiveIndex;
I:=FActiveIndex;
if I<=0 then Exit;
for I:=FActiveIndex-1 downto 0 do
if PListInfo(QDList[I])^.Visible then
begin
FActiveIndex:=I;
Exit;
end;
end;
function TListCtrl.GoNext: integer;
var
I:integer;
begin
Result:=FActiveIndex;
I:=FActiveIndex;
if I>=QDList.Count-1 then FActiveIndex:=0
else
for I:=FActiveIndex+1 to QDList.Count-1 do
if PListInfo(QDList[I])^.Visible then
begin
FActiveIndex:=I;
Exit;
end;
end;
function TListCtrl.GetBoundRect(const NodeIndex: Word; Canvas: TCanvas): TRect;
const
fH=20;
var
rc:TRect;
begin
rc.left:=PListInfo(QDList[NodeIndex])^.Level*15+10;
rc.top:=GetShowOrder(NodeIndex)*fH+10-6;
rc.right:=rc.left+40+Canvas.TextWidth(PListInfo(QDList[NodeIndex])^.Name);
rc.Bottom:=rc.top+fH;
Result:=rc;
end;
function TListCtrl.HitTest(const X,Y,Index:integer;Canvas:TCanvas):integer;
var
Lrc,Src:TRect;
i,order:integer;
begin
Result:=0;
order:=0;
for i:=0 to QDList.Count - 1 do
begin
if PListinfo(QDList[I])^.Visible then
begin
inc(order);
if order=Index+1 then Break;
end;
end;
Lrc:=GetBoundRect(I,Canvas);
if PtInRect(Lrc,Point(X,Y)) then
begin
Result:=1;
FActiveIndex:=I;
if HasChild(I) then
begin
Src:=Rect(Lrc.left,Lrc.top+2,Lrc.Left+9,Lrc.Bottom-8);
if PtInRect(Src,Point(X,Y)) then
begin
ExpandCurrent;
Result:=2;
end;
end;
end;
end;
function TListCtrl.ValidNum: Word;
var
I:integer;
Num:integer;
begin
Num:=0;
For I:= 0 to QDList.Count -1 do
if PListInfo(QDList[I])^.Visible then inc(Num);
Result:=Num;
end;
end.program LstCtrlTest;
uses
Forms,
UntMaint in 'UntMaint.pas' {Form1},
UntTListCtrl in 'UntTListCtrl.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
TlistCtrl 类 清单
一. 主要数据类型:
节点记录
TListInfo = packed record
ID: string[38]; // 接点 ID 编号
ParentID: string[38]; //父接点ID
Name: string[255]; //名字
Level: Byte; //接点层次 根节点为0,依次递增
Expand, Visible: Boolean; //展开 ,可见
end;
枝节点状态记录
PBranchState=^TBranchState; //节点状态 ,展开以及可见情况
TBranchState= record
Expand:Boolean;
Visible:Boolean;
end;
文件头结构定义
PLCFileHead=^TLCFileHead; // 文件头结构
TLCFileHead=packed record
Sign:string[2]; //文件标识 暂为'LC'
RecNum:Word; //节点总数
ActIndex:Word; //活动接点 保存 FActiveIndex
end;
二. 节点的组织和存放方法描述:
QDList:Tlist 是一个线性指针炼表,全部节点都存放在这个链中。
存放规则描述:
如果新节点不存在父节点(既根节点),则将它放到链表的最后。
如果这个新节点NewChdA是NodeA的子节点,则将他放在这个NodeA的所有子节点之后。既下图中最后一个ChdA之后,NodeB之前。
三. TListCtrl主要 函数功能说明:
Private 段 函数(过程):
function FindOne(const ID:string):PListInfo;
根据指定的ID查找一个元素,返回它的指针
查找方法为:直接从QDList链表的头开始查找,找到就返回节点指针,否则返回 Nil
function FindLastChild(PNode:PListInfo;const ParentIndex:integer):integer;
寻找与一个节点同父的最后一个子接点,返回最后一个子接点在QDLIST中的索引号。
查找方法为:首先确定ParentIndex指定的父节点存在,记录下ParentIndex 所在节点的Level值。记为ParentLevel。然后从依次向QDList的右侧寻找,直到碰到一个节点的Level值等于或者高于ParentLevel,得到最后这个子节点在QDLIST中的索引号,函数返回这个索引号,结束查找。此函数被
function InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
调用,用来正确的插入一个新元素。
function InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
插入一个新接点,此函数被procedure NewList(const Name, ParentID: string);方法调用。新节点的插入方法见上 节点的组织和存放方法描述
如果指定的ParentIndex 不存在,则默认创建一个根节点。
function FindAllChild(const NodeIndex:integer): integer;
寻找一个接点的子接点个数。如果这个节点没有子节点,则返回0,有子节点,则返回找到的子节点个数。方法见上 节点的组织和存放方法描述。操作流程如下图
function HasChild(const NodeIndex:integer):Boolean;
判断一个接点是不是父接点。判断依据为:如果这个节点的下一个节点的Level值比自己高。则它有子。如果它是链表中最后一个元素,则它肯定没有子。
Public 段 函数(过程):
procedure LoadFromFile(FileName: string);
从磁盘读数据,重构QDList 链表。通过TfileStream类的
Read(var Buffer:Untyped;Count:integer) 和Write(var Buffer:Untyped;Count:integer);方法,将定长记录保存到磁盘和从磁盘恢复到定长记录
procedure SaveToFile(FileName: string);
将QDLIST中的元素信息写入磁盘文件;
procedure NewList(const Name, ParentID: string);
根据给定的节点名称和父ID, 新增加一个节点。
如果指定的ParentID不存在,则默认创建一个根节点。
首先用NEW()在堆栈上动态分配一块足够大的内存,存放新节点,然后对这个新节点的各个域赋值,调用InsertOne(const PNode: PListInfo;const ParentIndex:integer):方法,将这个节点正确的放到QDLIST中去,如果InsertOne 方法返回 FALSE,则插入操作不成功,调用DISPOSE()释放由NEW()分配的内存。
procedure DeleteOne(const NodeIndex:integer);
根据由NodeIndex 指定的节点索引,删除一个元素。具体操作如下:
首先调用FindAllChild(const NodeIndex:integer)函数,查找子节点,然后依次删除全部子节点和自己。删除操作直接调用Tlist.Delete(const Index:integer)方法。删除完后,设置活动节点索引(FActiveIndex),设置规则如下:如果被删除节点前有节点,则将FactiveIndex 减1,既把活动节点设置成前一个节点,如果被删除节点之前没有节点,则将这个活动节点的索引设置成最后一个节点。
procedure Delete(ID: string);
根据指定的ID删除一个节点。先调用FindOne(const ID:string)查找这个节点,找不到则退出,找到则调用DeleteOne(const NodeIndex:integer); 删除这个节点。具体参见
procedure ExpandCurrent;
展开/关闭当前节点,当前节点由FactiveIndex值确定,如果FactiveIndex = - 1,既当前没有活动节点,则退出。若FactiveIndex>=0则说明存在当前活动节点,可以进行展开操作,则首先调用FindAllChild(FActiveIndex),找到全部子节点;
关闭节点操作如下:
依次将子节点的Visible:=false;结束关闭操作;
打开节点操作如下:
准备一个动态数组exArr:array of TBranchState;用来存放各级父节点(Branch)的展开和可见状态。为什么要保存?理由如下:一个节点可见的充分必要条件是:父节点展开而且父节点可见!首先记录当前需要做展开操作的这个节点的Level值,记为SelfLevel,现在进行的是打开操作,所以Expand=true,Visible=true.保存进eArr[0]. eArr[0].Expand:=true, eArr[0].Visible:=true;Level值为CurrentLevel的父节点状态存放在eArr[CurrentLevel-SelfLevel]中.如果现在需要确定一个Level值为m的节点NodeX的Visible.
则NodeX.Visible:=(exArr[m-sfLevel-1].Visible)and(exArr[m-sfLevel-1].Visible);
具体操作如下:依次访问各个子节点,调用
function HasChild(const NodeIndex:integer):Boolean;判断当前节点是不是
父节点(Branch枝),如果是,则先根据它的Level值设置好它的Visible,依据就是eArr[]中存放的它的父的展开和可见性,然后将它自己的状态也保存进eArr[]
中,因为他自己的状态决定了他的子节点是否可见。如果它自己只是个叶节点,没有子,则不必保存他的展开和可见性。
是上班后的摸索结果。希望有DELPHI的朋友。
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs , ComCtrls, StdCtrls,UntTListCtrl, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
PaintBox1: TPaintBox;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
//返回所选择接点的索引
procedure Draw;
function SelectOne(const Y:integer):integer;
// function SelectOne(const Y: integer): integer;
public
{ Public declarations }
lt:TListCtrl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
lt:=TListCtrl.Create;
FORM1.DoubleBuffered:=true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
lt.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
str:string;
begin
str:= 'Node';
if InputQuery('Input Box', 'Caption:',str)then
lt.NewList(str,'');
button2.Click;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
lt.DrawAllName(PaintBox1.Canvas);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
str:string;
begin
str:= 'Node';
if InputQuery('Input Box', 'Caption:',str)then
lt.NewList(str,lt.GetActiveID);
button2.Click;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
lt.DeleteAll;
PaintBox1.Repaint;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
//ShowMessage(inttostr(lt.FIndAllChild(lt.ActiveIndex)));
lt.DeleteOne(lt.ActiveIndex);
//lt.PfAllName(PaintBox1.Canvas )
Draw;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
showmessage(lt.GetActiveID);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
if OPenDialog1.Execute then
begin
lt.LoadFromFile(OPenDialog1.FileName);
button2.Click;
end;
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
if SaveDialog1.Execute then
lt.SaveToFile(SaveDialog1.FileName );
end;
procedure TForm1.Draw;
var
bmp:TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.width:=PaintBox1.Width;
bmp.Height:=PaintBox1.Height;
with bmp.Canvas do
begin
Brush.color:=clwhite;
FillRect(ClientRect);
end;
lt.DrawAllName(bmp.Canvas);
PaintBox1.Canvas.Draw(0,0,bmp);
finally
bmp.Free;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
draw;
end;
function TForm1.SelectOne(const Y: integer): integer;
var
h:integer;
row:integer;
begin
Result:=-1;
h:=18;
row:=Round((y-10)/h);
if row>lt.Count-1 then row:=-1;
Result:=row;
lt.ActiveIndex:=Result;
PaintBox1.Repaint;
PaintBox1.Canvas.TextOut(300,10,inttostr(result));
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
SelectOne(y);
IF button=mbRight then
lt.ExpandCurrent;
PaintBox1.Repaint;
end;
end.
{
7-7-2004 完成
}
unit UntTListCtrl;
interface
uses
windows,SysUtils, Classes, ComObj,Graphics;
type
PListInfo = ^TListInfo;
TListInfo = packed record
ID: string[38]; // 接点 ID 编号
ParentID: string[38]; //父接点ID
Name: string[255]; //名字
Level: Byte; //接点层次 根节点为0,依次递增
Expand, Visible: Boolean; //展开 ,可见
end;
PBranchState=^TBranchState; //节点状态 ,展开以及可见情况
TBranchState= record
Expand:Boolean;
Visible:Boolean;
end;
PLCFileHead=^TLCFileHead; // 文件头结构
TLCFileHead=packed record
Sign:string[2]; //文件标识 暂为'LC'
RecNum:Word; //节点总数
ActIndex:Word; //活动接点 保存 FActiveIndex
end;
TListCtrl = class
private
QDList: TList; //节点链表,最大个数为 High(Word)-1;
FActiveIndex: integer; //当前活动接点的索引; -1~~~High(Word)-1;
FCount:Word; // 接点总数
FBmp_Small:TBitmap;
procedure SetActiveIndex(const Value: Integer);
//寻找一个接点;返回它在QDList中的位置;
function FindOne(const ID:string):PListInfo;
//寻找和这个接点同父的最后一个子接点,返回这个子接点的在QDLIST中的索引号
function FindLastChild(PNode:PListInfo;const ParentIndex:integer):integer;
//正确的插入一个接点;
function InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
//寻找一个接点的子接点个数。
function FindAllChild(const NodeIndex:integer): integer;
//判断一个接点是不是父接点
function HasChild(const NodeIndex:integer):Boolean;
//设置 EXPAND 成员量。不做展开操作
procedure SetExpand(const NodeIndex: integer;Expanded:Boolean);
function GetParentIndex(const NodeIndex: integer): integer;
function GetShowOrder(const Index:integer):integer;
procedure DrawSmallIcon(const X,Y:integer;canvas:TCanvas);
function GetBoundRect(const NodeIndex:Word;Canvas:TCanvas):TRect;
public
constructor Create;
destructor Destroy;override;
procedure LoadFromFile(FileName: string);
procedure SaveToFile(FileName: string);
procedure NewList(const Name, ParentID: string);
procedure Delete(ID: string);
function GetActiveID:String;
procedure ExpandCurrent;
procedure DeleteAll;
procedure DeleteOne(const NodeIndex:integer);
function GoNext:integer;
function GoBack:integer;
property Count:Word read FCount;
property ActiveIndex: integer read FActiveIndex write SetActiveIndex;
//测试用方法
public
function ValidNum:Word;
procedure DrawAllName(canvas:TCanvas);
procedure DrawOneNode(const Index:Word; canvas: TCanvas);
function HitTest(const X,Y,Index:integer;Canvas:TCanvas):integer;
/
end;
implementation
{$R *.res}
{ TListCtrl }
constructor TListCtrl.Create;
begin
inherited;
QDList := TList.Create;
FActiveIndex:=-1;
FCount:=0;
FBmp_Small:=TBitmap.Create;
FBmp_Small.LoadFromResourceName(hInstance,'SMALLICON');
end;
destructor TListCtrl.Destroy;
begin
DeleteAll;
QDList.Destroy;
FBmp_Small.Free;
inherited;
end;
procedure TListCtrl.Delete(ID: string);
begin
// 首先查找元素,如果找到,则将它设置成为当前活动点,之后,删除当前活动点
if FindOne(ID)<> nil then
begin
DeleteOne(FActiveIndex);
FCount := QDList.Count;
end;
end;
function TListCtrl.FindOne(const ID: string):PListInfo;
var
I:integer;
begin
//直接遍历正个 QDList 炼表,找到就返回 该接点指针;
Result:=nil;
for i:=0 to QDList.Count -1 do
if PListInfo(QDList.Items[I])^.ID=ID then
begin
Result:=QDList.Items[I];
FActiveIndex:=I;
Exit;
end;
end;
procedure TListCtrl.NewList(const Name, ParentID: string);
var
newID: TGUID;
newNode:PListInfo;
PParent:PListInfo;
ParentIndex:integer;
begin
if QDList.Count >= (High(Word)-1) then Exit;//设置最大容量
CreateGUID(newID);
New(newNode); //为新接点开辟足够的内存空间
newNode^.ID:= GUIDToString(newID); //产生新ID
newNode^.Name:=Name;
newNode^.Expand:=true;
newNode^.Visible:=true;
PParent:=FindOne(ParentID);
if PParent<>nil then //如果它的父存在
begin
newNode^.Level:=PParent^.Level+1;
newNode^.ParentID:=ParentID;
ParentIndex:=FActiveIndex;//FindOne(); 方法使得 它就是父
end
else
begin
newNode^.Level:=0;
newNode^.ParentID:='';//如果找不到父,则默认创建一个根接点
ParentIndex:=-1;
end;
//执行插入操作,如果操作失败,则释放由New()分配的空间
if not InsertOne(newNOde,ParentIndex) then Dispose(newNode);
end;
function TListCtrl.InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
var
sfLevel:Word;
parentID:string;
lastChild:integer;
begin
Result:=false;
parentID:=PNode^.ParentID;
sfLevel:=PNode^.Level;
lastChild:=FindLastChild(PNode,ParentIndex);
if (sfLevel=0)or(lastChild=FCount-1) then // 它是根接点 或者它可以放到最后去;
begin
QDList.Add(PNode);
FCount:=QDList.Count;
FActiveIndex:=FCount-1;
Result:=true;
Exit;
end
else //它是某个接点的子
begin
QDList.Insert(lastChild+1,PNode);
FCount:=QDList.Count;
FActiveIndex:=lastChild+1;
Result:=true;
end;
end;
function TListCtrl.FindLastChild(PNode:PListInfo;const ParentIndex: integer): integer;
var
sfLevel:BYte;
I:integer;
begin
Result:=0; //它没有子接点
//指定的父索引或者父ID无效,则退出
if ParentIndex<=-1 then exit;
if PNode^.ParentID<>PListInfo(QDList.items[ParentIndex])^.Id then exit;
Result:=ParentIndex;
if ParentIndex=QDList.Count-1 then Exit;//
sfLevel:=PListInfo(QDList.items[ParentIndex])^.Level;
//从父节点的下一个节点开始判断,直到这个某个节点的LEVEL 值
// 高于或者等于父节点的LEVEL 则退出。
//返回最后一个子节点在QDLIST中的索引号
for I:= ParentIndex+1to QDList.Count-1 do
begin
if PListInfo(QDList.Items[I])^.Level<=sfLevel then EXIT
else inc(Result);
end;
end;
procedure TListCtrl.SetActiveIndex(const Value: integer);
VAR
I:integer;
num:integer;
begin
if (Value<-1)or(Value>QDList.Count-1)then exit;
num:=-1;
for I:=0 to QDList.Count-1 do
if PListInfo(QDList.Items[I])^.Visible then
begin
inc(num);
if Value=num then
begin
FActiveIndex:=I;
Exit;
end;
end;
end;
procedure TListCtrl.DeleteOne(const NodeIndex: integer);
var
I,chdNum:integer;
begin
if (NodeIndex<0)or(NodeIndex>=QDList.Count)then Exit;
FActiveINdex:=-1;
chdNum:=FindAllChild(NodeIndex);
for I:= NodeIndex+chdNum downto NodeIndex do
QDList.Delete(I); //这里必须用倒序循环,否则出错!
FCount:=QDList.Count;
//设置活动节点索引,如果被删除的这个节点前面有节点,则把它前面的节点
//设置成当前活动节点,如果前面没有节点,则设置成QDLIST的最后一个节点
IF NodeIndex>=1 then
begin
for I:=NodeIndex-1 downto 0 do
if PListInfo(QDList[I])^.Visible then
begin
FActiveIndex:=I;
Exit;
end ;
end
else
if QDList.Count>=1 then FActiveIndex:=QDList.Count-1
else
FActiveIndex:=-1;
end;
procedure TListCtrl.DeleteAll;
begin
QDList.Clear;
FCount:=0;
FActiveIndex:=-1;
end;
procedure TListCtrl.DrawAllName(canvas:TCanvas);
var
i:integer;
begin
if FCount=-1 then exit;
for i:=0 to QDList.Count-1 do
if PListInfo(QDList[I])^.Visible then
begin
DrawOneNode(I,canvas);
end;
end;
function TListCtrl.GetActiveID: String;
begin
Result:='';
if (FActiveIndex<= -1 ) then Exit;
Result:=PListInfo(QDList.Items[FActiveIndex])^.ID;
end;
function TListCtrl.FindAllChild(const NodeIndex:integer): integer;
var
I:integer;
sfLV:integer;
begin
Result:=0;
if NodeIndex>=QDList.Count-1 then exit;
sfLV:=PListInfo(QDList.Items[NodeIndex])^.Level;
for I:=NodeIndex+1 to QDList.Count -1 do
if (PListInfo(QDList.Items[I])^.Level>sfLV) then
Inc(Result)
else Exit;
end;
procedure TListCtrl.SaveToFile(FileName: string);
var
LstInfo:TListInfo;
headInfo:TLCFileHead;
DataFile:TFileStream;
I:integer;
begin
if FCount<=0 then Exit;
DataFile:=TFIleStream.Create(FileName,fmCreate);
try
with headInfo do // 做文件头
begin
Sign:='LC';
RecNum:=QDList.Count;
ActIndex:=FActiveIndex;
end;
DataFile.Write(headInfo,SizeOf(TLCFileHead)); // 写文件头
for I:=0 to QDList.Count-1 do
begin
with LstInfo do
begin
ID:=PListInfo(QDList.Items[I])^.ID;
ParentID:=PListInfo(QDList.Items[I])^.ParentID;
Name:=PListInfo(QDList.Items[I])^.Name;
Level:=PListInfo(QDList.Items[I])^.Level;
Expand:=PListInfo(QDList.Items[I])^.Expand;
Visible:=PListInfo(QDList.Items[I])^.Visible;
end;
dataFile.Write (LstInfo,SizeOF(TListInfo));
end;
finally
DataFile.Free;
end;
end;
procedure TListCtrl.LoadFromFile(FileName: string);
var
fileHead:TLCFileHead;
PNewNode:PListInfo;
newNode:TListInfo;
dataFile:TFileStream;
I:integer;
begin //读文件头信息
dataFile:=TFileStream.Create(FileName,fmOpenRead);
try
dataFile.Read(fileHead,SizeOF(TLCFileHead));
if (fileHead.RecNum<=0)or(fileHead.Sign<>'LC') then Exit;
DeleteAll;/
for I:=0 to fileHead.RecNum-1 do
begin
New(PNewNode);
dataFile.Read(newNode,SizeOF(TListInfo));
PNewNode^.ID:=newNode.ID;
PNewNode^.ParentID:=newNode.ParentID;
PNewNode^.Name:=newNOde.Name;
PNewNode^.Level:=newNode.Level;
PNewNode^.Expand:=newNode.Expand;
PNewNode^.Visible:=newNode.Visible;
QDList.Add(PNewNode);
end;
FActiveIndex:=fileHead.ActIndex;
FCount:=QDList.Count;
finally
dataFile.free;
end;
end;
function TListCtrl.GetParentIndex(const NodeIndex: integer): integer;
var
sfLevel:integer;
I:integer;
begin
Result:=-1;
sfLevel:=PListInfo(QDList.Items[NodeIndex])^.Level;
if sfLevel=0 then Exit;//根接点没有父
I:=NodeIndex;
while I>0 do
begin
if PListInfo(QDList.Items[I-1])^.Level=sfLevel-1 then
begin
Result:=I-1;
Exit;
end
else Dec(I); // 继续向左边找;
end;
end;
{
function TListCtrl.GetRootIndex(const NodeIndex: Integer): Integer;
var
sfLevel:integer;
I:integer;
begin
Result:=NodeIndex;
sfLevel:=PListInfo(QDList.Items[I])^.Level;
if sfLevel=0 then Exit;// 自己就是根接点
I:=NodeIndex;
while I>0 do
begin
if PListInfo(QDList.Items[I-1])^.Level=0 then
begin
Result:=I-1;
Exit;
end
else Dec(I); // 继续向左边找;
end;
end;
}
procedure TListCtrl.ExpandCurrent;
var
chdNum:integer;
sfLevel:integer;
curLevel:integer;
I:integer;
exArr:array of TBranchState;
begin
chdNum:=FindAllChild(FActiveIndex);
if chdNum=0 then exit;// 是叶,则退出。
SetExpand(FActiveIndex,not PListInfo(QDList[FActiveIndex])^.Expand );
if PListInfo(QDList[FActiveIndex])^.Expand=false then //关闭全部子
begin
for I:=FActiveIndex+1 to FActiveIndex+chdNum do
PListInfo(QDList[I])^.Visible:=false;
exit;
end; //
//下面做的是打开接点操作
sfLevel:=PListInfo(QDList[FActiveIndex])^.Level;
SetLength(exArr,1);
exArr[0].Expand:=true;
exArr[0].Visible:=true;
for I:=FActiveIndex+1 to FActiveIndex+chdNum do
begin
curLevel:=PListInfo(QDList[I])^.Level;
if HasChild(I) then
begin //如果它是一个枝
PListInfo(QDList[I])^.Visible:=(exArr[curLevel-sfLevel-1].Expand) and
(exArr[curLevel-sfLevel-1].Visible);
SetLength(exArr,curLevel-sfLevel+1);
exArr[curLevel-sfLevel].Expand:=PListInfo(QDList[I])^.Expand;
exArr[curLevel-sfLevel].Visible:=PListInfo(QDList[I])^.Visible;
end
else
begin //如果它是一个叶
PListInfo(QDList[I])^.Visible:=(exArr[curLevel-sfLevel-1].Expand) and
(exArr[curLevel-sfLevel-1].Visible);
end;
end;
end;
function TListCtrl.HasChild(const NodeIndex: integer): Boolean;
var
sfLevel:integer;
begin
Result:=false;
if NodeIndex>=QDList.Count-1 then Exit;//最后一个元素不可能是父;
sfLevel:=PListInfo(QDList[NodeIndex])^.Level;
//如果后面一个元素的Level大于自己,那么肯定是自己的子。它是一个父
if (PListInfo(QDList[NodeIndex+1])^.Level>sfLevel) then Result:=true;
end;
procedure TListCtrl.SetExpand(const NodeIndex: integer;Expanded:Boolean);
begin
PListInfo(QDList[NodeIndex])^.Expand:=Expanded;
end;
procedure TListCtrl.DrawOneNode(const Index:Word;Canvas: TCanvas);
var
par:integer;
parentX,parentY,sfX,sfY:integer;
fW,fH:integer;
begin
fW:=Canvas.TextWidth(PListInfo(QDList[Index])^.Name);
// fH:=Canvas.TextHeight(PListInfo(QDList[Index])^.Name);
if not PListInfo(QDList[Index])^.Visible then exit;
fH:=20;
par:=GetParentIndex(Index);
if (par = -1) then
begin
parentX:=10;
parentY:=10;
end
else
begin
parentX:=PListInfo(QDList[par])^.Level*15+10;
parentY:=GetShowOrder(par)*fH+10;
end;
sfX:=PListInfo(QDList[Index])^.Level*15+10;
sfY:=GetShowOrder(Index)*fH+10;
With Canvas do
begin
// Pen.Style:=psDot;
if par<>-1 then begin
Pen.color:=clGray;
MoveTo(parentX+4,parentY+6);
LineTo(parentX+4,sfY+1);
Lineto(sfX,sfY+1);
end;
if HasChild(Index)or(PListInfo(QDList[Index])^.Level=0) then
begin
Brush.Style:=bsClear;
// pen.style:=psSolid;
pen.color:=clBlack;
Rectangle(sfX,sfY-3,sfX+9,sfY+6);
MoveTo(sfx+8,sfY+1);
LIneTo(sfx+16,sfY+1);
pen.color:=clBlack;
MoveTo(sfX+2,sfY+1);
LineTo(sfx+7,sfY+1);
if not PListInfo(QDList[Index])^.Expand then
begin
MoveTo(sfX+4,sfY-1);
LineTo(sfx+4,sfY+4);
end;
inc(sfX,15);
DrawSmallIcon(sfx,sfy-6,canvas);
inc(sfx,17);
end;
if FActiveIndex=Index then
begin
Brush.Style:=bsSolid;
Brush.Color:=clBlue;//$00EBEBEB;
pen.color:=clBlack;
// Pen.Style:=psDOt;
Rectangle(Rect(sfx,sfy-6,sfx+fW+4,sfy+8));
Font.color:=clWhite;
end
else font.color:=clBlack;
Pen.Style:=psSolid;
Brush.Style:=bsClear;
TextOut(sfX+2,sfY-6,PListInfo(QDList[Index])^.Name);
end;
end;
function TListCtrl.GetShowOrder(const Index: integer): integer;
var
I:integer;
begin
Result:=-1;
for i:= 0 to Index do
if PListInfo(QDList[I])^.Visible then Inc(Result);
end;
procedure TListCtrl.DrawSmallIcon(const X,Y:integer; canvas: TCanvas);
var
src,drc:TRect;
begin
src:=Rect(0,0,15,13);
drc:=Rect(x,y,x+15,y+13);
canvas.BrushCopy(drc,FBmp_Small,src,clWhite);
end;
function TListCtrl.GoBack: integer;
var
I:integer;
begin
Result:=FActiveIndex;
I:=FActiveIndex;
if I<=0 then Exit;
for I:=FActiveIndex-1 downto 0 do
if PListInfo(QDList[I])^.Visible then
begin
FActiveIndex:=I;
Exit;
end;
end;
function TListCtrl.GoNext: integer;
var
I:integer;
begin
Result:=FActiveIndex;
I:=FActiveIndex;
if I>=QDList.Count-1 then FActiveIndex:=0
else
for I:=FActiveIndex+1 to QDList.Count-1 do
if PListInfo(QDList[I])^.Visible then
begin
FActiveIndex:=I;
Exit;
end;
end;
function TListCtrl.GetBoundRect(const NodeIndex: Word; Canvas: TCanvas): TRect;
const
fH=20;
var
rc:TRect;
begin
rc.left:=PListInfo(QDList[NodeIndex])^.Level*15+10;
rc.top:=GetShowOrder(NodeIndex)*fH+10-6;
rc.right:=rc.left+40+Canvas.TextWidth(PListInfo(QDList[NodeIndex])^.Name);
rc.Bottom:=rc.top+fH;
Result:=rc;
end;
function TListCtrl.HitTest(const X,Y,Index:integer;Canvas:TCanvas):integer;
var
Lrc,Src:TRect;
i,order:integer;
begin
Result:=0;
order:=0;
for i:=0 to QDList.Count - 1 do
begin
if PListinfo(QDList[I])^.Visible then
begin
inc(order);
if order=Index+1 then Break;
end;
end;
Lrc:=GetBoundRect(I,Canvas);
if PtInRect(Lrc,Point(X,Y)) then
begin
Result:=1;
FActiveIndex:=I;
if HasChild(I) then
begin
Src:=Rect(Lrc.left,Lrc.top+2,Lrc.Left+9,Lrc.Bottom-8);
if PtInRect(Src,Point(X,Y)) then
begin
ExpandCurrent;
Result:=2;
end;
end;
end;
end;
function TListCtrl.ValidNum: Word;
var
I:integer;
Num:integer;
begin
Num:=0;
For I:= 0 to QDList.Count -1 do
if PListInfo(QDList[I])^.Visible then inc(Num);
Result:=Num;
end;
end.program LstCtrlTest;
uses
Forms,
UntMaint in 'UntMaint.pas' {Form1},
UntTListCtrl in 'UntTListCtrl.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
TlistCtrl 类 清单
一. 主要数据类型:
节点记录
TListInfo = packed record
ID: string[38]; // 接点 ID 编号
ParentID: string[38]; //父接点ID
Name: string[255]; //名字
Level: Byte; //接点层次 根节点为0,依次递增
Expand, Visible: Boolean; //展开 ,可见
end;
枝节点状态记录
PBranchState=^TBranchState; //节点状态 ,展开以及可见情况
TBranchState= record
Expand:Boolean;
Visible:Boolean;
end;
文件头结构定义
PLCFileHead=^TLCFileHead; // 文件头结构
TLCFileHead=packed record
Sign:string[2]; //文件标识 暂为'LC'
RecNum:Word; //节点总数
ActIndex:Word; //活动接点 保存 FActiveIndex
end;
二. 节点的组织和存放方法描述:
QDList:Tlist 是一个线性指针炼表,全部节点都存放在这个链中。
存放规则描述:
如果新节点不存在父节点(既根节点),则将它放到链表的最后。
如果这个新节点NewChdA是NodeA的子节点,则将他放在这个NodeA的所有子节点之后。既下图中最后一个ChdA之后,NodeB之前。
三. TListCtrl主要 函数功能说明:
Private 段 函数(过程):
function FindOne(const ID:string):PListInfo;
根据指定的ID查找一个元素,返回它的指针
查找方法为:直接从QDList链表的头开始查找,找到就返回节点指针,否则返回 Nil
function FindLastChild(PNode:PListInfo;const ParentIndex:integer):integer;
寻找与一个节点同父的最后一个子接点,返回最后一个子接点在QDLIST中的索引号。
查找方法为:首先确定ParentIndex指定的父节点存在,记录下ParentIndex 所在节点的Level值。记为ParentLevel。然后从依次向QDList的右侧寻找,直到碰到一个节点的Level值等于或者高于ParentLevel,得到最后这个子节点在QDLIST中的索引号,函数返回这个索引号,结束查找。此函数被
function InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
调用,用来正确的插入一个新元素。
function InsertOne(const PNode: PListInfo;const ParentIndex:integer):Boolean;
插入一个新接点,此函数被procedure NewList(const Name, ParentID: string);方法调用。新节点的插入方法见上 节点的组织和存放方法描述
如果指定的ParentIndex 不存在,则默认创建一个根节点。
function FindAllChild(const NodeIndex:integer): integer;
寻找一个接点的子接点个数。如果这个节点没有子节点,则返回0,有子节点,则返回找到的子节点个数。方法见上 节点的组织和存放方法描述。操作流程如下图
function HasChild(const NodeIndex:integer):Boolean;
判断一个接点是不是父接点。判断依据为:如果这个节点的下一个节点的Level值比自己高。则它有子。如果它是链表中最后一个元素,则它肯定没有子。
Public 段 函数(过程):
procedure LoadFromFile(FileName: string);
从磁盘读数据,重构QDList 链表。通过TfileStream类的
Read(var Buffer:Untyped;Count:integer) 和Write(var Buffer:Untyped;Count:integer);方法,将定长记录保存到磁盘和从磁盘恢复到定长记录
procedure SaveToFile(FileName: string);
将QDLIST中的元素信息写入磁盘文件;
procedure NewList(const Name, ParentID: string);
根据给定的节点名称和父ID, 新增加一个节点。
如果指定的ParentID不存在,则默认创建一个根节点。
首先用NEW()在堆栈上动态分配一块足够大的内存,存放新节点,然后对这个新节点的各个域赋值,调用InsertOne(const PNode: PListInfo;const ParentIndex:integer):方法,将这个节点正确的放到QDLIST中去,如果InsertOne 方法返回 FALSE,则插入操作不成功,调用DISPOSE()释放由NEW()分配的内存。
procedure DeleteOne(const NodeIndex:integer);
根据由NodeIndex 指定的节点索引,删除一个元素。具体操作如下:
首先调用FindAllChild(const NodeIndex:integer)函数,查找子节点,然后依次删除全部子节点和自己。删除操作直接调用Tlist.Delete(const Index:integer)方法。删除完后,设置活动节点索引(FActiveIndex),设置规则如下:如果被删除节点前有节点,则将FactiveIndex 减1,既把活动节点设置成前一个节点,如果被删除节点之前没有节点,则将这个活动节点的索引设置成最后一个节点。
procedure Delete(ID: string);
根据指定的ID删除一个节点。先调用FindOne(const ID:string)查找这个节点,找不到则退出,找到则调用DeleteOne(const NodeIndex:integer); 删除这个节点。具体参见
procedure ExpandCurrent;
展开/关闭当前节点,当前节点由FactiveIndex值确定,如果FactiveIndex = - 1,既当前没有活动节点,则退出。若FactiveIndex>=0则说明存在当前活动节点,可以进行展开操作,则首先调用FindAllChild(FActiveIndex),找到全部子节点;
关闭节点操作如下:
依次将子节点的Visible:=false;结束关闭操作;
打开节点操作如下:
准备一个动态数组exArr:array of TBranchState;用来存放各级父节点(Branch)的展开和可见状态。为什么要保存?理由如下:一个节点可见的充分必要条件是:父节点展开而且父节点可见!首先记录当前需要做展开操作的这个节点的Level值,记为SelfLevel,现在进行的是打开操作,所以Expand=true,Visible=true.保存进eArr[0]. eArr[0].Expand:=true, eArr[0].Visible:=true;Level值为CurrentLevel的父节点状态存放在eArr[CurrentLevel-SelfLevel]中.如果现在需要确定一个Level值为m的节点NodeX的Visible.
则NodeX.Visible:=(exArr[m-sfLevel-1].Visible)and(exArr[m-sfLevel-1].Visible);
具体操作如下:依次访问各个子节点,调用
function HasChild(const NodeIndex:integer):Boolean;判断当前节点是不是
父节点(Branch枝),如果是,则先根据它的Level值设置好它的Visible,依据就是eArr[]中存放的它的父的展开和可见性,然后将它自己的状态也保存进eArr[]
中,因为他自己的状态决定了他的子节点是否可见。如果它自己只是个叶节点,没有子,则不必保存他的展开和可见性。
是上班后的摸索结果。希望有DELPHI的朋友。