I have always heard that canvas in delphi are simple and convenient to use. Now I use the canvas to implement a graphical representation of a simple tree mechanism. The system supports node selection, movement, saving trees, opening trees, etc. Recursion and pointers are used for convenience. Although there is some problem with efficiency, it is still good to quickly solve the problem.
The program is written in a mess, welcome to communicate: [email protected]
The source code is as follows:
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 Draw dots, 2 Select 3 View 4 Move 5 Sub-move
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: //View
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: //Mobile
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
Results:='';
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.