利用Delphi中的画布画树

_Q757856333叹

_Q757856333叹

2016-02-19 12:49

今天图老师小编要跟大家分享利用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.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;

（本文来源于图老师网站，更多请访问https://m.tulaoshi.com/bianchengyuyan/）

　　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;

（本文来源于图老师网站，更多请访问https://m.tulaoshi.com/bianchengyuyan/）

　　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.

展开更多 （50%）
分享

猜你喜欢

利用Delphi中的画布画树

编程语言 网络编程
利用Delphi中的画布画树

Delphi中利用网页打造程序界面

Delphi
Delphi中利用网页打造程序界面

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

在Delphi中利用CreateRemoteThread远程注入例子

编程语言 网络编程
在Delphi中利用CreateRemoteThread远程注入例子

Delphi中利用MSCOMM控件进行GPS数据采集

编程语言 网络编程
Delphi中利用MSCOMM控件进行GPS数据采集

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

在delphi7中利用mscomm控件编程

编程语言 网络编程
在delphi7中利用mscomm控件编程

在DELPHI中利用API实现网格内组件的嵌入

Delphi
在DELPHI中利用API实现网格内组件的嵌入

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

WANT的心得

WANT的心得

xhtml css网页制作问题的解决方法

xhtml css网页制作问题的解决方法
下拉加载更多内容 ↓