I have always heard that the use of Delphi is simple and convenient. Now I use the canvas to achieve a graphical representation of a simple tree mechanism. The system supports node selection, movement, saving the tree, open the tree, etc. For the convenience of implementation, recursive and pointers, although the efficiency is a bit problem, it is quite good at rapid solving problems.
The program is more chaotic, welcome to exchange: sss@pacia.com.cn
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); Proceder: 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 point, select 2 3 4 5 moves View child mobile beginx, beginy , ENDX, Endy: INTEGER; ClickED: Boolean; String; root: boolean; searilid: integer; procedure; procedure; addu; type; x, y: integer; type; x, y: integer; type; 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 The Begin Oldbrushcolor: = brush.color; OldpedColor: = Pen.Color; if Obj.selected The begin pen.color: = RGB (255, 0); Brush.color: = $ 00ff31ff; Ellipse (Obj.centerx-10, Obj.centerx 10, Obj.centerx 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: = OldpedColor; brush.color: = Oldbrushcolor; 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; Else Begin if Haveselect The Begin Addobj (INTTOSTR (SEARILID) , X, Y, 1, False, True; DrawNode (INTTOSTR (Searilid)); label1.caption: = 'add the node, ID:' INTOSTR (Searilid); 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) <> '' Ten ClickED: = true; beginx: = x; beginy: = y; end; 5: Begin if ClickObj (x, y) <> 'Ten Clicked: = true; beginx: = x; beginning: = Y; End; end; end else begin setselected (x, y); 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, PaintBox1.width, PaintBox1.Height); end; end; procedure tfrm_tree.button1click (sender: TOBJECT); begin toolno: = 1;
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.objid: = id; OBJ = X; obj.centry: = y; obj.typeno: = type; obj.selected: = success; obj.showed: = showed; Olst.Add (obj);
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 = id1 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 The Begin Result: = TOBJ (olst.items [i] ^); Break; end; end; end;
Function TFRM_Tree.haveselectr: Boolean; Var i, J: Integer; Begin Result: = false; J: = = = = 0 to J-1 DO Begin if Tobj (olst.items [i] ^). SELECTED THEN BEAK; END; end;
Procedure tfrm_tree.drawfull; var i, j: integer; begin //paintbox1.canvas.FillRect(Rect (0, paintbox1.width ,paintbox1.height); clearcanvas; J: = = = = = = 0 TO J-1 DO Begin DrawNode (Tobj (olst.items [i] ^). Objid); end;
Procedure tfrm_tree.paintbox1paint; begindrawfull; 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
End; DrawFull;
Procedure tfrm_tree.button3click (sender: TOBJECT); Begin Toolno: = 3;
Function TFRM_Tree.setshowsel (x, y: integer): Tobj; Var i, j: integer; begin j: = = = = = ^; for i: = 0 to j-1 do begin Tobj (olst.items [i] ^) .Selected: = false; if (ly (olst.items [i] ^). CenterX-10
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;
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);
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: = CLWHITE; brush.color: = CLWHITE Rectangle (0, 0, PaintBox1.width, PaintBox1.Height); end;
Procedure TFRM_Tree.Button5Click (Sender: TOBJECT); VAR i, J: Inteder; Begin J: = Olst.count; for i: = 0 to j-1 do begin Tobj (olst.items [i] ^). showed: = True;
End; DrawFull;
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 The begin Result: = Olst.Items [I]; Break; end; end;
Function TFRM_TRE.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 (Olst.Items [i] ^). CenterX-10
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] ^). Center: = Tobj (olst.items [i] ^). Centery Dy; end; // Drawfull;
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; click: = false; end; 5: begin copy: = false; 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 (Y-Beginx), GetSelect.objid; MoveLocal (X-Beginx), (Y-Beginy)); Beginx : = x; beginy: = Y; DRAWFULL; 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;
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 (0, 0, PaintBox1.width, PaintBox1.Height); olst.clear; root: = true; selid: = '; search: = 0; LSTDATE: = Tinifile32.create (selfile ); J: = LSTDATE.READINTEGER ('title', 'Num', 0); for i: = 1 to j Do Begin Addobj (LSTDDATE.READSTRING (INTTOSTR (I), 'Objid', ''), LSTDATE. Readinteger (INTSTR (I), 'Centerx', 0), LSTDATE.Readinteger (INTTOSTR (I), 'Centery', 0), LSTDATE.Readinteger (INTTOSTR (I), 'Typeno', 0), LSTDATE.READBOOL INTSTOSTR (I), 'SELECTED', TRUE, LSTDATE.ReadString (INTTOSTR (I), 'FNode', ''), LSTDATE.READBOOL (INTSTR (I), 'Showed', True); End; SearilId: = J; root: = false; DrawFull; end; end; procedure tfrm_tree.button7click (sender: TOBJECT); begin Toolno: = 5;
Procedure TFRM_Tree.movenode (DX, DY: Integer; ID: String); VAR i, J: Integer; curobj: ^ Tobj; Begin J: = = = = = ^ c j-1 do begin if Tobj ( Olst.Items [i] ^). fnode = id1 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;
