一直都听说delphi中画布使用简单方便。现在我就利用画布实现一个简单的树机构的图形表示。系统支持节点选择、移动、保存树、打开树等。为了实现的方便用到了递归与指针，虽然效率有点问题但是在快速解决问题还是蛮好的。
程序写的比较乱，欢迎交流：[email protected]
源代码如下：
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. 
|
本类阅读TOP10