转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
利用Delphi中的画布画树         ★★★★

利用Delphi中的画布画树

作者:闵涛 文章来源:闵涛的学习笔记 点击数:1624 更新时间:2009/4/23 18:31:04

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

[1] [2] [3]  下一页


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台