ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JDesigner/uEdgeList.pas
Revision: 1.1.1.1 (vendor branch)
Committed: Mon Dec 10 19:29:12 2001 UTC (14 years, 9 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 uEdgeList;
2
3 // Defines the Edge and a list of Edges, be warned it's a bit complicated
4 // Edges are the reaction arcs connecting species nodes
5
6 interface
7
8 uses Windows, Classes, Dialogs, Graphics, uNetUtils, uNodeList, uSymbolList;
9
10 const
11 DEFAULT_LINECOLOR = clBlack;
12 DEFAULT_SELECTED_LINECOLOR = clRed;
13 DEFAULT_ARROWCOLOR = clBlack;
14 DEFAULT_LINETHICKNESS = 1;
15
16 type
17 TDirection = (dSrc, dDest);
18
19 TConnectedNode = class (TObject)
20 NodeId : integer; // Only used during saving/loading of object, indicates which node is associated with SubNode
21 SubNode : TSubNode;
22 Stoich : integer;
23 procedure Clear;
24 constructor Create; overload;
25 constructor Create (SubNode : TSubNode; Stoich : integer); overload;
26 procedure Save (s : TStream);
27 constructor Read (s : TStream);
28 end;
29
30 // Lists all nodes connected to a particular Edge
31 TConnectedNodeList = class (TList)
32 private
33 protected
34 function Get (Index : integer) : TConnectedNode;
35 procedure Put (Index : integer; Item : TConnectedNode);
36 public
37 constructor Create;
38 destructor Destroy; override;
39 function Add (Item : TConnectedNode) : integer;
40 procedure Delete (Index : Integer);
41 property Items[Index : integer] : TConnectedNode read Get write Put; default;
42
43 procedure Save (s : TStream);
44 constructor Read (s : TStream);
45 end;
46
47
48 TEdgeType = (eUniUni, eBiUni, eUniBi, eBiBi, eTriBi);
49 TEdge = class (TObject)
50 Id : integer; // Only used during serialisation
51 Name : string;
52 EdgeType : TEdgeType;
53 Direction : TDirection;
54 Reversible : boolean; // Required for elementary mode analysis
55 // List of nodes entering and leaving the Edge
56 srcConnectedNodeList, destConnectedNodeList : TConnectedNodeList;
57
58 RateLaw : string; // Fairly simple affair at the moment
59 SymbolList : TSymbolList; // Contains symbols and their corresponding values
60
61 LineThickness : integer;
62 LineColor : TColor;
63 SelectedLineColor : TColor;
64 ArrowColor : TColor;
65 BackGroundColor : TColor;
66 UseArrow : Boolean;
67
68 Selected : boolean;
69 Canvas : TCanvas;
70 // SubArcs are one of more bezier segments which make up a complete
71 // Edge. eg in the case of a BiUni Edge, there are three subarcs
72 SubArcs : array[1..15] of TArcSeg;
73 ArcCentre : TPoint; // Applicable for EdgeTypes > eUniUni
74
75 // These define the start and end points of the bezier that's actually drawn,
76 // i.e the intersection of the bezier with the outer rectangle of a node,
77 // they'd don't need to be saved when the Edge is saved, they are
78 // computed on demand.
79
80 Intersect : array[1..10] of TPoint;
81
82 procedure PaintUniUni (const Origin : TPoint);
83 procedure PaintBiUni (const Origin : TPoint);
84 procedure PaintUniBi (const Origin : TPoint);
85 procedure PaintBiBi (const Origin : TPoint);
86
87 procedure Paint (const Origin : TPoint);
88 function FindNode (Node : TNode) : boolean; overload;
89 function FindNode (Node : TNode; var Edge : TEdge; var Direction : TDirection; var EdgeSeg : integer) : Boolean; overload;
90 function IsOnEdge (x, y : integer; var NId : integer; sub : TCurrentSubArc; var t : double) : Boolean;
91 // Is Mouse on a particular control handle ?
92 function IsMouseOnHandle (x, y : integer; var CurrentSubArc : TCurrentSubArc;
93 var handleID : TCurrentSelectedHandle; var hcoords : TPoint) : boolean;
94 function CheckParticularArc (x, y : integer; h1, h2 : TPoint;
95 var handleID : TCurrentSelectedHandle; var hcoords : TPoint) : Boolean;
96 function IsMouseOnArcCentre (x, y : integer) : Boolean;
97
98
99 constructor Create (Canvas : TCanvas);
100 destructor Destroy; override;
101
102 procedure AdjustArcCentres (vx, vy : integer);
103 procedure DoDrawSubArcHandles (p : array of TPoint);
104 function ComputeBezLineIntersection (SubNode : TSubNode; var pt : TPoint; var t : double; var Segn : integer) : Boolean;
105
106 procedure SetArcColor (c : TColor);
107 function GetArcColor : TColor;
108
109 procedure Save (s : TStream);
110 constructor Read (s : TStream; Canvas : TCanvas; EdgeId : integer; NodeList : TNodeList);
111 end;
112
113
114 // List of all reaction edges in the network
115 TEdgeList = class (TList)
116 private
117 GlobalArcColor : TColor;
118 protected
119 function Get (Index : integer) : TEdge;
120 procedure Put (Index : integer; Item : TEdge);
121 public
122 constructor Create;
123 constructor Clone (r : TEdgeList);
124 destructor Destroy; override;
125 function Add (Item : TEdge) : integer;
126 procedure Delete (Index : Integer);
127 property Items[Index : integer] : TEdge read Get write Put; default;
128 procedure Save (s : TStream);
129 procedure Read (s : TStream; Canvas : TCanvas; NodeList : TNodeList);
130
131 function FindEdge (x, y : integer; var Edge : TEdge; var Index : integer) : boolean;
132 procedure SetGlobalArcColor (c : TColor);
133 function GetGlobalArcColor : TColor;
134 procedure Paint (const Origin : TPoint);
135 end;
136
137
138 // Helper routine which is also exported
139 function ComputeCentroid (Edge : TEdge) : TPoint;
140
141
142 implementation
143
144 constructor TConnectedNode.Create;
145 begin
146 inherited Create;
147 Stoich := 0;
148 end;
149
150
151 constructor TConnectedNode.Create (SubNode : TSubNode; Stoich : integer);
152 begin
153 inherited Create;
154 Self.SubNode := SubNode;
155 Self.Stoich := Stoich;
156 end;
157
158
159
160 procedure TConnectedNode.Save (s : TStream);
161 begin
162 s.Write (SubNode.ParentNode.Id, sizeof (SubNode.ParentNode.Id));
163 s.Write (SubNode.Id, sizeof (SubNode.Id));
164 s.Write (Stoich, sizeof (Stoich));
165 end;
166
167
168 constructor TConnectedNode.Read (s : TStream);
169 begin
170 // At read time, the SubNode is an SubNode Id, this will be fixed up later
171 s.Read (NodeId, sizeof (NodeId));
172 s.Read (SubNode, sizeof (Integer));
173 s.Read (Stoich, sizeof (Stoich));
174 end;
175
176
177 procedure TConnectedNode.Clear;
178 begin
179 NodeId := -1;
180 Stoich := 0;
181 end;
182
183
184 // ---------------------------------------------------------------------------
185
186
187 constructor TConnectedNodeList.Create;
188 begin
189 inherited Create;
190 end;
191
192
193 function TConnectedNodeList.Get (Index : integer) : TConnectedNode;
194 begin
195 result := TConnectedNode(inherited Get(index));
196 end;
197
198
199 procedure TConnectedNodeList.Put (Index : integer; Item : TConnectedNode);
200 begin
201 inherited Put (Index, Item);
202 end;
203
204
205 function TConnectedNodeList.Add (Item : TConnectedNode) : integer;
206 begin
207 result := inherited Add (Item);
208 end;
209
210
211 procedure TConnectedNodeList.Delete (Index : Integer);
212 begin
213 Items[Index].Free;
214 Items[Index] := nil;
215 inherited Delete (Index);
216 end;
217
218
219 destructor TConnectedNodeList.Destroy;
220 var i : integer;
221 begin
222 for i := 0 to Count - 1 do
223 Items[i].Free;
224 inherited Destroy;
225 end;
226
227
228 procedure TConnectedNodeList.Save (s : TStream);
229 var c, i : integer;
230 begin
231 c := Count;
232 s.Write (c, SizeOf (c));
233 for i := 0 to c - 1 do
234 Items[i].Save (s);
235 end;
236
237
238 constructor TConnectedNodeList.Read (s : TStream);
239 var c, i : integer;
240 begin
241 inherited Create;
242 s.Read (c, SizeOf (c));
243 for i := 0 to c - 1 do
244 Add (TConnectedNode.Read (s));
245 end;
246
247
248 // ---------------------------------------------------------------------------
249
250
251 // Compute the centroid for the Edge
252 function ComputeCentroid (Edge : TEdge) : TPoint;
253 var nSrcNodes, nDestNodes : integer;
254 TotalNodes, i : integer;
255 Pt, ArcCentre : TPoint;
256 begin
257 nSrcNodes := Edge.srcConnectedNodeList.Count; { # of nodes that go into the arc }
258 nDestNodes := Edge.destConnectedNodeList.Count; { # of nodes that come off the arc }
259
260 // Calculate the centroid from the nodes associated with Edge
261 ArcCentre := Point (0, 0);
262
263 for i := 0 to nSrcNodes - 1 do
264 begin
265 Pt := Edge.srcConnectedNodeList[i].SubNode.GetCentrePt;
266 ArcCentre.x := ArcCentre.x + Pt.x;
267 ArcCentre.y := ArcCentre.y + Pt.y;
268 end;
269
270 for i := 0 to nDestNodes - 1 do
271 begin
272 Pt := Edge.destConnectedNodeList[i].SubNode.GetCentrePt;
273 ArcCentre.x := ArcCentre.x + Pt.x;
274 ArcCentre.y := ArcCentre.y + Pt.y;
275 end;
276
277 TotalNodes := nSrcNodes + nDestNodes;
278 result.x := ArcCentre.x div TotalNodes;
279 result.y := ArcCentre.y div TotalNodes;
280 end;
281
282
283 // ---------------------------------------------------------------------------
284
285 // Start of the Edge class proper
286
287 constructor TEdge.Create (Canvas : TCanvas);
288 var i : integer;
289 begin
290 inherited Create;
291 Self.Canvas := Canvas;
292 Self.Name := '';
293 // These will store references to all subnodes connected to this edge
294 srcConnectedNodeList := TConnectedNodeList.Create;
295 destConnectedNodeList := TConnectedNodeList.Create;
296
297 // A whole load of defaults
298 EdgeType := eUniUni;
299 UseArrow := True;
300 ArcCentre := Point (0, 0);
301 LineColor := DEFAULT_LINECOLOR;
302 ArrowColor := DEFAULT_ARROWCOLOR;
303 SelectedLineColor := DEFAULT_SELECTED_LINECOLOR;
304 BackGroundColor := Canvas.Brush.Color;
305 LineThickness := DEFAULT_LINETHICKNESS;
306 RateLaw := 'v';
307 SymbolList := TSymbolList.Create;;
308 end;
309
310
311 destructor TEdge.Destroy;
312 var i : integer;
313 begin
314 srcConnectedNodeList.Free;
315 destConnectedNodeList.Free;
316 SymbolList.Free;
317 inherited Destroy;
318 end;
319
320
321 function TEdge.CheckParticularArc (x, y : integer; h1, h2 : TPoint;
322 var handleID : TCurrentSelectedHandle; var hcoords : TPoint) : Boolean;
323 begin
324 if PointWithinCircle (x, y, h1) then
325 begin
326 handleID := 1; result := true;
327 hcoords := h1;
328 end
329 else
330 if PointWithinCircle (x, y, h2) then
331 begin
332 handleID := 2; result := true;
333 hcoords := h2;
334 end
335 else
336 begin
337 result := false; handleID := -1;
338 end;
339 end;
340
341
342 // Check if mouse in on a particular control handle
343 function TEdge.IsMouseOnHandle (x, y : integer; var CurrentSubArc : TCurrentSubArc;
344 var handleID : TCurrentSelectedHandle; var hcoords : TPoint) : boolean;
345 var h1, h2 : TPoint; i : integer;
346 begin
347 result := False;
348 case EdgeType of
349 eUniUni : begin
350 h1 := SubArcs[1].h1;
351 h2 := SubArcs[1].h2;
352 result := CheckParticularArc (x, y, h1, h2, handleID, hcoords);
353 CurrentSubArc := 1;
354 end;
355 eUniBi, eBiUni : begin { Reaction systems with three arcs }
356 for i := 1 to 3 do { Search the three subarcs }
357 begin
358 h1 := SubArcs[i].h1;
359 h2 := SubArcs[i].h2;
360 result := CheckParticularArc (x, y, h1, h2, handleID, hcoords);
361 if result then begin CurrentSubArc := i; exit; end;
362 end;
363 end;
364 eBiBi : begin { Reaction systems with four arcs }
365 for i := 1 to 4 do
366 begin
367 h1 := SubArcs[i].h1;
368 h2 := SubArcs[i].h2;
369 result := CheckParticularArc (x, y, h1, h2, handleID, hcoords);
370 if result then begin CurrentSubArc := i; exit; end;
371 end;
372 end;
373 eTriBi : begin { Reaction systems with five arcs }
374 for i := 1 to 5 do
375 begin
376 h1 := SubArcs[i].h1;
377 h2 := SubArcs[i].h2;
378 result := CheckParticularArc (x, y, h1, h2, handleID, hcoords);
379 if result then begin CurrentSubArc := i; exit; end;
380 end;
381 end;
382 end;
383 end;
384
385
386 function TEdge.IsMouseOnArcCentre (x, y : integer) : Boolean;
387 begin
388 if PointWithinCircle (x, y, ArcCentre) then
389 result := true
390 else
391 result := false;
392 end;
393
394
395 // Adjust the arc centre to vx, vy and when doing so also adjust the
396 // central control handles by the same amount, makes things behave
397 // visually in a nicer way.
398 procedure TEdge.AdjustArcCentres (vx, vy : integer);
399 var dvx, dvy : integer;
400 begin
401 dvx := vx - ArcCentre.x;
402 dvy := vy - ArcCentre.y;
403 ArcCentre := point (vx, vy);
404 // Move inner bezier handles by same amount
405 case EdgeType of
406 eUniUni : begin end; // ignore, no arc centre to adjust
407 eUniBi : begin
408 SubArcs[1].h2.x := SubArcs[1].h2.x + dvx;
409 SubArcs[1].h2.y := SubArcs[1].h2.y + dvy;
410
411 SubArcs[2].h1.x := SubArcs[2].h1.x + dvx;
412 SubArcs[2].h1.y := SubArcs[2].h1.y + dvy;
413
414 SubArcs[3].h1.x := SubArcs[3].h1.x + dvx;
415 SubArcs[3].h1.y := SubArcs[3].h1.y + dvy;
416 end;
417 eBiUni : begin
418 SubArcs[1].h2.x := SubArcs[1].h2.x + dvx;
419 SubArcs[1].h2.y := SubArcs[1].h2.y + dvy;
420
421 SubArcs[2].h2.x := SubArcs[2].h2.x + dvx;
422 SubArcs[2].h2.y := SubArcs[2].h2.y + dvy;
423
424 SubArcs[3].h1.x := SubArcs[3].h1.x + dvx;
425 SubArcs[3].h1.y := SubArcs[3].h1.y + dvy;
426 end;
427 eBiBi : begin
428 SubArcs[1].h2.x := SubArcs[1].h2.x + dvx;
429 SubArcs[1].h2.y := SubArcs[1].h2.y + dvy;
430
431 SubArcs[2].h2.x := SubArcs[2].h2.x + dvx;
432 SubArcs[2].h2.y := SubArcs[2].h2.y + dvy;
433
434 SubArcs[3].h1.x := SubArcs[3].h1.x + dvx;
435 SubArcs[3].h1.y := SubArcs[3].h1.y + dvy;
436
437 SubArcs[4].h1.x := SubArcs[4].h1.x + dvx;
438 SubArcs[4].h1.y := SubArcs[4].h1.y + dvy;
439 end;
440 eTriBi : begin
441 SubArcs[1].h2.x := SubArcs[1].h2.x + dvx;
442 SubArcs[1].h2.y := SubArcs[1].h2.y + dvy;
443
444 SubArcs[2].h2.x := SubArcs[2].h2.x + dvx;
445 SubArcs[2].h2.y := SubArcs[2].h2.y + dvy;
446
447 SubArcs[3].h2.x := SubArcs[3].h2.x + dvx;
448 SubArcs[3].h2.y := SubArcs[3].h2.y + dvy;
449
450 SubArcs[4].h1.x := SubArcs[4].h1.x + dvx;
451 SubArcs[4].h1.y := SubArcs[4].h1.y + dvy;
452
453 SubArcs[5].h1.x := SubArcs[5].h1.x + dvx;
454 SubArcs[5].h1.y := SubArcs[5].h1.y + dvy;
455 end;
456 end;
457 end;
458
459
460 // Returns true if current bezier intersects line segment, intersection
461 // point returned in pt, parametric value in t, and the segment number in segn
462 function TEdge.ComputeBezLineIntersection (SubNode : TSubNode; var pt : TPoint; var t : double; var Segn : integer) : Boolean;
463 var i, j : integer; BezSegs : TLineSeg; OuterSegs : TSquareSegs;
464 begin
465 // Construct the outer rectangle for node #, src
466 OuterSegs := SubNode.ParentNode.ComputeOuterSegs (SubNode);
467 result := false;
468 for i := 1 to MAXSEGS do
469 begin
470 t := i/MAXSegs;
471 BezSegs.p.x := BezPoints[i-1].x; BezSegs.p.y := BezPoints[i-1].y;
472 BezSegs.q.x := BezPoints[i].x; BezSegs.q.y := BezPoints[i].y;
473 for j := 1 to 4 do
474 if SegmentIntersects (OuterSegs[j], BezSegs, pt) then
475 begin
476 result := true; Segn := i; exit;
477 end;
478 end;
479 result := false;
480 end;
481
482
483 // Draw the bezier control points
484 procedure TEdge.DoDrawSubArcHandles (p : array of TPoint);
485 var oldcolour : TColor;
486 begin
487 // Must remember brush colour coz' because arrow heads are filled in with
488 // foreground colour which is different from background colour.
489 oldcolour := canvas.brush.color;
490 canvas.brush.color := clWhite; // makes them stand out
491
492 canvas.moveto (p[0].x, p[0].y); canvas.lineto (p[1].x, p[1].y);
493 canvas.ellipse (p[1].x-3, p[1].y-3, p[1].x+3, p[1].y+3);
494
495 canvas.moveto (p[2].x, p[2].y); canvas.lineto (p[3].x, p[3].y);
496 canvas.ellipse (p[2].x-3, p[2].y-3, p[2].x+3, p[2].y+3);
497 canvas.brush.color := oldcolour;
498 end;
499
500
501
502 procedure TEdge.PaintUniUni (const Origin : TPoint);
503 var srcNode, destNode : TSubNode; pSrc, pDest, h1, h2, pt : TPoint;
504 Segn : integer; par : Double;
505 begin
506 srcNode := srcConnectedNodeList[0].SubNode;
507 destNode := destConnectedNodeList[0].SubNode;
508
509 pSrc := srcNode.GetCentrePt;
510 pDest := destNode.GetCentrePt;
511
512 // Get the bezier control handle coordinates, there is only one set for UniUni
513 h1 := SubArcs[1].h1;
514 h2 := SubArcs[1].h2;
515
516 // Compute the points along the bezier from node centre to node centre
517 ComputeBezPoints ([pSrc, h1, h2, pDest]);
518
519 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
520 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
521
522 // Return the point coordinate where the bezier intersects the outer node segment
523 ComputeBezLineIntersection (SrcNode, pt, par, Segn);
524
525 // The intersection point will be the new start point for the bezier,
526 // prepare the coordinate for screen display
527 pSrc.x := pt.x - Origin.x; pSrc.y := pt.y - Origin.y;
528
529 // Save this intersection point because we'll need at other times to work out
530 // whether the user has clicked on the curve with the mouse, see IsMouseOnArc
531 intersect[1] := pt;
532
533 // Do the same for the destination point of the bezier }
534 if ComputeBezLineIntersection (DestNode, pt, Par, Segn) then
535 begin
536 // Store the new end point for the bezier
537 pDest.x := pt.x - Origin.x; pDest.y := pt.y - Origin.y;
538 intersect[2] := pt;
539 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest); // Does scaling
540 DrawBezier (Canvas, [pSrc, h1, h2, pDest]);
541 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
542 end;
543
544 if UseArrow then
545 DrawArrow (Canvas, pDest, 1.0, pDest.x - h2.x, pDest.y - h2.y);
546 end;
547
548
549 procedure TEdge.PaintBiUni (const Origin : TPoint);
550 var srcNode1, srcNode2, destNode : TSubNode; h1, h2, pSrc, pDest,
551 pt, AdjustedCentre : TPoint;
552 Segn : integer; par : Double;
553 begin
554 srcNode1 := srcConnectedNodeList[0].SubNode;
555 srcNode2 := srcConnectedNodeList[1].SubNode;
556 destNode := destConnectedNodeList[0].SubNode;
557
558 // Draw one arc at a time - there will be three for a BiUni
559 // Get the bezier control handle coordinates for the first arc
560 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
561
562 // Start to draw arcs, first src1 to centroid, calculate the centre of the src node
563 pSrc := srcNode1.GetCentrePt;
564 // First arc goes from src to centroid, so the destination for the first arc is the centroid }
565 pDest := ArcCentre;
566 // Compute the points along the bezier from node centre to centroid
567 ComputeBezPoints ([pSrc, h1, h2, pDest]);
568 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
569 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
570 pDest.x := pDest.x - Origin.x; pDest.y := pDest.y - Origin.y;
571
572 // Clip the src starting point by returning the bezier segment number which intersects with the node outer rectangle
573 if ComputeBezLineIntersection (SrcNode1, pt, Par, Segn) then
574 begin
575 // Store the new start point for the bezier, and draw it
576 pSrc.x := pt.x - Origin.x; pSrc.y := pt.y - Origin.y;
577 intersect[1] := pt;
578 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
579 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
580 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
581 end;
582
583 // Next arc, from src2 to centroid
584 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
585 pSrc := srcNode2.GetCentrePt;
586 pDest := ArcCentre;
587 ComputeBezPoints ([pSrc, h1, h2, pDest]);
588 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
589 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
590 pDest.x := pDest.x - Origin.x; pDest.y := pDest.y - Origin.y;
591
592 if ComputeBezLineIntersection (SrcNode2, pt, Par, Segn) then
593 begin
594 pSrc.x := pt.x - Origin.x; pSrc.y := pt.y - Origin.y;
595 intersect[2] := pt;
596 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
597 DrawBezier (Canvas, [pSrc, h1, h2, pDest]);
598 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
599 end;
600
601 // Next arc, from centroid to dest
602 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
603 pSrc := ArcCentre;
604 pDest := destNode.GetCentrePt;
605 ComputeBezPoints ([pSrc, h1, h2, pDest]);
606 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
607 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
608 pSrc.x := pSrc.x - Origin.x; pSrc.y := pSrc.y - Origin.y;
609
610 if ComputeBezLineIntersection (DestNode, pt, Par, Segn) then
611 begin
612 pDest.x := pt.x - Origin.x; pDest.y := pt.y - Origin.y;
613 intersect[3] := pt;
614 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
615 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
616 if UseArrow then
617 DrawArrow (canvas, pDest, 1.0, pDest.x - h2.x, pDest.y - h2.y);
618 if Selected then
619 begin
620 DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
621 AdjustedCentre.x := round ((ArcCentre.x - Origin.x));//*Scale);
622 AdjustedCentre.y := round ((ArcCentre.y - Origin.y));//*Scale);
623 DrawControlPoint (Canvas, AdjustedCentre);
624 end;
625 end;
626 end;
627
628
629 procedure TEdge.PaintUniBi (const Origin : TPoint);
630 var srcNode, destNode1, destNode2 : TSubNode; h1, h2, pSrc, pDest,
631 pt, AdjustedCentre : TPoint;
632 Segn : integer; par : Double;
633 begin
634 srcNode := srcConnectedNodeList[0].SubNode;
635 destNode1 := destConnectedNodeList[0].SubNode;
636 destNode2 := destConnectedNodeList[1].SubNode;
637
638 // Draw one arc at a time - there will be three for a UniBi
639
640 // Get the bezier control handle coordinates for the first subarc
641 h1 := SubArcs[1].h1;
642 h2 := SubArcs[1].h2;
643
644 // Start to draw arcs, first calculate the centre of the src node
645 pSrc := srcNode.GetCentrePt;
646 // First arc goes from src to centroid, so the destination for the first arc is the centroid }
647 pDest := ArcCentre;
648 // Compute the points along the bezier from node centre to centroid
649 ComputeBezPoints ([pSrc, h1, h2, pDest]);
650 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
651 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
652 pDest.x := pDest.x - Origin.x; pDest.y := pDest.y - Origin.y;
653
654 // Clip the src starting point by returning the bezier segment number which intersects with the node outer rectangle }
655 if ComputeBezLineIntersection (SrcNode, pt, Par, Segn) then // Only draw if successful }
656 begin
657 // Store the new start point for the bezier, and draw it }
658 pSrc.x := pt.x - Origin.x; pSrc.y := pt.y - Origin.y;
659 // UniUni for explanation of following line }
660 intersect[1] := pt;
661 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
662 DrawBezier (Canvas, [pSrc, h1, h2, pDest]);
663 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
664 end;
665
666 // Next arc, from centroid to dest1 }
667 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
668 pSrc := ArcCentre;
669 pDest := destNode1.GetCentrePt;
670 ComputeBezPoints ([pSrc, h1, h2, pDest]);
671 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
672 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
673 pSrc.x := pSrc.x - Origin.x; pSrc.y := pSrc.y - Origin.y;
674
675 if ComputeBezLineIntersection (destNode1, pt, Par, Segn) then
676 begin
677 pDest.x := pt.x - Origin.x; pDest.y := pt.y - Origin.y;
678 intersect[2] := pt;
679 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
680 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
681 if UseArrow then
682 DrawArrow (Canvas, pDest, 1.0, pDest.x - h2.x, pDest.y - h2.y);
683 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
684 end;
685
686 // Next arc, from centroid to dest2
687 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
688 pSrc := ArcCentre;
689 pDest := destNode2.GetCentrePt;
690 ComputeBezPoints ([pSrc, h1, h2, pDest]);
691 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
692 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
693 pSrc.x := pSrc.x - Origin.x; pSrc.y := pSrc.y - Origin.y;
694
695 if ComputeBezLineIntersection (destNode2, pt, Par, Segn) then
696 begin
697 pDest.x := pt.x - Origin.x; pDest.y := pt.y - Origin.y;
698 intersect[3] := pt;
699 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
700 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
701 if UseArrow then
702 DrawArrow (canvas, pDest, 1.0, pDest.x - h2.x, pDest.y - h2.y);
703 if Selected then
704 begin
705 DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
706 AdjustedCentre.x := round ((ArcCentre.x - Origin.x));//*Scale);
707 AdjustedCentre.y := round ((ArcCentre.y - Origin.y));//*Scale);
708 DrawControlPoint (canvas, AdjustedCentre);
709 end;
710 end;
711 end;
712
713
714 procedure TEdge.PaintBiBi (const Origin : TPoint);
715 var srcNode1, srcNode2, destNode1, destNode2 : TSubNode; h1, h2, pSrc, pDest,
716 pt, AdjustedCentre : TPoint;
717 Segn : integer; par : Double;
718 begin
719 srcNode1 := srcConnectedNodeList[0].SubNode;
720 srcNode2 := srcConnectedNodeList[1].SubNode;
721 destNode1 := destConnectedNodeList[0].SubNode;
722 destNode2 := destConnectedNodeList[1].SubNode;
723
724 // Draw one arc at a time - there will be four for a BiBi
725 // Get the bezier control handle coordinates for the first arc
726 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
727
728 // Start to draw arcs, first src1 to centroid, calculate the centre of the src node
729 pSrc := srcNode1.GetCentrePt;
730 // First arc goes from src to centroid, so the destination for the first arc is the centroid
731 pDest := ArcCentre;
732 // Compute the points along the bezier from node centre to centroid
733 ComputeBezPoints ([pSrc, h1, h2, pDest]);
734 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
735 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
736 pDest.x := pDest.x - Origin.x; pDest.y := pDest.y - Origin.y;
737
738 // Clip the src starting point by returning the bezier segment number which intersects with the node outer rectangle
739 if ComputeBezLineIntersection (srcNode1, pt, Par, Segn) then
740 begin
741 // Store the new start point for the bezier, and draw it
742 pSrc.x := pt.x - Origin.x; pSrc.y := pt.y - Origin.y;
743 intersect[1] := pt;
744 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
745 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
746 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
747 end;
748
749 // Next arc, from src2 to centroid
750 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
751 pSrc := srcNode2.GetCentrePt;
752 pDest := ArcCentre;
753 ComputeBezPoints ([pSrc, h1, h2, pDest]);
754 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
755 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
756 pDest.x := pDest.x - Origin.x; pDest.y := pDest.y - Origin.y;
757
758 if ComputeBezLineIntersection (SrcNode2, pt, Par, Segn) then
759 begin
760 pSrc.x := pt.x - Origin.x; pSrc.y := pt.y - Origin.y;
761 intersect[2] := pt;
762 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
763 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
764 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
765 end;
766
767 // Next arc, from centroid to dest1
768 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
769 pSrc := ArcCentre;
770 pDest := DestNode1.GetCentrePt;
771 ComputeBezPoints ([pSrc, h1, h2, pDest]);
772 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
773 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
774 pSrc.x := pSrc.x - Origin.x; pSrc.y := pSrc.y - Origin.y;
775
776 if ComputeBezLineIntersection (DestNode1, pt, Par, Segn) then
777 begin
778 pDest.x := pt.x - Origin.x; pDest.y := pt.y - Origin.y;
779 intersect[3] := pt;
780 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
781 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
782 DrawArrow (canvas, pDest, 1.0, pDest.x - h2.x, pDest.y - h2.y);
783 if Selected then DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
784 end;
785
786 // Next arc, from centroid to dest2
787 h1 := SubArcs[4].h1; h2 := SubArcs[4].h2;
788 pSrc := ArcCentre;
789 pDest := DestNode2.GetCentrePt;
790 ComputeBezPoints ([pSrc, h1, h2, pDest]);
791 h1.x := h1.x - Origin.x; h1.y := h1.y - Origin.y;
792 h2.x := h2.x - Origin.x; h2.y := h2.y - Origin.y;
793 pSrc.x := pSrc.x - Origin.x; pSrc.y := pSrc.y - Origin.y;
794
795 if ComputeBezLineIntersection (destNode2, pt, Par, Segn) then
796 begin
797 pDest.x := pt.x - Origin.x; pDest.y := pt.y - Origin.y;
798 intersect[4] := pt;
799 //ConvertPointsToScreenCoords (pSrc, h1, h2, pDest);
800 DrawBezier (canvas, [pSrc, h1, h2, pDest]);
801 DrawArrow (canvas, pDest, 1.0, pDest.x - h2.x, pDest.y - h2.y);
802 if Selected then
803 begin
804 DoDrawSubArcHandles ([pSrc, h1, h2, pDest]);
805 AdjustedCentre.x := round ((ArcCentre.x - Origin.x));//*Scale);
806 AdjustedCentre.y := round ((ArcCentre.y - Origin.y));//*Scale);
807 DrawControlPoint (Canvas, AdjustedCentre);
808 end;
809 end;
810 end;
811
812
813 procedure TEdge.Paint (const Origin : TPoint);
814 var OldPenColor, OldBrushColor : TColor;
815 OldLineThickness : integer;
816 begin
817 OldPenColor := Canvas.Pen.Color;
818 OldBrushColor := Canvas.Brush.Color;
819 OldLineThickness := Canvas.Pen.Width;
820 Canvas.Pen.Width := LineThickness;
821 if Selected then
822 Canvas.Pen.Color := SelectedLineColor
823 else Canvas.Pen.Color := LineColor;
824
825 Canvas.Brush.Color := ArrowColor;
826 case EdgeType of
827 eUniUni : PaintUniUni (Origin);
828 eBiUni : PaintBiUni (Origin);
829 eUniBi : PaintUniBi (Origin);
830 eBiBi : PaintBiBi (Origin);
831 end;
832
833 Canvas.Pen.Color := OldPenColor;
834 Canvas.Brush.Color := OldBrushColor;
835 Canvas.Pen.Width := OldLineThickness;
836 end;
837
838
839 function TEdge.FindNode (Node : TNode) : boolean;
840 var i : integer;
841 begin
842 result := False;
843 for i := 0 to srcConnectedNodeList.Count - 1 do
844 if srcConnectedNodeList[i].SubNode.ParentNode = Node then
845 begin
846 result := True;
847 exit;
848 end;
849
850 for i := 0 to srcConnectedNodeList.Count - 1 do
851 if destConnectedNodeList[i].SubNode.ParentNode = Node then
852 begin
853 result := True;
854 exit;
855 end;
856 end;
857
858
859 function TEdge.FindNode (Node : TNode; var Edge : TEdge; var Direction : TDirection; var EdgeSeg : integer) : Boolean;
860 var i : integer;
861 begin
862 Result := False;
863 for i := 0 to srcConnectedNodeList.Count - 1 do
864 if srcConnectedNodeList[i].SubNode.ParentNode = Node then
865 begin
866 Edge := Self;
867 Direction := dSrc;
868 Result := True;
869 EdgeSeg := i;
870 Exit;
871 end;
872 for i := 0 to destConnectedNodeList.Count - 1 do
873 if destConnectedNodeList[i].SubNode.ParentNode = Node then
874 begin
875 Edge := Self;
876 Direction := dDest;
877 Result := True;
878 EdgeSeg := i;
879 Exit;
880 end;
881 end;
882
883
884 // This is a tedious one....
885
886 // Returns -1 if mouse is not on an Arc, else returns the Arc id, the subarc, the
887 // parametric distance from beginning of arc to the mouse click coordinate,
888 // Arc id is placed in AId and the Node Id closest to the point to selection in NId
889 function TEdge.IsOnEdge (x, y : integer; var NId : integer; sub : TCurrentSubArc; var t : double) : boolean;
890 var src, dest: integer; pt1, pt2, h1, h2 : TPoint;
891 begin
892 result := False; NId := 0; sub := 1;
893 case EdgeType of
894 eUniUni: begin
895 { Collect up the bezier parameters }
896
897 { Don't define the bezier end points using the node centres but
898 use the intersection points, if you don't the bezier will not follow
899 the path shown on the screen, since the visible bezier is defined
900 using intersection points and not centre points }
901 pt1 := Intersect[1];
902 pt2 := Intersect[2];
903 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
904 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
905 begin
906 result := True; sub := 1;
907 //if t < 0.5 then NId := LeftNodeID[1]
908 //else NId := FArcList[i].RightNodeID[1]; exit;
909 end;
910 end;
911 eUniBi : begin
912 // With a UniBi we must test three Subarcs
913 pt1 := Intersect[1];
914 pt2 := ArcCentre;
915 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
916 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
917 begin
918 result := True; sub := 1; exit;
919 end;
920 // Not on the first one, so try second Subarc
921 pt1 := ArcCentre;
922 pt2 := Intersect[2];
923 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
924 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
925 begin
926 result := True; sub := 2; exit;
927 end;
928 // finally try third and last Subarc
929 pt1 := ArcCentre;
930 pt2 := Intersect[3];
931 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
932 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
933 begin
934 result := True; sub := 3; exit;
935 end;
936 end;
937 eBiUni : begin
938 // With a BiUni we must test three Subarcs
939 pt1 := Intersect[1];
940 pt2 := ArcCentre;
941 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
942 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
943 begin
944 result := True; sub := 1; exit;
945 end;
946 // Otherwise, try second Subarc
947 pt1 := Intersect[2];
948 pt2 := ArcCentre;
949 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
950 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
951 begin
952 result := True; sub := 2; exit;
953 end;
954 // finally try third and last Subarc
955 pt1 := ArcCentre;
956 pt2 := Intersect[3];
957 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
958 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
959 begin
960 result := True; sub := 3; exit;
961 end;
962 end;
963 eBiBi : begin
964 // With a BiBi we must test four Subarcs
965 pt1 := Intersect[1];
966 pt2 := ArcCentre;
967 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
968 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
969 begin
970 result := True; sub := 1; exit;
971 end;
972 // Otherwise, try second Subarc
973 pt1 := Intersect[2];
974 pt2 := ArcCentre;
975 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
976 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
977 begin
978 result := True; sub := 2; exit;
979 end;
980 // try third Subarc
981 pt1 := ArcCentre;
982 pt2 := Intersect[3];
983 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
984 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
985 begin
986 result := True; sub := 3; exit;
987 end;
988 // finally try forth and last Subarc
989 pt1 := ArcCentre;
990 pt2 := Intersect[4];
991 h1 := SubArcs[4].h1; h2 := SubArcs[4].h2;
992 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
993 begin
994 result := True; sub := 4; exit;
995 end;
996 end;
997 eTriBi : begin
998 // With a TriBi we must test five Subarcs }
999 pt1 := Intersect[1];
1000 pt2 := ArcCentre;
1001 h1 := SubArcs[1].h1; h2 := SubArcs[1].h2;
1002 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
1003 begin
1004 result := True; sub := 1; exit;
1005 end;
1006 // Otherwise, try second Subarc }
1007 pt1 := Intersect[2];
1008 pt2 := ArcCentre;
1009 h1 := SubArcs[2].h1; h2 := SubArcs[2].h2;
1010 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
1011 begin
1012 result := True; sub := 2; exit;
1013 end;
1014 // Otherwise, try third Subarc }
1015 pt1 := Intersect[3];
1016 pt2 := ArcCentre;
1017 h1 := SubArcs[3].h1; h2 := SubArcs[3].h2;
1018 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
1019 begin
1020 result := True; sub := 3; exit;
1021 end;
1022 // try fourth Subarc }
1023 pt1 := ArcCentre;
1024 pt2 := Intersect[4];
1025 h1 := SubArcs[4].h1; h2 := SubArcs[4].h2;
1026 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
1027 begin
1028 result := True; sub := 4; exit;
1029 end;
1030 // finally try fifth and last Subarc }
1031 pt1 := ArcCentre;
1032 pt2 := Intersect[5];
1033 h1 := SubArcs[5].h1; h2 := SubArcs[5].h2;
1034 if PtOnBezier ([pt1, h1, h2, pt2], point (x, y), t) then
1035 begin
1036 result := True; sub := 5; exit;
1037 end;
1038 end;
1039 end;
1040 end;
1041
1042
1043 procedure TEdge.Save (s : TStream);
1044 var i, st : integer; Writer : TWriter;
1045 begin
1046 Writer := TWriter.Create (s, 1024);
1047 Writer.WriteString (Name);
1048 Writer.WriteString (RateLaw);
1049 Writer.Write (EdgeType, Sizeof (EdgeType));
1050 Writer.Write (Direction, SizeOf (Direction));
1051 Writer.WriteBoolean (Reversible);
1052 Writer.WriteInteger (LineThickness);
1053 Writer.Write (LineColor, SizeOf (TColor));
1054 Writer.Write (SelectedLineColor, SizeOf (TColor));
1055 Writer.Write (ArrowColor, SizeOf (TColor));
1056 Writer.WriteBoolean (UseArrow);
1057 Writer.Free;
1058 SymbolList.Save (s);
1059
1060 case EdgeType of
1061 eUniUni : s.Write (SubArcs[1], sizeof (SubArcs[1]));
1062 eBiUni, eUniBi :
1063 begin
1064 s.Write (SubArcs[1], sizeof (SubArcs[1]));
1065 s.Write (SubArcs[2], sizeof (SubArcs[2]));
1066 s.Write (SubArcs[3], sizeof (SubArcs[3]));
1067 end;
1068 eBiBi :
1069 begin
1070 s.Write (SubArcs[1], sizeof (SubArcs[1]));
1071 s.Write (SubArcs[2], sizeof (SubArcs[2]));
1072 s.Write (SubArcs[3], sizeof (SubArcs[3]));
1073 s.Write (SubArcs[4], sizeof (SubArcs[4]));
1074 end;
1075 end;
1076
1077 s.Write (ArcCentre, sizeof (ArcCentre));
1078 srcConnectedNodeList.Save (s);
1079 destConnectedNodeList.Save (s);
1080 end;
1081
1082
1083 constructor TEdge.Read (s : TStream; Canvas : TCanvas; EdgeId : integer; NodeList : TNodeList);
1084 var MyCount, i, NodeId, st : integer; Node : TNode; Reader : TReader;
1085 begin
1086 inherited Create;
1087 Self.Canvas := Canvas;
1088
1089 Reader := TReader.Create (s, 1024);
1090 Name := Reader.ReadString;
1091 RateLaw := Reader.ReadString;
1092 Reader.Read (EdgeType, Sizeof (EdgeType));
1093 Reader.Read (Direction, SizeOf (Direction));
1094 Reversible := Reader.ReadBoolean;
1095 LineThickness := Reader.ReadInteger;
1096 Reader.Read (LineColor, SizeOf (TColor));
1097 Reader.Read (SelectedLineColor, SizeOf (TColor));
1098 Reader.Read (ArrowColor, SizeOf (TColor));
1099 UseArrow := Reader.ReadBoolean;
1100
1101 Reader.Free;
1102
1103 SymbolList := TSymbolList.Create;
1104 SymbolList.Read (s);
1105 // Load Bezier Control handle information
1106 case EdgeType of
1107 eUniUni : s.Read (SubArcs[1], sizeof (SubArcs[1]));
1108 eBiUni, eUniBi :
1109 begin
1110 s.Read (SubArcs[1], sizeof (SubArcs[1]));
1111 s.Read (SubArcs[2], sizeof (SubArcs[2]));
1112 s.Read (SubArcs[3], sizeof (SubArcs[3]));
1113 end;
1114 eBiBi :
1115 begin
1116 s.Read (SubArcs[1], sizeof (SubArcs[1]));
1117 s.Read (SubArcs[2], sizeof (SubArcs[2]));
1118 s.Read (SubArcs[3], sizeof (SubArcs[3]));
1119 s.Read (SubArcs[4], sizeof (SubArcs[4]));
1120 end;
1121 end;
1122
1123 s.Read (ArcCentre, sizeof (ArcCentre));
1124 srcConnectedNodeList := TConnectedNodeList.Read (s);
1125 destConnectedNodeList := TConnectedNodeList.Read (s);
1126 end;
1127
1128
1129 procedure TEdge.SetArcColor (c : TColor);
1130 begin
1131 if c <> LineColor then
1132 begin
1133 LineColor := c;
1134 ArrowColor := c;
1135 end;
1136 end;
1137
1138
1139 function TEdge.GetArcColor : TColor;
1140 begin
1141 result := LineColor;
1142 end;
1143
1144
1145 // -------------------------------------------------------------------------
1146
1147
1148 constructor TEdgeList.Create;
1149 begin
1150 inherited Create;
1151 GlobalArcColor := DEFAULT_LINECOLOR;
1152 end;
1153
1154
1155 constructor TEdgeList.Clone (r : TEdgeList);
1156 var i : Integer;
1157 begin
1158 inherited Create;
1159 // Possibliy not required
1160 //for i := 0 to r.Count - 1 do
1161 // Self.Add (TEdge.Clone (r[i]));
1162 end;
1163
1164
1165 function TEdgeList.Get (Index : integer) : TEdge;
1166 begin
1167 result := TEdge(inherited Get(index));
1168 end;
1169
1170
1171 procedure TEdgeList.Put (Index : integer; Item : TEdge);
1172 begin
1173 inherited Put (Index, Item);
1174 end;
1175
1176
1177 function TEdgeList.Add (Item : TEdge) : integer;
1178 begin
1179 result := inherited Add (Item);
1180 end;
1181
1182
1183 procedure TEdgeList.Delete (Index : Integer);
1184 begin
1185 Items[Index].Free;
1186 Items[Index] := nil;
1187 inherited Delete (Index);
1188 end;
1189
1190
1191 destructor TEdgeList.Destroy;
1192 var i : integer;
1193 begin
1194 for i := 0 to Count - 1 do
1195 Items[i].Free;
1196 inherited Destroy;
1197 end;
1198
1199
1200 procedure TEdgeList.Save (s : TStream);
1201 var c, i : integer;
1202 begin
1203 s.Write (GlobalArcColor, sizeof (GlobalArcColor));
1204 c := Count;
1205 s.write (c, SizeOf (c));
1206 for i := 0 to c - 1 do
1207 Items[i].Save (s);
1208 end;
1209
1210
1211 procedure TEdgeList.Read (s : TStream; Canvas : TCanvas; NodeList : TNodeList);
1212 var c, i : integer;
1213 begin
1214 s.Read (GlobalArcColor, sizeof (GlobalArcColor));
1215 s.read (c, SizeOf (c));
1216 for i := 0 to c - 1 do
1217 Add (TEdge.Read (s, Canvas, i, NodeList));
1218 end;
1219
1220
1221 function TEdgeList.FindEdge (x, y : integer; var Edge : TEdge; var Index : Integer) : boolean;
1222 var i, AId, NId : integer; sub : TCurrentSubArc; t : Double;
1223 begin
1224 result := False;
1225 for i := 0 to Count - 1 do
1226 begin
1227 if Items[i].IsOnEdge (x, y, NId, sub, t) then
1228 begin
1229 result := True;
1230 Edge := Items[i] as TEdge;
1231 Index := i;
1232 Exit;
1233 end;
1234 end;
1235 end;
1236
1237
1238 procedure TEdgeList.Paint (const Origin : TPoint);
1239 var i : integer;
1240 begin
1241 for i := 0 to Count - 1 do
1242 (Items[i] as TEdge).Paint (Origin);
1243 end;
1244
1245
1246 procedure TEdgeList.SetGlobalArcColor (c : TColor);
1247 var i : integer;
1248 begin
1249 GlobalArcColor := c;
1250 for i := 0 to Count - 1 do
1251 (Items[i] as TEdge).SetArcColor (c);
1252 end;
1253
1254
1255 function TEdgeList.GetGlobalArcColor : TColor;
1256 begin
1257 result := GlobalArcColor;
1258 end;
1259
1260
1261 end.
1262
1263
1264
1265
1266
1267 {function TEdge.IsOnEdge (x, y : integer) : boolean;
1268 var FromPt1, FromPt2, FromPt, ToPt, ToPt1, ToPt2, c : TPoint;
1269 begin
1270 result := False;
1271 case EdgeType of
1272 eUU :
1273 begin
1274 FromPt := srcNodeList[0].GetCentrePt (srcShadowList[0]);
1275 ToPt := destNodeList[0].GetCentrePt (destShadowList[0]);
1276 if PtOnLine (FromPt, ToPt, Point (x, y)) then
1277 result := True;
1278 end;
1279 eBiU :
1280 begin
1281 c := ComputeCentroid (Self);
1282 FromPt1 := srcNodeList[0].GetCentrePt (srcShadowList[0]);
1283 FromPt2 := srcNodeList[1].GetCentrePt (srcShadowList[1]);
1284 ToPt := destNodeList[0].GetCentrePt (destShadowList[0]);
1285
1286 if PtOnLine (FromPt1, c, Point (x, y)) then
1287 begin
1288 result := True;
1289 Exit;
1290 end;
1291
1292 if PtOnLine (FromPt2, c, Point (x, y)) then
1293 begin
1294 result := True;
1295 Exit;
1296 end;
1297
1298 if PtOnLine (c, ToPt, Point (x, y)) then
1299 begin
1300 result := True;
1301 Exit;
1302 end;
1303 end;
1304
1305 eUBi :
1306 begin
1307 c := ComputeCentroid (Self);
1308 FromPt := srcNodeList[0].GetCentrePt (srcShadowList[0]);
1309 ToPt1 := destNodeList[0].GetCentrePt (destShadowList[0]);
1310 ToPt2 := destNodeList[1].GetCentrePt (destShadowList[1]);
1311
1312 if PtOnLine (FromPt, c, Point (x, y)) then
1313 begin
1314 result := True;
1315 Exit;
1316 end;
1317
1318 if PtOnLine (c, ToPt1, Point (x, y)) then
1319 begin
1320 result := True;
1321 Exit;
1322 end;
1323
1324 if PtOnLine (c, ToPt2, Point (x, y)) then
1325 begin
1326 result := True;
1327 Exit;
1328 end;
1329 end;
1330
1331 eBiBi :
1332 begin
1333 c := ComputeCentroid (Self);
1334 FromPt1 := srcNodeList[0].GetCentrePt (srcShadowList[0]);
1335 FromPt2 := srcNodeList[1].GetCentrePt (srcShadowList[1]);
1336 ToPt1 := destNodeList[0].GetCentrePt (destShadowList[0]);
1337 ToPt2 := destNodeList[1].GetCentrePt (destShadowList[1]);
1338
1339 if PtOnLine (FromPt1, c, Point (x, y)) then
1340 begin
1341 result := True;
1342 Exit;
1343 end;
1344
1345 if PtOnLine (FromPt1, FromPt2, Point (x, y)) then
1346 begin
1347 result := True;
1348 Exit;
1349 end;
1350
1351 if PtOnLine (c, ToPt1, Point (x, y)) then
1352 begin
1353 result := True;
1354 Exit;
1355 end;
1356
1357 if PtOnLine (c, ToPt2, Point (x, y)) then
1358 begin
1359 result := True;
1360 Exit;
1361 end;
1362 end;
1363
1364 end;
1365 end;}