一直都听说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] 下一页 没有相关教程
|