利用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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有