利用Delphi中的画布画树

一直都听说delphi中画布使用简单方便。现在我就利用画布实现一个简单的树机构的图形表示。系统支持节点选择、移动、保存树、打开树等。为了实现的方便用到了递归与指针，虽然效率有点问题但是在快速解决问题还是蛮好的。

　程序写的比较乱，欢迎交流：sss@pacia.com.cn

  源代码如下：

  unit U_Tree;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, jpeg, Menus,IniFiles32;

type
  TObj= record
　  ObjId　 : string;
　  CenterX : integer;
　  CenterY : integer;
　  TypeNo  : integer;
　  Selected : boolean;
　  FNode　  : string;
　  showed  : boolean;
  end;
  TFrm_Tree = class(TForm)
　  Panel1: TPanel;
　  PaintBox1: TPaintBox;
　  Panel2: TPanel;
　  Label1: TLabel;
　  Button2: TButton;
　  Button1: TButton;
　  Button3: TButton;
　  Button4: TButton;
　  Button5: TButton;
　  Button6: TButton;
　  MainMenu1: TMainMenu;
　  FADEStream1: TMenuItem;
　  RANDOMRandomselection1: TMenuItem;
　  SaveDialog1: TSaveDialog;
　  OpenDialog1: TOpenDialog;
　  Button7: TButton;
　  PRocedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
　　  Shift: TShiftState; X, Y: Integer);
　  procedure FormCreate(Sender: TObject);
　  procedure Button1Click(Sender: TObject);
　  procedure Button2Click(Sender: TObject);
　  procedure PaintBox1Paint(Sender: TObject);
　  procedure Button3Click(Sender: TObject);
　  procedure Button4Click(Sender: TObject);
　  procedure Button5Click(Sender: TObject);
　  procedure Button6Click(Sender: TObject);
　  procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
　　  Shift: TShiftState; X, Y: Integer);
　  procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
　　  Y: Integer);
　  procedure FADEStream1Click(Sender: TObject);
　  procedure RANDOMRandomselection1Click(Sender: TObject);
　  procedure Button7Click(Sender: TObject);
  private
　  { Private declarations }
　  ToolNO : integer;　　　　　　　　　　　  //1 画点，2 选择  3 查看  4 移动 5子移动
　  beginx,beginy,endx,endy : integer;
　  clicked:boolean;
　  OLst : TList;
　  SelID : string;
　  Root : boolean;
　  SearilID : integer;
　  procedure DrawNode(id:string);
　  procedure AddObj(id:string;x,y:integer;typeno:integer;selected:boolean;Fnode:string;showed:boolean);
　  function getObj(id : string): TObj;
　  function getPObj(id:string): Pointer;
　  function getselect: TObj;
　  function haveselect:boolean;
　  function clickobj(x,y:integer):string;
　  procedure DrawFull;
　  procedure setselected(x,y:integer);
　  function setshowsel(x,y:integer):tobj;
　  procedure setfnode(id:string);
　  procedure setcnode(id:string);
　  procedure clearshowed;
　  procedure clearCanvas;
　  procedure moveobj(dx,dy:integer);
　  procedure movenode(dx,dy:integer;id:string);
　  procedure movelocal(dx,dy:integer);
　  //procedure
  public
　  { Public declarations }
  end;

var
  Frm_Tree: TFrm_Tree;

implementation

{$R *.DFM}

{ TForm1 }

procedure TFrm_Tree.DrawNode(id:string);
var
  OldBrushColor: TColor;
  OldpenColor: TColor;
  obj:TObj;
begin
  obj:=getObj(id);

  with Frm_Tree.PaintBox1.Canvas do
  begin
　  if obj.showed then
　  begin
　　  OldBrushColor:=brush.color;
　　  OldpenColor:=pen.color;
　　  if obj.Selected then
　　  begin
　　　  Pen.Color:=rgb(255,0,0);
　　  end;
　　  Brush.Color:=$00FF31FF;
　　  Ellipse(obj.CenterX-10,obj.Centery-10,obj.CenterX+10,obj.Centery+10);
　　  Pen.Color:=$00FF31FF;
　　  if obj.TypeNo>0 then
　　  begin
　　　  moveTo(obj.CenterX,obj.CenterY);
　　　  lineTo(GetObj(obj.FNode).CenterX,GetObj(obj.FNode).CenterY);
　　  end;
　　  pen.color:=OldpenColor;
　　  brush.color:=OldBrushColor;
　  end;
  end;
end;

procedure TFrm_Tree.PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  curobj:Tobj;
begin
  if Button= mbLeft then
  begin
　  case ToolNO of
　  1:
　　  begin
　　　  SearilID :=SearilID+1;
　　　  if Root then
　　　  begin
　　　　  AddObj(inttostr(SearilID),x,y,0,false,'',true);
　　　　  DrawNode(inttostr(SearilID));
　　　　  Root:=false;
　　　  end
　　　  else
　　　  begin
　　　　  if haveselect then
　　　　  begin
　　　　　  AddObj(inttostr(SearilID),x,y,1,false,getselect.objid,true);
　　　　　  DrawNode(inttostr(SearilID));
　　　　　  label1.Caption:='add the node,id:'+inttostr(SearilID);
　　　　  end
　　　　  else
　　　　  begin
　　　　　  label1.Caption:='please select the node!';
　　　　  end;
　　　  end;
　　  end;
　  2:
　　  begin
　　　  setselected(x,y);
　　  end;
　  3:　　　　　　　　　　　 //查看
　　  begin
　　　  //clearCanvas;
　　　  curobj:=setshowsel(x,y);
　　　  if curobj.ObjId<>'' then
　　　  begin
　　　　  clearshowed;
　　　　  curobj:=setshowsel(x,y);
　　　　  curobj.showed:=true;
　　　　  setfnode(curobj.FNode);
　　　　  setcnode(curobj.ObjId);
　　　　  DrawFull;
　　　  end;
　　  end;
　  4:　　　　　　 //移动
　　  begin
　　　  if clickobj(x,y)<>'' then clicked:=true;
　　　  beginx:=x;
　　　  beginy:=y;
　　  end;
　  5:
　　  begin
　　　  if clickobj(x,y)<>'' then clicked:=true;
　　　  beginx:=x;
　　　  beginy:=y;
　　  end;
　  end;
  end
  else
  begin
　　  setselected(x,y);
  end;
end;

procedure TFrm_Tree.FormCreate(Sender: TObject);
begin
  OLst:=TList.Create;
  ToolNO:=0;
  Root:=true;
  SelID:='';
  SearilID:=0;
  clicked:=false;
  with PaintBox1.Canvas do
  begin
　  brush.Color:=clWhite;
　  FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));
  end;
end;

procedure TFrm_Tree.Button1Click(Sender: TObject);
begin
  ToolNO:=1;
end;

procedure TFrm_Tree.Button2Click(Sender: TObject);
begin
  ToolNO:=2;
end;

procedure TFrm_Tree.AddObj(id: string; x, y, typeno: integer;
  selected: boolean; Fnode: string;showed:boolean);
var
  Obj: ^TObj;
begin
  new(obj);
  obj.ObjId:=id;
  obj.CenterX:=x;
  obj.centery:=y;
  obj.TypeNo:=typeno;
  obj.Selected:=selected;
  obj.FNode:=fnode;
  obj.showed:=showed;
  OLst.Add(obj);
end;

function TFrm_Tree.getObj(id: string): TObj;
var
  i,j:integer;
begin
  j:=Olst.Count;
  for i:=0 to j-1 do
  begin
　  if TObj(OLst.Items[i]^).ObjId=id then
　  begin
　　  Result:=TObj(OLst.Items[i]^);
　　  Break;
　  end;
  end;
end;

function TFrm_Tree.getselect: TObj;
var
  i,j:integer;
begin
  j:=Olst.Count;
  for i:=0 to j-1 do
  begin
　  if TObj(OLst.Items[i]^).Selected then
　  begin
　　  Result:=TObj(OLst.Items[i]^);
　　  Break;
　  end;
  end;
end;

function TFrm_Tree.haveselect: boolean;
var
  i,j:integer;
begin
  Result:=false;
  j:=Olst.Count;
  for i:=0 to j-1 do
  begin
　  if TObj(OLst.Items[i]^).Selected then
　  begin
　　  Result:=true;
　　  Break;
　  end;
  end;
end;

procedure TFrm_Tree.DrawFull;
var
  i,j:integer;
begin
  //PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));
  clearCanvas;
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  DrawNode(TObj(OLst.Items[i]^).ObjId);
  end;
end;

procedure TFrm_Tree.PaintBox1Paint(Sender: TObject);
begin
DrawFull;
end;

procedure TFrm_Tree.setselected(x, y: integer);
var
  i,j:integer;
begin
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  TObj(OLst.Items[i]^).Selected:=false;
　  if (TObj(OLst.Items[i]^).CenterX-10<x) and (TObj(OLst.Items[i]^).CenterX+10>x)
　  and (TObj(OLst.Items[i]^).Centery-10<y) and (TObj(OLst.Items[i]^).Centery+10>y) then
　  begin
　　  TObj(OLst.Items[i]^).Selected:=true;
　　  Label1.caption:='selected the node id:'+ TObj(OLst.Items[i]^).objid;
　  end;

  end;
  DrawFull;
end;

procedure TFrm_Tree.Button3Click(Sender: TObject);
begin
  ToolNO:=3;
end;

function TFrm_Tree.setshowsel(x, y: integer):tobj;
var
  i,j:integer;
begin
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  TObj(OLst.Items[i]^).Selected:=false;
　  if (TObj(OLst.Items[i]^).CenterX-10<x) and (TObj(OLst.Items[i]^).CenterX+10>x)
　  and (TObj(OLst.Items[i]^).Centery-10<y) and (TObj(OLst.Items[i]^).Centery+10>y) then
　  begin
　　  TObj(OLst.Items[i]^).showed:=true;
　　  Label1.caption:='look the node id:'+ TObj(OLst.Items[i]^).objid;
　　  Result:=TObj(OLst.Items[i]^);
　　  Break;
　  end;
  end;
end;

procedure TFrm_Tree.clearshowed;
var
  i,j:integer;
begin
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  TObj(olst.items[i]^).showed:=false;
  end;
end;

procedure TFrm_Tree.setfnode(id: string);
var
  curobj:^tobj;
begin
  if id<>'' then
  begin
　  //new(curobj);
　  curobj:=getPObj(id);
　  while curobj^.TypeNo=1 do
　  begin
　　　 curobj^.showed := true;
　　　 curobj :=getpobj(curobj^.FNode);
　  end;
　  curobj^.showed:=true;
　  //dispose(curobj);
  end;
end;

procedure TFrm_Tree.setcnode(id: string);
var
  curobj:^tobj;
  i,j:integer;
begin
  //curobj:=getobj(id);
  j:=olst.count;
  for i:=0 to j-1 do
  begin
　  if tobj(olst.Items[i]^).FNode=id then
　  begin
　　  curobj:=getpobj(tobj(olst.Items[i]^).ObjId);
　　  curobj^.showed:=true;
　　  setcnode(curobj^.ObjId);
　  end;
  end;
end;

procedure TFrm_Tree.clearCanvas;
begin
  //PaintBox1.Canvas
  PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));
end;

procedure TFrm_Tree.Button4Click(Sender: TObject);
begin
  clicked:=false;
  PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));
  OLst.Clear;
  Root:=true;
  SelID:='';
  SearilID:=0;
 { with PaintBox1.Canvas do
　  begin
　　　  Pen.Width :=2;
　　　  Pen.Color:=clblack;
　　　  pen.Style :=psclear;
　　　  Brush.Style:=bsSolid;
　　　  Brush.Color:=clwhite;
　　　  Rectangle(0,0,PaintBox1.Width,PaintBox1.Height);
　  end;}
end;

procedure TFrm_Tree.Button5Click(Sender: TObject);
var
  i,j: integer;
begin
  j:=olst.count;
  for i:=0 to j-1 do
  begin
　  tobj(olst.Items[i]^).showed:=true;

  end;
  DrawFull;
end;

function TFrm_Tree.getPObj(id: string): Pointer;
var
  i,j:integer;
begin
  Result:=nil;
  j:=Olst.Count;
  for i:=0 to j-1 do
  begin
　  if TObj(OLst.Items[i]^).ObjId=id then
　  begin
　　  Result:=OLst.Items[i];
　　  Break;
　  end;
  end;
end;

function TFrm_Tree.clickobj(x, y: integer): string;
var
  i,j:integer;
begin
  Result:='';
  j:=olst.Count;
  setselected(x,y);
  for I:=0 to j-1 do
  begin
　  if (TObj(OLst.Items[i]^).CenterX-10<x) and (TObj(OLst.Items[i]^).CenterX+10>x)
　  and (TObj(OLst.Items[i]^).Centery-10<y) and (TObj(OLst.Items[i]^).Centery+10>y) then
　  begin
　　  Label1.caption:='click the node id:'+ TObj(OLst.Items[i]^).objid;
　　  Result:=TObj(OLst.Items[i]^).ObjId;
　　  Break;
　  end;
  end;
end;

procedure TFrm_Tree.Button6Click(Sender: TObject);
begin
  ToolNO:=4;
end;

procedure TFrm_Tree.moveobj(dx, dy: integer);
var
  i,j:integer;
begin
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  TObj(OLst.Items[i]^).CenterX:= TObj(OLst.Items[i]^).CenterX+dx;
　  TObj(OLst.Items[i]^).Centery:= TObj(OLst.Items[i]^).Centery+dy;
  end;
  //DrawFull;
end;

procedure TFrm_Tree.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case toolno of
　  4:
　  begin
　　  if clicked then
　　  begin
　　　  endx:=x;
　　　  endy:=y;
　　　  moveobj((endx-beginx),(endy-beginy));
　　  end;
　　  clicked:=false;
　  end;
　  5:
　  begin
　　  clicked:=false;
　  end;
  end;
end;

procedure TFrm_Tree.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (clicked) then
  begin
  case ToolNO of
  4:
  begin
　  moveobj((x-beginx),(y-beginy));
　  beginx:=x;beginy:=y;
　  DrawFull;
  end;
  5:
  begin
　  movenode((x-beginx),(y-beginy),getselect.ObjId);
　  movelocal((x-beginx),(y-beginy));
　  beginx:=x;beginy:=y;
　  DrawFull;
  end;
  end;
  end;
end;

procedure TFrm_Tree.FADEStream1Click(Sender: TObject);
var
  selfile :String;
  curid:string;
  curobj:Tobj;
  lstdate:TIniFile32;
  i,j:integer;
begin
  j:=OLst.Count;
  if SaveDialog1.Execute then
  begin
　  selfile := SaveDialog1.FileName;
　  lstdate := TIniFile32.Create(selfile+'.dat');
　  lstdate.WriteInteger('Title','Num',j);
　  for i:=0 to j-1 do
　  begin
　　  curobj:=Tobj(olst.Items[i]^);
　　  curid:= curobj.ObjId;
　　  lstdate.WriteString(curid,'ObjID',curobj.ObjId);
　　  lstdate.WriteInteger(curid,'CenterX',curobj.CenterX);
　　  lstdate.WriteInteger(curid,'CenterY',curobj.CenterY);
　　  lstdate.WriteInteger(curid,'TypeNo',curobj.TypeNo);
　　  lstdate.WriteBool(curid,'Selected',curobj.Selected);
　　  lstdate.WriteString(curid,'FNode',curobj.FNode);
　　  lstdate.WriteBool(curid,'Showed',curobj.showed);
　  end;
  end;
end;

procedure TFrm_Tree.RANDOMRandomselection1Click(Sender: TObject);
var
  selfile :String;
  //curid:string;
  lstdate:TIniFile32;
  i,j:integer;
begin
  if OpenDialog1.Execute then
  begin
　　  selfile:=OpenDialog1.FileName;
　　  clicked:=false;
　　  PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));
　　  OLst.Clear;
　　  Root:=true;
　　  SelID:='';
　　  SearilID:=0;
　　  lstdate:=TIniFile32.Create(selfile);
　　  j:=lstdate.ReadInteger('Title','Num',0);
　　  for i:=1 to j do
　　  begin
　　　  addobj(lstdate.Readstring(inttostr(i),'ObjID',''),lstdate.ReadInteger(inttostr(i),'CenterX',0),lstdate.ReadInteger(inttostr(i),'CenterY',0),lstdate.ReadInteger(inttostr(i),'TypeNo',0),lstdate.ReadBool(inttostr(i),'Selected',true),lstdate.Readstring(inttostr(i),'FNode',''),lstdate.ReadBool(inttostr(i),'Showed',true));
　　  end;
　　  SearilID:=j;
　　  Root:=false;
　　  DrawFull;
  end;
end;

procedure TFrm_Tree.Button7Click(Sender: TObject);
begin
  ToolNO:=5;
end;

procedure TFrm_Tree.movenode(dx, dy: integer;id:string);
var
  i,j:integer;
  curobj:^tobj;
begin
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  if tobj(olst.Items[i]^).FNode=id then
　  begin
　　  curobj:=getpobj(tobj(olst.Items[i]^).ObjId);
　　  curobj^.CenterX:=curobj^.CenterX+dx;
　　  curobj^.CenterY:=curobj^.CenterY+dy;
　　  movenode(dx,dy,curobj^.ObjId);
　  end;
  end;
end;

procedure TFrm_Tree.movelocal(dx, dy: integer);
var
  i,j:integer;
  //curobj:tobj;
begin
  j:=olst.Count;
  for I:=0 to j-1 do
  begin
　  if tobj(olst.Items[i]^).Selected then
　  begin
　　　 tobj(olst.Items[i]^).CenterX:=tobj(olst.Items[i]^).CenterX+dx;
　　　 tobj(olst.Items[i]^).Centery:=tobj(olst.Items[i]^).Centery+dy;
　　　 Break;
　  end;
  end;
end;
end.