利用Delphi中的画布画树

原创 2004年09月07日 10:14:00

     一直都听说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.

Delphi 画布对象及其简单应用

TShape组件的属性,事件和方法 TImage组件的属性,事件和方法 Paintbox组件的属性,事件和方法 使用鼠标事件的绘图第 9章 图像图形应用编程 9.1 图形应用编程本章主要是讲解...
  • ly930156123
  • ly930156123
  • 2016年10月11日 14:52
  • 761

Delphi 画布对象及其简单应用

 TShape组件的属性,事件和方法 TImage组件的属性,事件和方法 Paintbox组件的属性,事件和方法 使用鼠标事件的绘图第 9章 图像图形应用编程 9.1 图形应用编程本章主...
  • hutao1101175783
  • hutao1101175783
  • 2014年02月09日 19:01
  • 832

HTML5画布Canvas线段、矩形、弧形及贝塞尔曲线等简单图形绘制

HTML5中最有意思的就是这个canvas了 通过它我们可以画自己想要的图形 它也是十分重要的技术 应用于游戏、图表等等 或者绘制各种酷炫的东西 这里给大家分享一个网站 传送门 里面都是c...
  • q1056843325
  • q1056843325
  • 2017年01月08日 14:38
  • 2342

Canva画布类的常用方法总结

常用函数作用及参数 1.drawColor(int color) 2.drawText(String text,float x,float y,Paint paint) 3.drawPoint(...
  • baidu_36026860
  • baidu_36026860
  • 2016年10月11日 22:53
  • 541

TBitmap.Canvas 上绘制的内容被自动缩放的问题

项目 内容 调试 Delphi Seattle 运行 Win7 & iOS 9.2 问题描述当需要在Bitmap.Canvas上人工绘制内容(包括图像和形状)时,遇到如下问题。pro...
  • doggybread
  • doggybread
  • 2015年12月12日 05:46
  • 620

canvas demo之 画一个星星

想要使用canvas画一个五角星,关键即是找出十个顶点的坐标,我们当然可以用十句 context.lineTo来实现,但是这样没有任何意义,因为没办复用,而且代码冗余。实际上由一个位置坐标,以及一大一...
  • qq_20417227
  • qq_20417227
  • 2016年07月26日 11:59
  • 1273

js canvas画柱状图 没什么高端的 就是一篇偶尔思路的

公司项目要用js画柱状图,本来想用个插件吧 chart.js 忽然一想 我们也用不了那么大的插件,自己写个吧,也能看看自己那点数学水平可以不! 有几个小亮点吧 1.函数x 和 函数y 对坐标进行了...
  • ibogood
  • ibogood
  • 2015年07月25日 19:06
  • 1504

Android中Canvas的常用方法

所有View在UI上绘制全部是由Canvas实现的。     一. save(),restore()  保存和还原               这两个方法并不是用来对图形进行处理的(移动,旋转,缩...
  • zxwd2015
  • zxwd2015
  • 2016年05月26日 16:50
  • 127

Delphi实现树型结构具体实例

unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, ...
  • chinajobs
  • chinajobs
  • 2016年08月18日 11:38
  • 1025

如何画出一个表达式的树形结构

大家都知道,表达式树前序遍历得到前缀表达式,中序遍历得到中缀表达式,后序遍历得到后缀表达式, 那么,如何根据最常见的中缀表达式画出表达式的树形结构图呢? 步骤1:求出中缀表达式对应的后缀表达式 ...
  • wwj_ff
  • wwj_ff
  • 2015年07月06日 10:11
  • 1172
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:利用Delphi中的画布画树
举报原因:
原因补充:

(最多只允许输入30个字)