利用Delphi中的画布画树

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

  1<x) (tobj(olst.items[i]^).centerx+10="" and="">x)   
  2and (TObj(OLst.Items[i]^).Centery-10<y) (tobj(olst.items[i]^).centery+10="" and="">y) then   
  3begin   
  4TObj(OLst.Items[i]^).Selected:=true;   
  5Label1.caption:='selected the node id:'+ TObj(OLst.Items[i]^).objid;   
  6end; 
  7
  8end;   
  9DrawFull;   
 10end; 
 11
 12procedure TFrm_Tree.Button3Click(Sender: TObject);   
 13begin   
 14ToolNO:=3;   
 15end; 
 16
 17function TFrm_Tree.setshowsel(x, y: integer):tobj;   
 18var   
 19i,j:integer;   
 20begin   
 21j:=olst.Count;   
 22for I:=0 to j-1 do   
 23begin   
 24TObj(OLst.Items[i]^).Selected:=false;   
 25if (TObj(OLst.Items[i]^).CenterX-10<x) (tobj(olst.items[i]^).centerx+10="" and="">x)   
 26and (TObj(OLst.Items[i]^).Centery-10<y) (tobj(olst.items[i]^).centery+10="" and="">y) then   
 27begin   
 28TObj(OLst.Items[i]^).showed:=true;   
 29Label1.caption:='look the node id:'+ TObj(OLst.Items[i]^).objid;   
 30Result:=TObj(OLst.Items[i]^);   
 31Break;   
 32end;   
 33end;   
 34end; 
 35
 36procedure TFrm_Tree.clearshowed;   
 37var   
 38i,j:integer;   
 39begin   
 40j:=olst.Count;   
 41for I:=0 to j-1 do   
 42begin   
 43TObj(olst.items[i]^).showed:=false;   
 44end;   
 45end; 
 46
 47procedure TFrm_Tree.setfnode(id: string);   
 48var   
 49curobj:^tobj;   
 50begin   
 51if id&lt;&gt;'' then   
 52begin   
 53//new(curobj);   
 54curobj:=getPObj(id);   
 55while curobj^.TypeNo=1 do   
 56begin   
 57curobj^.showed := true;   
 58curobj :=getpobj(curobj^.FNode);   
 59end;   
 60curobj^.showed:=true;   
 61//dispose(curobj);   
 62end;   
 63end; 
 64
 65procedure TFrm_Tree.setcnode(id: string);   
 66var   
 67curobj:^tobj;   
 68i,j:integer;   
 69begin   
 70//curobj:=getobj(id);   
 71j:=olst.count;   
 72for i:=0 to j-1 do   
 73begin   
 74if tobj(olst.Items[i]^).FNode=id then   
 75begin   
 76curobj:=getpobj(tobj(olst.Items[i]^).ObjId);   
 77curobj^.showed:=true;   
 78setcnode(curobj^.ObjId);   
 79end;   
 80end;   
 81end; 
 82
 83procedure TFrm_Tree.clearCanvas;   
 84begin   
 85//PaintBox1.Canvas   
 86PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));   
 87end; 
 88
 89procedure TFrm_Tree.Button4Click(Sender: TObject);   
 90begin   
 91clicked:=false;   
 92PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));   
 93OLst.Clear;   
 94Root:=true;   
 95SelID:='';   
 96SearilID:=0;   
 97{ with PaintBox1.Canvas do   
 98begin   
 99Pen.Width :=2;   
100Pen.Color:=clblack;   
101pen.Style :=psclear;   
102Brush.Style:=bsSolid;   
103Brush.Color:=clwhite;   
104Rectangle(0,0,PaintBox1.Width,PaintBox1.Height);   
105end;}   
106end; 
107
108procedure TFrm_Tree.Button5Click(Sender: TObject);   
109var   
110i,j: integer;   
111begin   
112j:=olst.count;   
113for i:=0 to j-1 do   
114begin   
115tobj(olst.Items[i]^).showed:=true; 
116
117end;   
118DrawFull;   
119end; 
120
121function TFrm_Tree.getPObj(id: string): Pointer;   
122var   
123i,j:integer;   
124begin   
125Result:=nil;   
126j:=Olst.Count;   
127for i:=0 to j-1 do   
128begin   
129if TObj(OLst.Items[i]^).ObjId=id then   
130begin   
131Result:=OLst.Items[i];   
132Break;   
133end;   
134end;   
135end; 
136
137function TFrm_Tree.clickobj(x, y: integer): string;   
138var   
139i,j:integer;   
140begin   
141Result:='';   
142j:=olst.Count;   
143setselected(x,y);   
144for I:=0 to j-1 do   
145begin   
146if (TObj(OLst.Items[i]^).CenterX-10<x) (tobj(olst.items[i]^).centerx+10="" and="">x)   
147and (TObj(OLst.Items[i]^).Centery-10<y) (tobj(olst.items[i]^).centery+10="" and="">y) then   
148begin   
149Label1.caption:='click the node id:'+ TObj(OLst.Items[i]^).objid;   
150Result:=TObj(OLst.Items[i]^).ObjId;   
151Break;   
152end;   
153end;   
154end; 
155
156procedure TFrm_Tree.Button6Click(Sender: TObject);   
157begin   
158ToolNO:=4;   
159end; 
160
161procedure TFrm_Tree.moveobj(dx, dy: integer);   
162var   
163i,j:integer;   
164begin   
165j:=olst.Count;   
166for I:=0 to j-1 do   
167begin   
168TObj(OLst.Items[i]^).CenterX:= TObj(OLst.Items[i]^).CenterX+dx;   
169TObj(OLst.Items[i]^).Centery:= TObj(OLst.Items[i]^).Centery+dy;   
170end;   
171//DrawFull;   
172end; 
173
174procedure TFrm_Tree.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;   
175Shift: TShiftState; X, Y: Integer);   
176begin   
177case toolno of   
1784:   
179begin   
180if clicked then   
181begin   
182endx:=x;   
183endy:=y;   
184moveobj((endx-beginx),(endy-beginy));   
185end;   
186clicked:=false;   
187end;   
1885:   
189begin   
190clicked:=false;   
191end;   
192end;   
193end; 
194
195procedure TFrm_Tree.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;   
196X, Y: Integer);   
197begin   
198if (clicked) then   
199begin   
200case ToolNO of   
2014:   
202begin   
203moveobj((x-beginx),(y-beginy));   
204beginx:=x;beginy:=y;   
205DrawFull;   
206end;   
2075:   
208begin   
209movenode((x-beginx),(y-beginy),getselect.ObjId);   
210movelocal((x-beginx),(y-beginy));   
211beginx:=x;beginy:=y;   
212DrawFull;   
213end;   
214end;   
215end;   
216end; 
217
218procedure TFrm_Tree.FADEStream1Click(Sender: TObject);   
219var   
220selfile :String;   
221curid:string;   
222curobj:Tobj;   
223lstdate:TIniFile32;   
224i,j:integer;   
225begin   
226j:=OLst.Count;   
227if SaveDialog1.Execute then   
228begin   
229selfile := SaveDialog1.FileName;   
230lstdate := TIniFile32.Create(selfile+'.dat');   
231lstdate.WriteInteger('Title','Num',j);   
232for i:=0 to j-1 do   
233begin   
234curobj:=Tobj(olst.Items[i]^);   
235curid:= curobj.ObjId;   
236lstdate.WriteString(curid,'ObjID',curobj.ObjId);   
237lstdate.WriteInteger(curid,'CenterX',curobj.CenterX);   
238lstdate.WriteInteger(curid,'CenterY',curobj.CenterY);   
239lstdate.WriteInteger(curid,'TypeNo',curobj.TypeNo);   
240lstdate.WriteBool(curid,'Selected',curobj.Selected);   
241lstdate.WriteString(curid,'FNode',curobj.FNode);   
242lstdate.WriteBool(curid,'Showed',curobj.showed);   
243end;   
244end;   
245end; 
246
247procedure TFrm_Tree.RANDOMRandomselection1Click(Sender: TObject);   
248var   
249selfile :String;   
250//curid:string;   
251lstdate:TIniFile32;   
252i,j:integer;   
253begin   
254if OpenDialog1.Execute then   
255begin   
256selfile:=OpenDialog1.FileName;   
257clicked:=false;   
258PaintBox1.Canvas.FillRect(rect(0,0,PaintBox1.Width,PaintBox1.Height));   
259OLst.Clear;   
260Root:=true;   
261SelID:='';   
262SearilID:=0;   
263lstdate:=TIniFile32.Create(selfile);   
264j:=lstdate.ReadInteger('Title','Num',0);   
265for i:=1 to j do   
266begin   
267addobj(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));   
268end;   
269SearilID:=j;   
270Root:=false;   
271DrawFull;   
272end;   
273end; 
274
275procedure TFrm_Tree.Button7Click(Sender: TObject);   
276begin   
277ToolNO:=5;   
278end; 
279
280procedure TFrm_Tree.movenode(dx, dy: integer;id:string);   
281var   
282i,j:integer;   
283curobj:^tobj;   
284begin   
285j:=olst.Count;   
286for I:=0 to j-1 do   
287begin   
288if tobj(olst.Items[i]^).FNode=id then   
289begin   
290curobj:=getpobj(tobj(olst.Items[i]^).ObjId);   
291curobj^.CenterX:=curobj^.CenterX+dx;   
292curobj^.CenterY:=curobj^.CenterY+dy;   
293movenode(dx,dy,curobj^.ObjId);   
294end;   
295end;   
296end; 
297
298procedure TFrm_Tree.movelocal(dx, dy: integer);   
299var   
300i,j:integer;   
301//curobj:tobj;   
302begin   
303j:=olst.Count;   
304for I:=0 to j-1 do   
305begin   
306if tobj(olst.Items[i]^).Selected then   
307begin   
308tobj(olst.Items[i]^).CenterX:=tobj(olst.Items[i]^).CenterX+dx;   
309tobj(olst.Items[i]^).Centery:=tobj(olst.Items[i]^).Centery+dy;   
310Break;   
311end;   
312end;   
313end;   
314end.</y)></x)></y)></x)></y)></x)>
Published At
Categories with Web编程
Tagged with
comments powered by Disqus