ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JDesigner/uNodeList.pas
Revision: 1.1.1.1 (vendor branch)
Committed: Mon Dec 10 19:29:13 2001 UTC (14 years, 4 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 uNodeList;
2
3
4 // Defines the Node Object and a list of Nodes Object
5
6
7 interface
8
9 uses Windows, Classes, Graphics, uNetUtils;
10
11 const
12 // The following constant is the distance between the outer
13 // and inner rectangles, the 'dead' space between a node and
14 // the launch point for a reaction arc (edge)
15 NODE_ARC_DEADSPACE = 7;
16 // Arc default dimensions
17 NODE_EDGE_THICKNESS = 1;
18 FLOATING_NODE_EDGE_COLOR = clBlack;
19 BOUNDARY_NODE_EDGE_COLOR = clBlack;
20 SELECTED_NODE_EDGE_COLOR = clRed;
21 NODE_TEXT_COLOR = clBlack;
22
23
24 type
25 TNode = class;
26 TConnectedEdge = class (TObject)
27 Edge : TObject;
28 constructor Create; overload;
29 constructor Create (Edge : TObject); overload;
30 constructor Read (s : TStream);
31 procedure Save (s : TStream);
32 end;
33
34 TConnectedEdgeList = class (TList)
35 private
36 protected
37 function Get (Index : integer) : TConnectedEdge;
38 procedure Put (Index : integer; Item : TConnectedEdge);
39 public
40 constructor Create;
41 destructor Destroy; override;
42 function Add (Item : TConnectedEdge) : integer;
43 procedure Delete (Index : Integer);
44 property Items[Index : integer] : TConnectedEdge read Get write Put; default;
45 procedure Save (s : TStream);
46 procedure Read (s : TStream);
47 end;
48
49
50 TSubNode = class (TObject)
51 Id : integer; // Only used during serialisation
52 x, y, w, h : integer; // Bounding box of this subnode
53 OldX, OldY : integer; // Required when moving nodes around
54 ConnectedEdgeList : TConnectedEdgeList; // Edges connected to this subnode
55 Selected : boolean; // True if subnode is selected
56 ParentNode : TNode; // So that we can call methods (eg Paint) in the Parent
57 constructor Create (ParentNode : TNode);
58 destructor Destroy; override;
59
60 function GetCentrePt : TPoint; // Computes the centre of the subnode
61 procedure Save (s : TStream);
62 constructor Read (s : TStream; ParentNode : TNode);
63 end;
64
65 TSubList = class (TList)
66 private
67 protected
68 function Get (Index : integer) : TSubNode;
69 procedure Put (Index : integer; Item : TSubNode);
70 public
71 constructor Create;
72 destructor Destroy; override;
73 function Add (Item : TSubNode) : integer;
74 procedure Delete (Index : Integer);
75 property Items[Index : integer] : TSubNode read Get write Put; default;
76 procedure Save (s : TStream);
77 procedure Read (s : TStream; ParentNode : TNode);
78 end;
79
80 TNodeStatus = (nsFloating, nsBoundary);
81 TNodeBorderType = (ntRound, ntSquare, ntCircle, ntNone);
82 TNode = class (TObject)
83 private
84 public
85 Id : integer; // Only used during serialisation
86 Name : string;
87 Value : double;
88 Volume : double; // Don't do anything with this yet?
89 Status : TNodeStatus; // Floating or Boundary
90
91 // SubList stores the list of shadow nodes including the mother node
92 // which is always stored at position zero.
93 SubList : TSubList;
94 Canvas : TCanvas; // Draw nodes onto this Canvas
95
96 BorderType : TNodeBorderType; // Square, round, none etc
97 EdgeThickness : integer;
98 EdgeColor : TColor;
99 SelectedEdgeColour : TColor;
100 Font : TFont;
101
102 UseImage : boolean;
103 Image : TBitmap;
104
105 procedure SetBoundingBox (SubNode : TSubNode);
106 function IsOnNode (x, y : integer; var SubNode : TSubNode) : boolean;
107 function ComputeOuterSegs (SubNode : TSubNode) : TSquareSegs;
108 function ComputeLaunchPoint (SubNode : TSubNode; EndPt : TPoint) : TPoint;
109 function AddShadow : integer;
110 procedure UnSelect;
111 procedure SetNodeColor (const c : TColor);
112 function GetNodeColor : TColor;
113 procedure SetTextColor (const c : TColor);
114 function GetTextColor : TColor;
115
116 procedure PaintIndividualNode (const Origin : TPoint; ShadowId : integer);
117 procedure Paint (const Origin : TPoint);
118 procedure Save (s : TStream);
119 constructor Read (Canvas : TCanvas; s : TStream);
120
121 constructor Create (Canvas : TCanvas); overload;
122 constructor Create (Canvas : TCanvas; Name : string); overload;
123 constructor Create (Canvas : TCanvas; Name : string; x, y : integer); overload;
124 constructor Create (Canvas : TCanvas; Name : string; x, y, w, h : integer); overload;
125 destructor Destroy;
126 end;
127
128
129 TNodeList = class (TList)
130 private
131 GlobalFloatingNodeColor : TColor;
132 GlobalBoundaryNodeColor : TColor;
133 GlobalTextColor : TColor;
134 protected
135 function Get (Index : integer) : TNode;
136 procedure Put (Index : integer; Item : TNode);
137 public
138 constructor Create;
139 constructor Clone (r : TNodeList);
140 destructor Destroy; override;
141 function Add (Item : TNode) : integer;
142 procedure Delete (Index : Integer);
143 function Find (str : string; var Index : integer) : boolean;
144 property Items[Index : integer] : TNode read Get write Put; default;
145 procedure Save (s : TStream);
146 procedure Read (s : TStream; Canvas : TCanvas);
147
148 procedure Paint (const Origin : TPoint);
149 function FindNode (x, y : integer; var SubNode : TSubNode) : Boolean;
150
151 function GetGlobalFloatingNodeColor : TColor;
152 procedure SetGlobalFloatingNodeColor (c : TColor);
153
154 function GetGlobalBoundaryNodeColor : TColor;
155 procedure SetGlobalBoundaryNodeColor (c : TColor);
156
157 function GetGlobalTextColor : TColor;
158 procedure SetGlobalTextColor (c : TColor);
159 end;
160
161
162 implementation
163
164
165 // ----------------------------------------------------------------------
166
167
168 uses uEdgeList;
169
170 // Padding is to make the saving and loading of the nodes future proof
171 var Padding : array[0..31] of Byte;
172
173
174 constructor TConnectedEdge.Create;
175 begin
176 inherited Create;
177 Edge := nil;
178 end;
179
180
181 constructor TConnectedEdge.Create (Edge : TObject);
182 begin
183 inherited Create;
184 Self.Edge := Edge;
185 end;
186
187
188 procedure TConnectedEdge.Save (s : TStream);
189 begin
190 s.Write ((Edge as TEdge).Id, sizeof ((Edge as TEdge).Id));
191 end;
192
193
194 constructor TConnectedEdge.Read (s : TStream);
195 begin
196 inherited Create;
197 s.Read (Edge, sizeof (integer));
198 end;
199
200
201
202 // ----------------------------------------------------------------------
203
204
205 constructor TConnectedEdgeList.Create;
206 begin
207 inherited Create;
208 end;
209
210
211 function TConnectedEdgeList.Get (Index : integer) : TConnectedEDge;
212 begin
213 result := TConnectedEdge(inherited Get(index));
214 end;
215
216
217 procedure TConnectedEdgeList.Put (Index : integer; Item : TConnectedEdge);
218 begin
219 inherited Put (Index, Item);
220 end;
221
222
223 function TConnectedEdgeList.Add (Item : TConnectedEdge) : integer;
224 begin
225 result := inherited Add (Item);
226 end;
227
228
229 procedure TConnectedEdgeList.Delete (Index : Integer);
230 begin
231 Items[Index].Free;
232 Items[Index] := nil;
233 inherited Delete (Index);
234 end;
235
236
237 destructor TConnectedEdgeList.Destroy;
238 var i : integer;
239 begin
240 for i := 0 to Count - 1 do
241 Items[i].Free;
242 inherited Destroy;
243 end;
244
245
246 procedure TConnectedEdgeList.Save (s : TStream);
247 var c, i : integer;
248 begin
249 c := Count;
250 s.Write (c, SizeOf (c));
251 for i := 0 to c - 1 do
252 Items[i].Save (s);
253 end;
254
255
256 procedure TConnectedEdgeList.Read (s : TStream);
257 var c, i : integer;
258 begin
259 s.Read (c, SizeOf (c));
260 for i := 0 to c - 1 do
261 Add (TConnectedEdge.Read (s));
262 end;
263
264
265 // ---------------------------------------------------------------------------
266
267
268 constructor TSubNode.Create (ParentNode : TNode);
269 begin
270 inherited Create;
271 x := 0; y := 0; w := 0; h := 0;
272 ConnectedEdgeList := TConnectedEdgeList.Create;
273 Self.ParentNode := ParentNode;
274 end;
275
276
277 destructor TSubNode.Destroy;
278 var i : integer;
279 begin
280 // Wipe Connection
281 for i := 0 to ConnectedEdgeList.Count - 1 do
282 ConnectedEdgeList[i] := nil;
283 ConnectedEdgeList.Pack;
284 ConnectedEdgeList.Free;
285 inherited Destroy;
286 end;
287
288
289 procedure TSubNode.Save (s : TStream);
290 var i, c : integer;
291 begin
292 s.Write (x, sizeof (x));
293 s.Write (y, sizeof (y));
294 s.Write (w, sizeof (w));
295 s.Write (h, sizeof (h));
296 c := ConnectedEdgeList.count;
297 s.Write (c, sizeof (c));
298 for i := 0 to c - 1 do
299 ConnectedEdgeList[i].Save (s);
300 end;
301
302
303 constructor TSubNode.Read (s : TStream; ParentNode : TNode);
304 var i, c, EdgeId : integer; str : string; Edge : TEdge; ConnectedEdge : TConnectedEdge;
305 begin
306 inherited Create;
307 Self.ParentNode := ParentNode;
308 s.Read (x, sizeof (x));
309 s.Read (y, sizeof (y));
310 s.Read (w, sizeof (w));
311 s.Read (h, sizeof (h));
312 s.Read (c, sizeof (c));
313 ConnectedEdgeList := TConnectedEdgeList.Create;
314 for i := 0 to c - 1 do
315 ConnectedEdgeList.Add (TConnectedEdge.Read (s));
316 end;
317
318
319 // Compute the centre of the node given the shadows id
320 function TSubNode.GetCentrePt : TPoint;
321 begin
322 result.x := x + (w div 2);
323 result.y := y + (h div 2);
324 end;
325
326
327 // ----------------------------------------------------------------------
328
329
330 constructor TSubList.Create;
331 begin
332 inherited Create;
333 end;
334
335
336 function TSubList.Get (Index : integer) : TSubNode;
337 begin
338 result := TSubNode(inherited Get(index));
339 end;
340
341
342 procedure TSubList.Put (Index : integer; Item : TSubNode);
343 begin
344 inherited Put (Index, Item);
345 end;
346
347
348 function TSubList.Add (Item : TSubNode) : integer;
349 begin
350 result := inherited Add (Item);
351 end;
352
353
354 procedure TSubList.Delete (Index : Integer);
355 begin
356 Items[Index].Free;
357 Items[Index] := nil;
358 inherited Delete (Index);
359 end;
360
361
362 destructor TSubList.Destroy;
363 var i : integer;
364 begin
365 for i := 0 to Count - 1 do
366 Items[i].Free;
367 inherited Destroy;
368 end;
369
370
371 procedure TSubList.Save (s : TStream);
372 var c, i : integer;
373 begin
374 c := Count;
375 s.Write (c, SizeOf (c));
376 for i := 0 to c - 1 do
377 Items[i].Save (s);
378 end;
379
380
381 procedure TSubList.Read (s : TStream; ParentNode : TNode);
382 var c, i : integer;
383 begin
384 s.Read (c, SizeOf (c));
385 for i := 0 to c - 1 do
386 Add (TSubNode.Read (s, ParentNode));
387 end;
388
389
390
391 // -----------------------------------------------------------------------
392
393
394 constructor TNode.Create (Canvas : TCanvas);
395 var i : integer; SubNode : TSubNode;
396 begin
397 inherited Create;
398 Self.Canvas := Canvas;
399 Name := 'untitled';
400 SubList := TSubList.Create;
401
402 // Create the mother node
403 SubNode := TSubNode.Create (Self);
404 SubList.Add (SubNode);
405
406 SetBoundingBox (SubNode);
407 BorderType := ntRound;
408 EdgeColor := FLOATING_NODE_EDGE_COLOR;
409 EdgeThickness := NODE_EDGE_THICKNESS;
410 SelectedEdgeColour := SELECTED_NODE_EDGE_COLOR;
411 Status := nsFloating;
412 Font := TFont.Create;
413 Font.Color := NODE_TEXT_COLOR;
414 Font.Name := 'Arial';
415 Font.Size := 8;
416 Font.Style := [];
417 Image := nil;
418 UseImage := False;
419 end;
420
421
422 constructor TNode.Create (Canvas : TCanvas; Name : string);
423 begin
424 Create (Canvas);
425 Self.Name := Name;
426 end;
427
428
429 constructor TNode.Create (Canvas : TCanvas; Name : string; x, y : integer);
430 begin
431 Create (Canvas);
432 Self.Name := Name;
433 Self.SubList[0].x := x; Self.SubList[0].y := y;
434 SetBoundingBox (Self.SubList[0]);
435 end;
436
437
438 constructor TNode.Create (Canvas : TCanvas; Name : string; x, y, w, h : integer);
439 var i : integer;
440 begin
441 // Do not call Create (Canvas) here since it calls SetBounding Box which we don't
442 // want to happen coz' we're providing our own bounding box.
443 inherited Create;
444 Self.Canvas := Canvas;
445 Self.Name := Name;
446 Self.SubList := TSubList.Create;
447
448 Self.SubList[0].x := x; Self.SubList[0].y := y;
449 Self.SubList[0].w := w; Self.SubList[0].h := h;
450
451 BorderType := ntRound;
452 EdgeColor := FLOATING_NODE_EDGE_COLOR;
453 EdgeThickness := NODE_EDGE_THICKNESS;
454 SelectedEdgeColour := SELECTED_NODE_EDGE_COLOR;
455 Status := nsFloating;
456
457 Font := TFont.Create;
458 Font.Color := NODE_TEXT_COLOR;
459 Font.Name := 'Arial';
460 Font.Size := 8;
461 Font.Style := [];
462
463 UseImage := False;
464 Image := nil;
465 end;
466
467
468 destructor TNode.Destroy;
469 var i, j : integer;
470 begin
471 // We mustn't destroy the edges since we don't own them, just wipe the references
472 for i := 0 to SubList.Count - 1 do
473 begin
474 for j := 0 to SubList[i].ConnectedEdgeList.Count - 1 do
475 SubList[i].ConnectedEdgeList.Items[j] := nil;
476 SubList[i].ConnectedEdgeList.Pack;
477 SubList[i].Free;
478 end;
479 SubList.Free;
480 Font.Free;
481 Image.Free;
482 inherited Destroy;
483 end;
484
485
486
487 procedure TNode.SetBoundingBox (SubNode : TSubNode);
488 var Size : TSize;
489 begin
490 //if SubNode.ParentNode.UseImage then
491 // begin
492 // Size.cx := Image.Width;
493 // Size.cy := Image.Height;
494 // end
495 //else
496 Size := Canvas.TextExtent (Name);
497 // Set a minimum bounds
498 if Size.cx < 24 then Size.cx := 24;
499 if Size.cy < 12 then Size.cy := 12;
500 SubNode.w := Size.cx + 5; SubNode.h := Size.cy + 4;
501 end;
502
503
504 procedure TNode.PaintIndividualNode (const Origin : TPoint; ShadowId : integer);
505 var tx, ty, tw, th : integer; DeadSpace, p, Newx, Newy, i, OldWidth : integer;
506 OldStyle : TBrushStyle; ct : TPoint;
507 begin
508 // SetB.. required in case font settings have changed
509 SetBoundingBox (SubList[ShadowId]);
510 // Get the bounding box dimensions
511 tx := SubList[ShadowId].x; ty := SubList[ShadowId].y;
512 tw := SubList[ShadowId].w; th := SubList[ShadowId].h;
513 ct.x := tx + (tw div 2);
514 ct.y := ty + (th div 2);
515
516 if SubList[ShadowId].Selected then
517 Canvas.Pen.Color := clRed
518 else Canvas.Pen.Color := EdgeColor;
519 Canvas.Pen.Width := EdgeThickness;
520 // Centre the text
521 DeadSpace := 4;
522 p := ((tw+DeadSpace) div 2) - (Canvas.TextWidth (Name) div 2);
523
524 // Paint mother node first
525 Newx := tx - Origin.x; Newy := ty - Origin.y;
526 ct.x := ct.x - Origin.x; ct.y := ct.y - Origin.y;
527
528 Canvas.Pen.Width := 1;
529 if ShadowId = 0 then
530 Canvas.Pen.Style := psSolid
531 else Canvas.Pen.Style := psDot;
532 if Status = nsBoundary then
533 begin
534 case BorderType of
535 ntRound :
536 Canvas.RoundRect (Newx, Newy, Newx + tw + DeadSpace+1, Newy + th + 1, 6, 6);
537 ntSquare :
538 Canvas.Rectangle (Newx, Newy, Newx + tw + DeadSpace+1, Newy + th + 1);
539 ntCircle :
540 Canvas.Ellipse (ct.x - (tw div 2) - 5, ct.y - (th div 2) - 5, ct.x + (tw div 2) + 7, ct.y + (th div 2) + 5);
541 ntNone : begin end;
542 end;
543 end;
544
545 if UseImage then
546 begin
547 if SubList[ShadowId].Selected then
548 Canvas.Rectangle (Newx-7, Newy-8, Newx + tw + 7, Newy + th + 9);
549 Canvas.StretchDraw (Rect (Newx - 6, Newy - 7, Newx + tw + 6, Newy + th + 8), Image);
550 OldStyle := Canvas.Brush.Style;
551 Canvas.Brush.Style := bsClear;
552 Canvas.TextRect(rect (Newx + p, Newy+3, Newx + tw, Newy + th - 1), Newx + p, Newy+1, Name);
553 Canvas.Brush.Style := OldStyle;
554 end
555 else
556 begin
557 case BorderType of
558 ntRound :
559 Canvas.RoundRect (Newx, Newy, Newx+ tw +DeadSpace, Newy+ th, 6, 6);
560 ntSquare :
561 Canvas.Rectangle (Newx, Newy, Newx + tw + DeadSpace, Newy + th);
562 ntCircle :
563 Canvas.Ellipse (ct.x - (tw div 2) - 5, ct.y - (th div 2) - 5, ct.x + (tw div 2) + 7, ct.y + (th div 2) + 5);
564 ntNone : begin end;
565 end;
566 Canvas.TextRect(rect (Newx + p, Newy+1, Newx + tw, Newy + th -1), Newx + p, Newy+1, Name);
567 end;
568 end;
569
570
571 procedure TNode.Paint (const Origin : TPoint);
572 var i, OldWidth : integer;
573 OldFont : TFont; OldColor : TColor;
574 begin
575 OldColor := Canvas.Pen.Color;
576 OldWidth := Canvas.Pen.Width;
577
578 OldFont := TFont.Create;
579 OldFont.Assign (Canvas.Font);
580 Canvas.Font.Assign (Font);
581
582 // ************************
583 for i := 0 to SubList.Count - 1 do
584 PaintIndividualNode (Origin, i);
585
586 Canvas.Font.Assign (OldFont);
587 OldFont.Free;
588
589 Canvas.Pen.Color := OldColor;
590 Canvas.Pen.Width := OldWidth;
591 end;
592
593
594
595 function TNode.IsOnNode (x, y : integer; var SubNode : TSubNode) : boolean;
596 var i : integer;
597 begin
598 Result := False;
599 // Work our way through the shadows
600 for i := 0 to SubList.Count - 1 do
601 begin
602 if (x >= Self.SubList[i].x) and (x <= Self.SubList[i].x + Self.SubList[i].w) and
603 (y >= Self.SubList[i].y) and (y <= Self.SubList[i].y + Self.SubList[i].h) then
604 begin
605 result := True;
606 SubNode := SubList[i];
607 Exit;
608 end;
609 end;
610 end;
611
612
613 procedure TNode.Save (s : TStream);
614 var i : integer;
615 begin
616 WriteString (s, Name);
617 WriteDouble (s, value);
618 s.Write (Status, SizeOf (Status));
619 s.Write (EdgeThickness, SizeOf (EdgeThickness));
620 s.Write (EdgeColor, SizeOf (EdgeColor));
621 s.Write (SelectedEdgeColour, Sizeof (SelectedEdgeColour));
622 s.Write (BorderType, sizeof (BorderType));
623 WriteFont (s, Font);
624 s.Write (UseImage, Sizeof (UseImage));
625 if UseImage then
626 Image.SaveToStream (s);
627
628 SubList.Save (s);
629 s.Write (Padding, SizeOf (Padding)); // Future proof
630 end;
631
632
633 constructor TNode.Read (Canvas : TCanvas; s : TStream);
634 var i : integer;
635 begin
636 Create (Canvas);
637 Self.Canvas := Canvas;
638 Name := ReadStr (s);
639 Value := ReadDouble (s);
640 s.Read (Status, SizeOf (Status));
641 s.Read (EdgeThickness, SizeOf (EdgeThickness));
642 s.Read (EdgeColor, SizeOf (EdgeColor));
643 s.Read (SelectedEdgeColour, Sizeof (SelectedEdgeColour));
644 s.Read (BorderType, sizeof (BorderType));
645 ReadFont (s, Font);
646 s.Read (UseImage, Sizeof (UseImage));
647 if UseImage then
648 begin
649 Image := TBitmap.Create;
650 Image.LoadFromStream (s);
651 end;
652 SubList.Clear;
653 SubList.Read (s, Self);
654 s.Read (Padding, SizeOf (Padding)); // Future proof
655
656 end;
657
658
659
660 // Add a new shadow to the node and give it a nearby but random position
661 function TNode.AddShadow : integer;
662 var SubNode : TSubNode;
663 begin
664 SubNode := TSubNode.Create (Self);
665 SubNode.x := SubList[0].x + random (30);
666 SubNode.x := SubList[0].x + random (30);
667 SubNode.y := SubList[0].y + random (30);
668 SubNode.w := SubList[0].w;
669 SubNode.h := SubList[0].h;
670 result := SubList.Add (SubNode);
671 end;
672
673
674 procedure TNode.UnSelect;
675 var i : integer;
676 begin
677 for i := 0 to SubList.Count - 1 do
678 SubList[i].Selected := False;
679 end;
680
681
682 // Construct the outer rectangle segments which forms the boundary
683 // where arcs start and stop at nodes. s = shadow
684 function TNode.ComputeOuterSegs (SubNode : TSubNode) : TSquareSegs;
685 var tx, ty, tw, th : integer;
686 begin
687 tx := SubNode.x;
688 ty := SubNode.y;
689 tw := SubNode.w;
690 th := SubNode.h;
691
692 Result[1].p.x := tx - NODE_ARC_DEADSPACE;
693 Result[1].p.y := ty - NODE_ARC_DEADSPACE;
694 Result[1].q.x := tx + tw + NODE_ARC_DEADSPACE;
695 Result[1].q.y := ty - NODE_ARC_DEADSPACE;
696
697 Result[2].p.x := tx + tw + NODE_ARC_DEADSPACE;
698 Result[2].p.y := ty - NODE_ARC_DEADSPACE;
699 Result[2].q.x := tx + tw + NODE_ARC_DEADSPACE;
700 Result[2].q.y := ty + th + NODE_ARC_DEADSPACE;
701
702 Result[3].p.x := tx + tw + NODE_ARC_DEADSPACE;
703 Result[3].p.y := ty + th + NODE_ARC_DEADSPACE;
704 Result[3].q.x := tx - NODE_ARC_DEADSPACE;
705 Result[3].q.y := ty + th + NODE_ARC_DEADSPACE;
706
707 Result[4].p.x := tx - NODE_ARC_DEADSPACE;
708 Result[4].p.y := ty + th + NODE_ARC_DEADSPACE;
709 Result[4].q.x := tx - NODE_ARC_DEADSPACE;
710 Result[4].q.y := ty - NODE_ARC_DEADSPACE;
711 end;
712
713
714 // Arc visibly start and end point are just outside the nodes, we compute
715 // the point where an arc emerges from a node here. Pt is
716 // the computed point and EndPt is the end of the arc
717 function TNode.ComputeLaunchPoint (SubNode : TSubNode; EndPt : TPoint) : TPoint;
718 var v : TLineSeg; Found : Boolean; i : integer; SquareSegs : TSquareSegs;
719 begin
720 // Define a straight line segment from Node to End Pt
721 v.p.x := SubNode.x + (SubNode.w div 2);
722 v.p.y := SubNode.y + (SubNode.h div 2);
723
724 v.q.x := EndPt.x;
725 v.q.y := EndPt.y;
726 // Compute where the point where the segment will start and terminate
727 // Gather the boundary segments lines around the node
728 SquareSegs := ComputeOuterSegs (SubNode);
729 Found := False;
730 for i := 1 to 4 do
731 if SegmentIntersects (SquareSegs[i], v, Result) then
732 begin
733 Found := true;
734 exit;
735 end;
736
737 if not Found then
738 begin
739 // if no intersection then use node centres
740 Result.x := SubNode.x;
741 Result.y := SubNode.y;
742 end;
743 end;
744
745
746 procedure TNode.SetNodeColor (const c : TColor);
747 begin
748 if EdgeColor <> c then
749 begin
750 EdgeColor := c;
751 end;
752 end;
753
754
755 function TNode.GetNodeColor : TColor;
756 begin
757 result := EdgeColor;
758 end;
759
760
761 procedure TNode.SetTextColor (const c : TColor);
762 begin
763 if Font.Color <> c then
764 begin
765 Font.Color := c;
766 end;
767 end;
768
769
770 function TNode.GetTextColor : TColor;
771 begin
772 result := Font.Color;
773 end;
774
775
776
777 // -------------------------------------------------------------------------
778 // Node list wrapper around a TList
779 // -------------------------------------------------------------------------
780
781
782 constructor TNodeList.Create;
783 begin
784 GlobalFloatingNodeColor := FLOATING_NODE_EDGE_COLOR;
785 GlobalBoundaryNodeColor := BOUNDARY_NODE_EDGE_COLOR;
786 GlobalTextColor := NODE_TEXT_COLOR;
787 inherited Create;
788 end;
789
790
791 constructor TNodeList.Clone (r : TNodeList);
792 var i : Integer; ms : TMemoryStream;
793 begin
794 inherited Create;
795 ms := TMemoryStream.Create;
796 try
797 r.Save (ms);
798 ms.position := 0;
799 self.Read (ms, r[0].Canvas);
800 finally
801 ms.Free;
802 end;
803 end;
804
805
806 function TNodeList.Get (Index : integer) : TNode;
807 begin
808 result := TNode(inherited Get(index));
809 end;
810
811
812 procedure TNodeList.Put (Index : integer; Item : TNode);
813 begin
814 inherited Put (Index, Item);
815 end;
816
817
818 function TNodeList.Add (Item : TNode) : integer;
819 begin
820 result := inherited Add (Item);
821 end;
822
823
824 procedure TNodeList.Delete (Index : Integer);
825 var i : integer;
826 begin
827 Items[Index].Free;
828 Items[Index] := nil;
829 inherited Delete (Index);
830 end;
831
832
833 destructor TNodeList.Destroy;
834 var i : integer;
835 begin
836 for i := 0 to Count - 1 do
837 Items[i].Free;
838 inherited Destroy;
839 end;
840
841
842 procedure TNodeList.Save (s : TStream);
843 var c, i : integer;
844 begin
845 s.Write (GlobalFloatingNodeColor, sizeof (GlobalFloatingNodeColor));
846 s.Write (GlobalBoundaryNodeColor, sizeof (GlobalBoundaryNodeColor));
847 s.Write (GlobalTextColor, sizeof (GlobalTextColor));
848 c := Count;
849 s.Write (c, SizeOf (c));
850 for i := 0 to c - 1 do
851 Items[i].Save (s);
852 end;
853
854
855 procedure TNodeList.Read (s : TStream; Canvas : TCanvas);
856 var c, i : integer;
857 begin
858 s.Read (GlobalFloatingNodeColor, sizeof (GlobalFloatingNodeColor));
859 s.Read (GlobalBoundaryNodeColor, sizeof (GlobalBoundaryNodeColor));
860 s.Read (GlobalTextColor, sizeof (GlobalTextColor));
861 s.Read (c, SizeOf (c));
862 for i := 0 to c - 1 do
863 Add (TNode.Read (Canvas, s));
864 end;
865
866
867 function TNodeList.Find (str : string; var Index : integer) : boolean;
868 var i : integer;
869 begin
870 result := False;
871 for i := 0 to Count - 1 do
872 if Items[i].Name = str then
873 begin
874 result := True;
875 Index := i;
876 Exit;
877 end;
878 end;
879
880
881 // Locate node 'Node'. Returns true if found, with Index indicating the position in
882 // the node list and Shadow indicating the shadow node where the coords apply
883 function TNodeList.FindNode (x, y : integer; var SubNode : TSubNode) : Boolean;
884 var i : integer;
885 begin
886 result := False;
887 for i := 0 to Count - 1 do
888 begin
889 if Items[i].IsOnNode (x, y, SubNode) then
890 begin
891 result := True;
892 Exit;
893 end;
894 end;
895 end;
896
897
898 // Render all the nodes on to the Cavnas
899 procedure TNodeList.Paint (const Origin : TPoint);
900 var i : integer;
901 begin
902 for i := 0 to Count - 1 do
903 (Items[i] as TNode).Paint (Origin);
904 end;
905
906
907 procedure TNodeList.SetGlobalFloatingNodeColor (c : TColor);
908 var i : integer;
909 begin
910 GlobalFloatingNodeColor := c;
911 for i := 0 to Count - 1 do
912 if (Items[i] as TNode).Status = nsFloating then
913 (Items[i] as TNode).SetNodeColor (c);
914 end;
915
916
917 function TNodeList.GetGlobalFloatingNodeColor : TColor;
918 begin
919 result := GlobalFloatingNodeColor;
920 end;
921
922
923 procedure TNodeList.SetGlobalBoundaryNodeColor (c : TColor);
924 var i : integer;
925 begin
926 GlobalBoundaryNodeColor := c;
927 for i := 0 to Count - 1 do
928 if (Items[i] as TNode).Status = nsBoundary then
929 (Items[i] as TNode).SetNodeColor (c);
930 end;
931
932
933 function TNodeList.GetGlobalBoundaryNodeColor : TColor;
934 begin
935 result := GlobalBoundaryNodeColor;
936 end;
937
938
939 function TNodeList.GetGlobalTextColor : TColor;
940 begin
941 result := GlobalTextColor;
942 end;
943
944
945 procedure TNodeList.SetGlobalTextColor (c : TColor);
946 var i : integer;
947 begin
948 GlobalTextColor := c;
949 for i := 0 to Count - 1 do
950 (Items[i] as TNode).SetTextColor (c);
951 end;
952
953
954 end.