ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JDesigner/uNetObjList.pas
Revision: 1.1.1.1 (vendor branch)
Committed: Mon Dec 10 19:29:12 2001 UTC (14 years, 6 months ago) by hsauro
Branch: MAIN, hsauro
CVS Tags: V10, HEAD_NEW, HEAD
Changes since 1.1: +0 -0 lines
Log Message:
no message

Line File contents
1 unit uNetObjList;
2
3 // Unit for handling items other than nodes and edges. At the moment only
4 // test objects are supported.
5
6 interface
7
8 uses Windows, Classes, Graphics;
9
10 type
11 TNetObjType = (noText);
12
13 // Base class for all net objects
14 TNetObj = class (TObject)
15 NetObjType : TNetObjType; // Object type
16 Canvas : TCanvas; // Canvas on which to draw the object
17 vx, vy, vw, vh : integer; // Bounding Box
18 procedure Paint (const Origin : TPoint); virtual; abstract;
19 procedure Save (s : TStream); virtual;
20 procedure Read (s : TStream); virtual;
21 constructor Create (Canvas : TCanvas); virtual;
22 destructor Destroy; virtual;
23 end;
24
25 // Text object
26 TNetTextObj = class (TNetObj)
27 Font : TFont;
28 Text : string;
29 constructor Create (Canvas : TCanvas); override;
30 destructor Destroy; override;
31 procedure Paint (const Origin : TPoint); override;
32 procedure Save (s : TStream); override;
33 procedure Read (s : TStream); virtual;
34 end;
35
36
37 TNetObjList = class (TList)
38 protected
39 function Get (Index : integer) : TNetObj;
40 procedure Put (Index : integer; Item : TNetObj);
41 public
42 //constructor Clone (r : TNodeList);
43 destructor Destroy; override;
44 function Add (Item : TNetObj) : integer;
45 procedure Delete (Index : Integer);
46 property Items[Index : integer] : TNetObj read Get write Put; default;
47 procedure Save (s : TStream);
48 procedure Read (s : TStream; Canvas : TCanvas);
49
50 procedure Paint (const Origin : TPoint);
51 function FindObj (x, y : integer; var NetObj : TNetObj; var Index : integer) : Boolean;
52 end;
53
54
55 implementation
56
57 Uses uNetUtils;
58
59
60 constructor TNetObj.Create (Canvas : TCanvas);
61 begin
62 inherited Create;
63 Self.Canvas := Canvas;
64 end;
65
66
67 destructor TNetObj.Destroy;
68 begin
69 inherited Destroy;
70 end;
71
72
73 procedure TNetObj.Read (s : TStream);
74 begin
75 s.REad (NetObjType, sizeof (TNetObjType));
76 s.Read (vx, Sizeof (vx));
77 s.Read (vy, Sizeof (vy));
78 s.Read (vw, Sizeof (vw));
79 s.Read (vh, SizeOf (vh));
80 end;
81
82
83 procedure TNetObj.Save (s : TStream);
84 begin
85 s.Write (NetObjType, sizeof (TNetObjType));
86 s.Write (vx, Sizeof (vx));
87 s.Write (vy, Sizeof (vy));
88 s.Write (vw, Sizeof (vw));
89 s.Write (vh, SizeOf (vh));
90 end;
91
92
93 // --------------------------------------------------------------------------
94 // Text Object
95
96 constructor TNetTextObj.Create (Canvas : TCanvas);
97 begin
98 inherited Create (Canvas);
99 Font := TFont.Create;
100 Font.Color := clBlack;
101 Font.Name := 'Arial';
102 Font.Size := 10;
103 Font.Style := [];
104 NetObjType := noText;
105 end;
106
107
108 destructor TNetTextObj.Destroy;
109 begin
110 Font.Free;
111 inherited Destroy;
112 end;
113
114
115 procedure TNetTextObj.Paint (const Origin : TPoint);
116 var OldFont : TFont;
117 begin
118 OldFont := TFont.Create;
119 OldFont.Assign (Canvas.Font);
120 Canvas.Font.Assign (Font);
121 Canvas.TextOut (vx-Origin.x, vy-Origin.y, Text);
122 vw := Canvas.TextWidth (Text);
123 vh := Canvas.TextHeight (Text);
124 Canvas.Font.Assign (OldFont);
125 OldFont.Free;
126 end;
127
128
129 procedure TNetTextObj.Save (s : TStream);
130 begin
131 inherited Save (s);
132 WriteString (s, Text);
133 WriteFont (s, Font);
134 end;
135
136
137 procedure TNetTextObj.Read (s : TStream);
138 begin
139 inherited Read (s);
140 Text := ReadStr (s);
141 ReadFont (s, Font);
142 end;
143
144 // ------------------------------------------------------------------------
145
146
147 function TNetObjList.Get (Index : integer) : TNetObj;
148 begin
149 result := TNetObj(inherited Get(index));
150 end;
151
152
153 procedure TNetObjList.Put (Index : integer; Item : TNetObj);
154 begin
155 inherited Put (Index, Item);
156 end;
157
158
159 function TNetObjList.Add (Item : TNetObj) : integer;
160 begin
161 result := inherited Add (Item);
162 end;
163
164
165 procedure TNetObjList.Delete (Index : Integer);
166 var i : integer;
167 begin
168 Items[Index].Free;
169 Items[Index] := nil;
170 inherited Delete (Index);
171 end;
172
173
174 destructor TNetObjList.Destroy;
175 var i : integer;
176 begin
177 for i := 0 to Count - 1 do
178 Items[i].Free;
179 inherited Destroy;
180 end;
181
182
183 procedure TNetObjList.Save (s : TStream);
184 var c, i : integer;
185 begin
186 c := Count;
187 s.Write (c, SizeOf (c));
188 for i := 0 to c - 1 do
189 begin
190 s.Write (Items[i].NetObjType, SizeOf (TNetObjType));
191 Items[i].Save (s);
192 end;
193 end;
194
195
196 procedure TNetObjList.Read (s : TStream; Canvas : TCanvas);
197 var c, i : integer; NetObjType : TNetObjType; Obj : TNetTextObj;
198 begin
199 s.Read (c, SizeOf (c));
200 for i := 0 to c - 1 do
201 begin
202 s.Read (NetObjType, SizeOf (TNetObjType));
203 case NetObjType of
204 noText :
205 begin
206 Obj := TNetTextObj.Create (Canvas);
207 Obj.Read (s);
208 Add (Obj);
209 end;
210 end;
211
212 end;
213 end;
214
215
216 // Render all the nodes on to the Cavnas
217 procedure TNetObjList.Paint (const Origin : TPoint);
218 var i : integer;
219 begin
220 for i := 0 to Count - 1 do
221 (Items[i] as TNetObj).Paint (Origin);
222 end;
223
224
225 function TNetObjList.FindObj (x, y : integer; var NetObj : TNetObj; var Index : integer) : Boolean;
226 var i : integer; Obj : TNetObj;
227 begin
228 Result := False;
229 for i := 0 to Count - 1 do
230 begin
231 Obj := Items[i];
232 if PtInRect(rect (Obj.vx, Obj.vy, Obj.vx + Obj.vw, Obj.vy + Obj.vh), point (x, y)) then
233 begin
234 Result := True;
235 NetObj := Obj;
236 Exit;
237 end;
238 end;
239 end;
240
241 end.