利用Delphi中的画布画树

【 tulaoshi.com - 编程语言 】

　　     一直都听说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.TypeNo0 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-10x) and (TObj(OLst.Items[i]^).CenterX+10x)
　　    and (TObj(OLst.Items[i]^).Centery-10y) and (TObj(OLst.Items[i]^).Centery+10y) 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-10x) and (TObj(OLst.Items[i]^).CenterX+10x)
　　    and (TObj(OLst.Items[i]^).Centery-10y) and (TObj(OLst.Items[i]^).Centery+10y) 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-10x) and (TObj(OLst.Items[i]^).CenterX+10x)
　　    and (TObj(OLst.Items[i]^).Centery-10y) and (TObj(OLst.Items[i]^).Centery+10y) 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.