论坛: 编程破解 标题: 贴出一个DELPHI的树的源程序（用TLIST\包括树的显示用CANVAS画的） 复制本贴地址    
作者: zhanjiajun [zhanjiajun]    论坛用户   登录
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的朋友。


地主 发表时间: 04-08-09 13:13
回复: TomyChen [quest]   版主   登录
DELPHI。。。不是很懂，但还是支持:)

B1层 发表时间: 04-08-09 14:02
回复: ziaichen [ziaichen]   论坛用户   登录
好东东
帮你顶!

B2层 发表时间: 04-08-09 16:05
回复: zhanjiajun [zhanjiajun]   论坛用户   登录
你们说说DEL与C++，为什么DEL的工资哪么低呢？

DEL的VCL与MFC一样，都是对API。但是，为什么一些人说什么DEL的不是程序员呢？ ？

B3层 发表时间: 04-08-11 20:59
回复: TomyChen [quest]   版主   登录
很简单，因为DELPHI不是。。。比尔老大出品的...呵呵...

B4层 发表时间: 04-08-11 21:52
回复: zhanjiajun [zhanjiajun]   论坛用户   登录
对了，版主：
我现在水平是：
对API有一点点了解。对WINDOWS消息机制一点点了解。对数据结构有一点点了解。
写过一些项目。可以做一些基本的程序工作。我现在的工资是：1000人民币。你说在外地会不会
相对高点？我有时候想看看：J2EE，但我的理想一直是UNIX下的C设计。我非常想找个好工作，娶老婆，生孩子！！！！


B5层 发表时间: 04-08-12 09:11
回复: TomyChen [quest]   版主   登录
这问题就比较难回答了....你的目标。。。好像谁的目标都差不多这样。问题在于，如果你觉得方向定好了就行动，毕竟这年头，啥都缺，就不缺搞计算机的。
1000块得看你所在地区的消费了。在深圳这，不少程序员还只拿1。5K，而且也活得挺好，白白胖胖的。
呵呵……这是一个很。。。那个的问题。。。关于讨论这个问题，最好另开帖，不然，这帖就水掉了

B6层 发表时间: 04-08-12 10:32
回复: zhanjiajun [zhanjiajun]   论坛用户   登录
up

B7层 发表时间: 04-08-15 09:51
回复: cike [cike]   论坛用户   登录
顶
楼主我爱你

B8层 发表时间: 04-08-21 16:13
回复: cike [cike]   论坛用户   登录
现在你真的只有1000人民币一个月？
被你说的我都不想再学del了


B9层 发表时间: 04-08-21 16:15
回复: zhanjiajun [zhanjiajun]   论坛用户   登录
其实DEL里也有WEB服务项目的。

B10层 发表时间: 04-10-08 22:19
回复: zhanjiajun [zhanjiajun]   论坛用户   登录
我也爱你！浮旧贴

B11层 发表时间: 05-10-27 15:37
回复: cike [cike]   论坛用户   登录
呵呵，像你这样写法，人都累死了。用几个while语句和快的啊！！

B12层 发表时间: 05-11-08 20:47

论坛: 编程破解

20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写：NetDemon

粤ICP备05087286号