ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JDesigner/uNetPanel.pas
Revision: 1.1.1.1 (vendor branch)
Committed: Mon Dec 10 19:29:12 2001 UTC (14 years, 8 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 uNetPanel;
2
3 // Designer Panel component.
4 // This can be used to build your own designer forms. Just install it into
5 // the Delphi component palette.
6
7 interface
8
9 uses
10 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
11 ExtCtrls, stdctrls, Menus, uNetwork, uNodeList, uEdgeList, uNetUtils,
12 ufEdgeProp, uNetObjList, ufNodeProp, uSymbolList, uCommon;
13
14 type
15 TMouseState = (mDown, mUp);
16
17 TNodeHit = procedure (Sender: TObject; var Node : TNode) of object;
18 TEdgeHit = procedure (Sender: TObject; var Edge : TEdge) of object;
19
20 TActionMode = (sSelect, sPanning, sUU, sBiU, sUBi, sBiBi, sAddingNode,
21 sMovingNode, sHandleMoving, sMoveArcCentre, sAddText, sEditingText, sNetObjectMoving);
22
23 TDropFilesEvent = procedure(Sender: TObject; X, Y: integer; AFiles: TStrings) of object;
24
25 TNetPanel = class(TCustomPanel)
26 private
27 { Private declarations }
28 FNetwork : TNetwork;
29 FActionMode : TActionMode;
30 FOrigin : TPoint;
31 OldX, OldY : integer;
32 TextBox : TEdit;
33 DoubleClicked : boolean;
34
35 SelectedNetObj : TNetObj;
36 FNodeHit : TNodeHit;
37 FEdgeHit : TEdgehit;
38
39 SourceNode1, SourceNode2, DestNode1, DestNode2 : TSubNode;
40 FNodePopupMenu : TPopupMenu;
41 FEdgePopupMenu : TPopupMenu;
42 ShadowItem : TMenuItem;
43 FloatingMenu, BoundaryMenu : TMenuItem;
44 StatusSubMenu : TMenuItem;
45 MouseX, MouseY : integer;
46
47 ImageList : TImageList;
48
49 fOnDropFiles: TDropFilesEvent;
50 procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
51
52 procedure AdjustBezierHandles (SubNode : TSubNode);
53 procedure AdjustMovedBezierHandle;
54 procedure WM_ERASEBKGND (var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
55 procedure NodeHit (Node : TNode);
56 procedure EdgeHit (Edge : TEdge);
57 procedure SetActionMode (m : TActionMode);
58 function GetActionMode : TActionMode;
59 procedure SetNetWork (Network : TNetwork);
60 procedure OnPopUpMenu (Sender : TObject);
61 procedure OnCreateShadow (Sender : TObject);
62 procedure OnChangeName (Sender : TObject);
63 procedure OnNodeProperties (Sender : TObject);
64 procedure OnChangeEdge (Sender : TObject);
65 procedure OnEdgeProperties (Sender: TObject);
66 procedure OnSetBoundary (Sender : TObject);
67 procedure OnSetFloating (Sender : TObject);
68
69 procedure OnTextBoxExit (Sender : TObject);
70 procedure OnTextBoxKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
71 procedure GetUserText (x, y, vx, vy : integer; NewObj : boolean);
72
73 procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
74 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
75 procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
76
77 procedure DblClick; override;
78 procedure Resize (Sender : TObject);
79 protected
80 { Protected declarations }
81 procedure CreateWindowHandle (const Params: TCreateParams); override;
82 public
83 { Public declarations }
84 Bitmap : TBitmap;
85 HScrollBar, VScrollBar : TScrollBar;
86 CurrentObject : TObjectInfo;
87
88 function ConvertMouseToVirtualCoordinates (MousePos : TPoint) : TPoint;
89 function IsMouseOverObject (vx, vy : integer; var ObjInfo : TObjectInfo) : TObjectType;
90 function IsMouseOnArcCentre (x, y : integer) : Boolean;
91 function IsMouseOnHandle (x, y : integer; var CurrentSubArc : TCurrentSubArc;
92 var handleID : TCurrentSelectedHandle; var hcoords : TPoint) : boolean;
93
94 function IsOnNode (x, y : integer; var SubNode : TSubNode) : boolean; overload;
95 function IsOnEdge (x, y : integer; var Index : integer) : boolean; overload;
96 function IsOnEdge (x, y : integer; var Edge : TEdge) : boolean; overload;
97
98 function IsOnNetObject (x, y : integer; var NetObj : TNetObj) : Boolean;
99
100 procedure ScrollBarOnScroll (Sender : TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
101 constructor Create (AOwner : TComponent); override;
102 destructor Destroy; override;
103 procedure CreateParams (var Params: TCreateParams);
104 procedure Clear;
105 procedure Paint; override;
106
107 function AddNode (Name : string) : integer; overload;
108 function AddNode (Name : string; x, y : integer) : integer; overload;
109 function AddNode (Name : string; x, y, w, h : integer) : integer; overload;
110 procedure AddNodes;
111 function GetUniqueNodeName : string;
112 procedure DeleteNode (Node : TNode);
113 procedure DeleteEdge (Edge : TEdge);
114 procedure StartConnectingUU;
115 procedure StartConnectingBiU;
116 procedure StartConnectingUBi;
117 procedure StartConnectingBiBi;
118 procedure StandBy;
119 function GetCurrentEdge : TEdge;
120 procedure AddUniUniArcMouseDown (vx, vy : integer);
121 procedure AddBiUniArcMouseDown (x, y : integer);
122 procedure AddUniBiArcMouseDown (x, y : integer);
123 procedure AddBiBiArcMouseDown (x, y : integer);
124
125 procedure Read (FileName : string);
126 procedure Save (FileName : string);
127
128 procedure PrepareUndo;
129 procedure ApplyUndo;
130 function UndoStackEmpty : boolean;
131 procedure EmptyUndoStack;
132 protected
133 procedure CreateWnd; override;
134 procedure DestroyWnd; override;
135 published
136 { Published declarations }
137 property ActionMode : TActionMode read GetActionMode write SetActionMode;
138 property Network : TNetwork read FNetwork write SetNetwork;
139
140 property OnMouseDown;
141 property OnMouseUp;
142 property OnMouseMove;
143 property OnExit;
144 property OnEnter;
145 property Align;
146 property ShowHint;
147 property PopupMenu;
148 property DragKind;
149 property DragMode;
150 property DragCursor;
151
152 property OnDropFiles: TDropFilesEvent read fOnDropFiles write fOnDropFiles;
153 property OnNodeHit : TNodeHit read FNodeHit write FNodeHit;
154 property OnEdgeHit : TEdgeHit read FEdgeHit write FEdgeHit;
155 end;
156
157 // Node Property Editor
158
159 procedure Register;
160
161 implementation
162
163 USes ShellAPI;
164
165 {$R net.res}
166
167 var FScale : double = 1.0;
168 x : boolean;
169
170
171 // Translates a mouse coordinate to virtual coordinate. The routine
172 // assumes that the input value has been translated from the screen
173 // to the virtual canvas.
174 function ScreenToVirtual (x : integer) : integer;
175 begin
176 result := trunc (x/FScale);
177 end;
178
179 function VirtualToScreen (vx : integer) : integer;
180 begin
181 result := trunc (vx*FScale);
182 end;
183
184
185 // ----------------------------------------------------------------------
186
187
188 //procedure TMyPaintBox.WM_ERASEBKGND (var Message: TWmEraseBkgnd);
189 //begin
190 // Message.result := 1;
191 //end;
192
193
194 // ---------------------------------------------------------------------------
195
196
197 procedure TNetPanel.WM_ERASEBKGND (var Message: TWmEraseBkgnd);
198 begin
199 Message.result := 1;
200 end;
201
202
203 procedure TNetPanel.WMDropFiles (var Msg: TMessage);
204 var
205 i, iNumberDropped: integer;
206 szPathName: array[0..260] of char;
207 Point: TPoint;
208 FilesList: TStringList;
209 begin
210 try
211 if Assigned(fOnDropFiles) then begin
212 FilesList := TStringList.Create;
213 try
214 iNumberDropped := DragQueryFile(THandle(Msg.wParam), Cardinal(-1),
215 nil, 0);
216 DragQueryPoint(THandle(Msg.wParam), Point);
217
218 for i := 0 to iNumberDropped - 1 do begin
219 DragQueryFile(THandle(Msg.wParam), i, szPathName,
220 SizeOf(szPathName));
221 FilesList.Add(szPathName);
222 end;
223 fOnDropFiles(Self, Point.X, Point.Y, FilesList);
224 finally
225 FilesList.Free;
226 end;
227 end;
228 finally
229 Msg.Result := 0;
230 DragFinish(THandle(Msg.wParam));
231 end;
232 end;
233
234
235 procedure TNetPanel.CreateWnd;
236 begin
237 inherited;
238 DragAcceptFiles(Handle, TRUE);
239 end;
240
241
242 procedure TNetPanel.DestroyWnd;
243 begin
244 DragAcceptFiles(Handle, FALSE);
245 inherited;
246 end;
247
248
249 constructor TNetPanel.Create (AOwner : TComponent);
250 var x : TBitmap;
251 begin
252 inherited Create (AOwner);
253 ControlStyle := [csOpaque, csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
254 OnResize := Resize;
255 BevelOuter := bvNone;
256 Height := 100;
257 Width := 100; // Give it some size so that is doesn't looked squashed up
258
259 Bitmap := TBitmap.Create;
260 ImageList := TImageList.Create(AOwner);
261 x := TBitmap.Create(); x.LoadFromResourceName(HInstance, 'REDBLOB'); ImageList.AddMasked(x, clWhite);
262 x := TBitmap.Create(); x.LoadFromResourceName (HInstance, 'GREENBLOB'); ImageList.AddMasked(x, clWhite);
263 x := TBitmap.Create(); x.LoadFromResourceName (HInstance, 'BLUEBLOB'); ImageList.AddMasked(x, clWhite);
264
265 Screen.Cursors[1] := LoadCursor(HInstance, 'Wand1');
266 Screen.Cursors[2] := LoadCursor(HInstance, 'Wand2');
267 Screen.Cursors[3] := LoadCursor(HInstance, 'Wand3');
268
269 HScrollBar := TScrollBar.Create (Self);
270 HScrollBar.Parent := Self;
271 HScrollBar.Align := alBottom;
272 HScrollBar.OnScroll := ScrollBarOnScroll;
273 HScrollBar.Max := 1000;
274 HScrollBar.LargeChange := 1;
275
276 vScrollBar := TScrollBar.Create (Self);
277 vScrollBar.Parent := Self;
278 vScrollBar.Kind := sbVertical;
279 vScrollBar.Align := alRight;
280 vScrollBar.OnScroll := ScrollBarOnScroll;
281 vScrollBar.Max := 1000;
282 vScrollBar.LargeChange := 1;
283
284 FActionMode := sSelect;
285 FOrigin := point (0, 0);
286 TextBox := TEdit.Create (Self);
287 TextBox.Parent := Self;
288 TextBox.Width := 360;
289 TextBox.Top := 50;
290 TextBox.Left := 50;
291 TextBox.OnExit := OnTextBoxExit;
292 TextBox.OnKeyDown := OnTextBoxKeyDown;
293 TextBox.BorderStyle := bsNone;
294 TextBox.Visible := False;
295
296 Caption := '';
297
298 ActionMode := sSelect;
299 DoubleClicked := False;
300
301 ShadowItem := NewItem ('Create Shadow', ShortCut (0, []), False, True, OnCreateShadow, 0, '');
302 BoundaryMenu := NewItem ('Boundary Node...', ShortCut (0, []), False, True, OnSetBoundary, 0, '');
303 BoundaryMenu.RadioItem := True;
304 FloatingMenu := NewItem ('Floating Node...', ShortCut (0, []), False, True, OnSetFloating, 0, '');
305 FloatingMenu.RadioItem := True;
306 StatusSubMenu := NewSubMenu ('Set Node Status...', ShortCut (0, []), 'StatusMenu', [BoundaryMenu, FloatingMenu], True);
307
308
309 FNodePopupMenu := NewPopupMenu(Self, 'NodePopup', paLeft,
310 true, [StatusSubMenu,
311 ShadowItem,
312 NewLine,
313 NewItem ('Properties', ShortCut (0, []), False, True, OnNodeProperties, 0, '')]);
314
315 FEdgePopupMenu := NewPopupMenu(Self, 'EdgePopup', paLeft,
316 true, [NewItem ('Properties...', ShortCut (0, []), False, True, OnEdgeProperties, 0, ''),
317 NewLine,
318 NewItem ('Change Edge Name', ShortCut (0, []), False, True, OnChangeEdge, 0, '')]);
319
320 //FPopupMenu.AutoPopup := True;
321 //FPopupMenu.OnPopUp := OnPopupMenu;
322 //PopupMenu := FPopupMenu;
323 //if csDesigning in ComponentState then
324 // MyResize (nil);
325 end;
326
327
328 destructor TNetPanel.Destroy;
329 begin
330 Bitmap.Free;
331 ShadowItem.Free;
332 BoundaryMenu.Free;
333 FloatingMenu.Free;
334 StatusSubMenu.Free;
335 inherited Destroy;
336 end;
337
338
339 procedure TNetPanel.CreateWindowHandle (const Params: TCreateParams);
340 begin
341 inherited CreateWindowHandle (Params);
342 //TextBox.Parent := Parent; // Need the handle of GraphPanel, well here it is!
343 end;
344
345
346 procedure TNetPanel.CreateParams (var Params: TCreateParams);
347 begin
348 inherited;
349 with Params do begin
350 WindowClass.style := WindowClass.style and not (CS_HRedraw or CS_VRedraw);
351 end;
352 end;
353
354
355 procedure TNetPanel.Resize (Sender : TObject);
356 begin
357 Bitmap.Height := Height - hScrollBar.Height;
358 Bitmap.Width := Width - vScrollBar.Width;
359 if not (csDesigning in ComponentState) then
360 Paint;
361 end;
362
363
364 procedure TNetPanel.Paint;
365 var dest : TRect;
366 begin
367 if csDesigning in ComponentState then
368 begin
369 // Fill the area within the scroll bars
370 Canvas.FillRect (rect (0, 0, Width - vScrollBar.Width, Height - hScrollBar.Height));
371 end
372 else
373 if Network <> nil then
374 begin
375 Network.Paint (FOrigin, Bitmap.Width, Bitmap.Height);
376 dest := rect (0, 0, Width - vScrollBar.Width, Height - hScrollBar.Height);
377 Canvas.CopyRect (dest, Bitmap.Canvas, rect (0, 0, Bitmap.Width, Bitmap.Height));
378 end;
379 end;
380
381
382 procedure TNetPanel.ScrollBarOnScroll (Sender : TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
383 begin
384 FOrigin := point (hScrollBar.Position, vScrollBar.Position);
385 Paint;
386 end;
387
388
389 function TNetPanel.ConvertMouseToVirtualCoordinates (MousePos : TPoint) : TPoint;
390 var pt : TPoint;
391 begin
392 pt := ScreenToClient(Mouse.CursorPos);
393 result.x := ScreenToVirtual (pt.x {- vScrollBar.Width}) + HScrollBar.Position;
394 result.y := ScreenToVirtual (pt.y) + VScrollBar.position;
395 end;
396
397
398 procedure TNetPanel.OnTextBoxExit (Sender : TObject);
399 var str : string;
400 begin
401 str := TextBox.Text;
402 TextBox.Visible := False;
403 ActionMode := sSelect;
404 (SelectedNetObj as TNetTextObj).Text := str;
405 Cursor := crDefault;
406 Paint;
407 end;
408
409
410 procedure TNetPanel.OnTextBoxKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
411 var str : string;
412 begin
413 if Key = VK_RETURN then
414 begin
415 str := TextBox.Text;
416 TextBox.Visible := False;
417 ActionMode := sSelect;
418 (SelectedNetObj as TNetTextObj).Text := str;
419 Cursor := crDefault;
420 Paint;
421 end;
422 end;
423
424
425 procedure TNetPanel.GetUserText (x, y, vx, vy : integer; NewObj : boolean);
426 var TextObj : TNetTextObj; pt : TPoint;
427 begin
428 // TextBox will be positioned relative to form so we must adjust the
429 // coords when positioning the edit box
430
431 //pt := (Parent as TForm).ScreenToClient(ClientToScreen(point (x, y)));
432 pt := ScreenToClient(ClientToScreen(point (x, y)));
433 TextBox.Left := pt.x;
434 TextBox.Top := pt.y-7;
435 if NewObj then
436 begin
437 TextObj := TNetTextObj.Create (Bitmap.Canvas);
438 TextObj.Font.Color := clBlack;
439 //TextObj.Font.Assign (Canvas.Font);
440 Network.ObjectList.Add (TextObj);
441 end
442 else TextObj := CurrentObject.NetObj as TNetTextObj;
443
444 TextBox.Text := TextObj.Text;
445 // Size the textbox to the limits of the containing panel window
446 TextBox.Width := Width - x-20;
447 TextBox.Visible := True;
448 TextBox.SetFocus;
449 ActionMode := sEditingText;
450
451 TextBox.Font.Assign (TextObj.Font);
452 TextObj.vx := vx;
453 TextObj.vy := vy-7;
454 SelectedNetObj := TextObj;
455 end;
456
457
458 procedure TNetPanel.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
459 var Edge : TEdge; vx, vy, Id : integer;
460 pt : TPoint; SubNode : TSubNode;
461 begin
462 inherited MouseDown (Button, Shift, X, Y);
463
464 // Don't let mousedown code execute if we've just processed a double click
465 if DoubleClicked then
466 begin
467 DoubleClicked := False;
468 exit;
469 end;
470
471 if Network = nil then Exit;
472
473 vx := ScreenToVirtual (x{ - vScrollBar.Width}) + HScrollBar.Position;
474 vy := ScreenToVirtual (y) + VScrollBar.position;
475
476 if Button = mbRight then
477 begin
478 if IsOnNode (vx, vy, SubNode) then
479 begin
480 CurrentObject.SubNode := SubNode;
481 CurrentObject.ObjType := oNode;
482 CurrentObject.vx := vx; CurrentObject.vy := vy;
483
484 if CurrentObject.SubNode.ParentNode.EdgeThickness > 1 then
485 begin
486 FloatingMenu.Checked := False;
487 BoundaryMenu.Checked := True;
488 end
489 else
490 begin
491 FloatingMenu.Checked := True;
492 BoundaryMenu.Checked := False;
493 end;
494 FNodePopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
495 end;
496 if IsOnEdge (vx, vy, Edge) then
497 begin
498 CurrentObject.Edge := Edge;
499 CurrentObject.ObjType := oEdge;
500 CurrentObject.vx := vx; CurrentObject.vy := vy;
501 FEdgePopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
502 end;
503
504 MouseX := vx;
505 MouseY := vy;
506 Exit;
507 end;
508
509 if (Button = mbLeft) then
510 case ActionMode of
511 sPanning :
512 begin
513 OldX := vx; OldY := vy;
514 Exit;
515 end;
516
517 sUU : begin PrepareUndo; AddUniUniArcMouseDown (vx, vy); end;
518 sBiU : begin PrepareUndo; AddBiUniArcMouseDown (vx, vy); end;
519 sUBi : begin PrepareUndo; AddUniBiArcMouseDown (vx, vy); end;
520 sBiBi : begin PrepareUndo; AddBiBiArcMouseDown (vx, vy); end;
521
522 sAddingNode :
523 begin
524 Network.UnSelect;
525 PrepareUndo;
526 AddNode (GetUniqueNodeName, vx, vy);
527 Paint;
528 Exit;
529 end;
530
531 sAddText :
532 begin
533 // Display TextBox and accept user input
534 PrepareUndo;
535 GetUserText (x, y, vx, vy, True);
536 end;
537
538 sEditingText :
539 begin
540 OnTextBoxExit (nil);
541 end;
542
543 sSelect :
544 case IsMouseOverObject (vx, vy, CurrentObject) of
545 oNode :
546 begin
547 if not (ssShift in Shift) then
548 Network.UnSelect;
549
550 // Call the Nodehit event handler
551 Nodehit (CurrentObject.SubNode.ParentNode);
552 CurrentObject.SubNode.Selected := True;
553 CurrentObject.SubNode.OldX := vx;
554 CurrentObject.SubNode.OldY := vy;
555 ActionMode := sMovingNode;
556 Paint;
557 Exit;
558 end;
559
560 oEdge :
561 begin
562 Network.UnSelect;
563 Edge := CurrentObject.Edge;
564 Edge.Selected := not Edge.Selected;
565 Edgehit (Edge);
566 Paint;
567 Exit;
568 end;
569
570 oArcHandle :
571 begin
572 OldX := vx - CurrentObject.HandleCoords.x;
573 OldY := vy - CurrentObject.HandleCoords.y;
574 ActionMode := sHandleMoving;
575 end;
576
577 oArcCentre :
578 begin
579 OldX := x;
580 OldY := y;
581 ActionMode := sMoveArcCentre;
582 end;
583
584 oOverText :
585 begin
586 OldX := vx - CurrentObject.NetObj.vx;
587 OldY := vy - CurrentObject.NetObj.vy;
588 ActionMode := sNetObjectMoving;
589 end;
590
591 oNone :
592 begin
593 // Mouse is over empty space, deselect any selected object
594 Network.UnSelect;
595 ActionMode := sPanning;
596 OldX := vx; OldY := vy; //DispManStatus := sPanning;
597 Paint;
598 end;
599 end;
600 end;
601 Paint;
602 end;
603
604
605 procedure TNetPanel.MouseMove (Shift: TShiftState; X, Y: Integer);
606 var vx, vy, i, j, dx, dy : integer; Node : TNode;
607 begin
608 inherited MouseMove (Shift, X, Y);
609 if Network = nil then exit;
610
611 // Adjust for the scroll bars
612 x := x{ - vScrollBar.Width};
613
614 vx := ScreenToVirtual (x) + HScrollBar.position;
615 vy := ScreenToVirtual (y) + VScrollBar.position;
616
617 case ActionMode of
618 sMovingNode :
619 begin
620 // Find the distance that the mouse has moved
621 dx := vx - CurrentObject.SubNode.OldX;
622 dy := vy - CurrentObject.SubNode.OldY;
623 // Update the old node coords as we'll need them next time to compute the distance
624 CurrentObject.SubNode.OldX := vx;
625 CurrentObject.SubNode.OldY := vy;
626 if CurrentObject.SubNode.Selected then
627 begin
628 CurrentObject.SubNode.x := CurrentObject.SubNode.x + dx;
629 CurrentObject.SubNode.y := CurrentObject.SubNode.y + dy;
630 AdjustBezierHandles (CurrentObject.SubNode);
631 end;
632 Paint;
633 end;
634
635 sHandleMoving :
636 begin
637 // Each subarc has two handles, h1 and h2, update which ever is being moved }
638 case CurrentObject.CurrentSelectedHandle of
639 1 : begin
640 CurrentObject.Edge.SubArcs[CurrentObject.CurrentSubArc].h1.x := vx - OldX;
641 CurrentObject.Edge.SubArcs[CurrentObject.CurrentSubArc].h1.y := vy - OldY;
642 end;
643 2 : begin
644 CurrentObject.Edge.SubArcs[CurrentObject.CurrentSubArc].h2.x := vx - OldX;
645 CurrentObject.Edge.SubArcs[CurrentObject.CurrentSubArc].h2.y := vy - OldY;
646 end;
647 else
648 showmessage ('Currently Selected Handle has incorrect value:' + inttostr (CurrentObject.CurrentSelectedhandle));
649 end;
650 AdjustMovedBezierHandle;
651 Paint;
652 end;
653
654 sMoveArcCentre :
655 begin
656 CurrentObject.Edge.AdjustArcCentres (vx, vy);
657 Paint;
658 end;
659
660 sNetObjectMoving :
661 begin
662 CurrentObject.NetObj.vx := vx - OldX;
663 CurrentObject.NetObj.vy := vy - OldY;
664 Paint;
665 end;
666
667 sPanning :
668 begin
669 hScrollbar.position := hScrollbar.position + ((vx - OldX) div 2);
670 vScrollbar.position := vScrollbar.position + ((vy - OldY) div 2);
671 FOrigin := point (hScrollBar.Position, vScrollBar.Position);
672 OldX := vx; OldY := vy;
673 Paint;
674 Exit;
675 end;
676 end;
677 end;
678
679
680 procedure TNetPanel.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
681 var i : integer;
682 begin
683 inherited MouseUp (Button, Shift, X, Y);
684 case FActionMode of
685 sAddingNode : begin Paint; end;
686 sUU, sUBi, sBiU, sBiBi : begin Paint; end;
687 sMovingNode :
688 begin
689 //for i := 0 to Network.NodeList.Count - 1 do
690 // if Network.NodeList[i].Selected then
691 AdjustBezierHandles (CurrentObject.SubNode);
692 FActionMode := sSelect;
693 Paint;
694 end;
695 sAddText :
696 begin
697 //TextBox.Free;
698 end;
699 sEditingText :
700 begin
701 end;
702 else
703 ActionMode := sSelect;
704 end;
705 end;
706
707
708 procedure TNetPanel.DblClick;
709 var vp : TPoint; x, y, vx, vy : integer;
710 begin
711 DoubleClicked := True; // A bit of a hack !
712 inherited DblClick;
713 if ActionMode = sSelect then
714 begin
715 vp := ConvertMouseToVirtualCoordinates (Mouse.CursorPos);
716 case IsMouseOverObject (vp.x, vp.y, CurrentObject) of
717 oNode :
718 begin
719
720 end;
721 oOverText :
722 begin
723 FOrigin := point (hScrollBar.Position, vScrollBar.Position);
724 vx := CurrentObject.NetObj.vx;
725 vy := CurrentObject.NetObj.vy;
726 x := vx + FOrigin.x;
727 y := vy + FOrigin.y;
728 if CurrentObject.NetObj is TNetTextObj then
729 GetUserText (x, y+7, vx, vy+7, False);
730 end;
731 end;
732 end;
733 end;
734
735
736 procedure TNetPanel.SetActionMode (m : TActionMode);
737 begin
738 FActionMode := m;
739 end;
740
741
742 function TNetPanel.GetActionMode : TActionMode;
743 begin
744 result := FActionMode;
745 end;
746
747
748 procedure TNetPanel.SetNetwork (Network : TNetwork);
749 begin
750 if Network <> nil then
751 begin
752 FNetwork := Network;
753 FNetwork.Canvas := Bitmap.Canvas;
754 end;
755 end;
756
757
758 procedure TNetPanel.OnPopUpMenu (Sender : TObject);
759 var Shadow : integer;
760 begin
761 //ShadowNode := nil;
762 // MouseX and MouseY come from the pImage MouseDown event
763 //if IsOnNode (MouseX, MouseY, ShadowNode, Shadow) then
764 // ShadowItem.Enabled := True
765 //else ShadowItem.Enabled := False;
766 end;
767
768
769 procedure TNetPanel.OnCreateShadow (Sender : TObject);
770 var sh, i, j, Count, EdgeSeg : integer; Edge : TEdge; Direction : TDirection;
771 ShadowNode : TNode;
772 begin
773 if CurrentObject.ObjType = oNode then
774 begin
775 // Look for edges ShadowNode is connected to and allocate edges
776 // to appropriate shadows
777 Count := 0;
778 sh := CurrentObject.SubNode.ParentNode.AddShadow;
779 {for i := 0 to Network.EdgeList.Count - 1 do
780 begin
781 if Network.EdgeList[i].FindNode (ShadowNode, Edge, Direction, EdgeSeg) then
782 begin
783 case Direction of
784 dSrc : Edge.src ShadowList[EdgeSeg] := sh;
785 dDest : Edge.dest ShadowList[EdgeSeg] := sh;
786 end;
787 Inc (Count);
788 end;
789 end;}
790 Paint;
791 end;
792 end;
793
794
795 procedure TNetPanel.OnChangeName (Sender : TObject);
796 begin
797 if CurrentObject.ObjType = oNode then
798 begin
799 CurrentObject.SubNode.ParentNode.Name := InputBox('Change Node Name', 'Enter New Node Name', CurrentObject.SubNode.ParentNode.Name);
800 CurrentObject.SubNode.ParentNode.SetBoundingBox (CurrentObject.SubNode);
801 Paint;
802 end;
803 end;
804
805
806
807 procedure TNetPanel.OnNodeProperties (Sender : TObject);
808 var i : integer;
809 begin
810 frmNodeProp := TfrmNodeProp.Create (nil);
811 try
812 frmNodeProp.NodeList := TNodeList.Clone (Network.NodeList);
813 frmNodeProp.NodeId := Network.NodeList.IndexOf (CurrentObject.SubNode.ParentNode);
814
815 frmNodeProp.EdtNodeName.Text := CurrentObject.SubNode.ParentNode.Name;
816 frmNodeProp.EdtNodeValue.Text := floattostr (CurrentObject.SubNode.ParentNode.Value);
817 if CurrentObject.SubNode.ParentNode.Status = nsBoundary then
818 frmNodeProp.rdoFixed.checked := True
819 else frmNodeProp.rdoFloating.checked := True;
820
821 case CurrentObject.SubNode.ParentNode.BorderType of
822 ntRound : frmNodeProp.rdoRoundRect.Checked := True;
823 ntSquare : frmNodeProp.rdoSquareRect.Checked := True;
824 ntCircle : frmNodeProp.rdoCircle.Checked := True;
825 ntNone : frmNodeProp.rdoNoRect.Checked := True;
826 end;
827
828 if frmNodeProp.ShowModal = mrOK then
829 begin
830 for i := 0 to frmNodeProp.NodeList.Count - 1 do
831 begin
832 Network.NodeList[i].Name := frmNodeProp.NodeList[i].Name;
833 Network.NodeList[i].value := frmNodeProp.NodeList[i].value;
834 Network.NodeList[i].Status := frmNodeProp.NodeList[i].Status;
835 Network.NodeList[i].BorderType := frmNodeProp.NodeList[i].BorderType;
836
837 if frmNodeProp.NodeList[i].UseImage then
838 begin
839 if Network.NodeList[i].Image = nil then
840 Network.NodeList[i].Image := TBitmap.Create;
841 Network.NodeList[i].Image.Assign (frmNodeProp.NodeList[i].Image);
842 Network.NodeList[i].UseImage := True;
843 end
844 else
845 begin
846 Network.NodeList[i].UseImage := False;
847 Network.NodeList[i].Image.Free;
848 end;
849 end;
850 Paint;
851 end;
852 finally
853 frmNodeProp.NodeList.Free;
854 frmNodeProp.Free;
855 end;
856 end;
857
858
859 procedure TNetPanel.OnChangeEdge (Sender : TObject);
860 begin
861 if CurrentObject.ObjType = oEdge then
862 CurrentObject.Edge.Name := InputBox('Change Edge Name', 'Enter New Edge Name', CurrentObject.Edge.Name);
863 Paint;
864 end;
865
866
867 procedure TNetPanel.OnEdgeProperties (Sender: TObject);
868 var nReactants, nProducts, i, Index : integer;
869 name : string; value : double;
870 begin
871 frmEdgeProp := TfrmEdgeProp.Create (nil);
872 try
873 frmEdgeProp.Edge := CurrentObject.Edge;
874 frmEdgeProp.Network := Self.Network;
875 frmEdgeProp.cbEdgeColour.color := CurrentObject.Edge.LineColor;
876 //frmEdgeProp.spArcThickness.AsInteger := CurrentObject.Edge.LineThickness;
877 frmEdgeProp.cbFillColour.color := CurrentObject.Edge.ArrowColor;
878
879 nReactants := CurrentObject.Edge.srcConnectedNodeList.Count;
880 nProducts := CurrentObject.Edge.destConnectedNodeList.Count;
881 frmEdgeProp.expr.Compile (CurrentObject.Edge.Ratelaw);
882 for i := 1 to frmEdgeProp.expr.GetnSymbols do
883 begin
884 name := frmEdgeProp.expr.getnthSymbol (i);
885 value := frmEdgeProp.expr.getVar (name);
886 // Add parameters to the symbol list, store any variables else where
887 if Network.NodeList.Find (Name, Index) then
888 frmEdgeProp.expr.setVar (name, Network.NodeList[Index].value)
889 else
890 begin
891 if CurrentObject.Edge.SymbolList.Find (name, Index) then
892 frmEdgeProp.expr.setVar (name, CurrentObject.Edge.SymbolList[Index].value);
893 end;
894 end;
895
896 frmEdgeProp.BuildParameterTable();
897
898 if frmEdgeProp.ShowModal = mrOK then
899 begin
900 CurrentObject.Edge.Name := frmEdgeProp.EdtName.Text;
901 CurrentObject.Edge.Ratelaw := frmEdgeProp.EdtRateLaw.Text;
902 CurrentObject.Edge.SymbolList.Free;
903 CurrentObject.Edge.SymbolList := TSymbolList.Create;
904 CurrentObject.Edge.LineColor := frmEdgeProp.cbEdgeColour.color;
905 //CurrentObject.Edge.LineThickness := frmEdgeProp.spArcThickness.AsInteger;
906 CurrentObject.Edge.ArrowColor := frmEdgeProp.cbFillColour.color;
907
908 for i := 1 to frmEdgeProp.expr.GetnSymbols do
909 begin
910 name := frmEdgeProp.expr.getnthSymbol (i);
911 value := frmEdgeProp.expr.getVar (name);
912 // Add parameters to the symbol list, store any variables else where
913 if Network.NodeList.Find (Name, Index) then
914 Network.NodeList[Index].Value := value
915 else
916 CurrentObject.Edge.SymbolList.Add (TSymbol.Create (name, value, True));
917 end;
918
919 if frmEdgeProp.chkReversible.Checked then
920 CurrentObject.Edge.Reversible := True
921 else CurrentObject.Edge.Reversible := False;
922 // Get the stoichiometries
923 for i := 0 to nReactants - 1 do
924 CurrentObject.Edge.srcConnectedNodeList[i].Stoich := strtoint (frmEdgeProp.ReactantGrid.Cells[1, i]);
925 for i := 0 to nProducts - 1 do
926 CurrentObject.Edge.destConnectedNodeList[i].Stoich := strtoint (frmEdgeProp.ProductGrid.Cells[1, i]);
927 Invalidate;
928 end;
929 finally
930 frmEdgeProp.Free;
931 end;
932 end;
933
934
935 procedure TNetPanel.OnSetBoundary (Sender : TObject);
936 begin
937 if CurrentObject.ObjType = oNode then
938 begin
939 with CurrentObject.SubNode.ParentNode do
940 begin
941 EdgeThickness := 2;
942 EdgeColor := Network.NodeList.GetGlobalBoundaryNodeColor;
943 Status := nsBoundary;
944 end;
945 Paint;
946 end;
947 end;
948
949
950 procedure TNetPanel.OnSetFloating (Sender : TObject);
951 begin
952 if CurrentObject.ObjType = oNode then
953 begin
954 with CurrentObject.SubNode.ParentNode do
955 begin
956 EdgeThickness := 1;
957 EdgeColor := Network.NodeList.GetGlobalBoundaryNodeColor;
958 Status := nsFloating;
959 end;
960 end;
961 Paint;
962 end;
963
964
965 procedure TNetPanel.Clear;
966 begin
967 StandBy;
968 Network.Clear;
969 Paint;
970 end;
971
972
973 function TNetPanel.GetCurrentEdge : TEdge;
974 begin
975 if CurrentObject.Edge = nil then
976 result := nil
977 else result := CurrentObject.Edge;
978 end;
979
980
981 procedure TNetPanel.NodeHit (Node : TNode);
982 begin
983 if Assigned(OnNodeHit) then
984 OnNodeHit (Self, Node);
985 end;
986
987
988 procedure TNetPanel.EdgeHit (Edge : TEdge);
989 begin
990 if Assigned(OnEdgeHit) then
991 OnEdgeHit (Self, Edge);
992 end;
993
994
995 function TNetPanel.IsMouseOnHandle (x, y : integer; var CurrentSubArc : TCurrentSubArc;
996 var handleID : TCurrentSelectedHandle; var hcoords : TPoint) : boolean;
997 begin
998 result := False;
999 if CurrentObject.ObjType in [oEdge, oArcHandle] then// then begin result := False; Exit; end;
1000 result := CurrentObject.Edge.IsMouseOnHandle (x, y, CurrentSubArc, handleID, hcoords);
1001 end;
1002
1003
1004 function TNetPanel.IsMouseOnArcCentre (x, y : integer) : Boolean;
1005 begin
1006 result := False;
1007 if CurrentObject.ObjType in [oEdge, oArcCentre] then
1008 result := CurrentObject.Edge.IsMouseOnArcCentre (x, y);
1009 end;
1010
1011
1012 function TNetPanel.IsMouseOverObject (vx, vy : integer; var ObjInfo : TObjectInfo) : TObjectType;
1013 var i, Shadow : integer; Node : TNode;
1014 begin
1015 if IsOnNode (vx, vy, ObjInfo.SubNode) then
1016 ObjInfo.ObjType := oNode
1017 else
1018 // Must check arc handle before arc just in case handle handle is on top of arc line
1019 if IsMouseOnHandle (vx, vy, ObjInfo.CurrentSubArc, ObjInfo.CurrentSelectedHandle, ObjInfo.HandleCoords) then
1020 ObjInfo.ObjType := oArcHandle
1021 else
1022 if IsMouseOnArcCentre (vx, vy) then
1023 ObjInfo.ObjType := oArcCentre
1024 else
1025 if IsOnEdge (vx, vy, ObjInfo.Edge) then
1026 ObjInfo.ObjType := oEdge
1027 else if IsOnNetObject (vx, vy, ObjInfo.NetObj) then
1028 begin
1029 ObjInfo.vx := vx;
1030 ObjInfo.vy := vy;
1031 ObjInfo.ObjType := oOverText;
1032 end
1033 else
1034 ObjInfo.ObjType := oNone;
1035 result := ObjInfo.ObjType;
1036 end;
1037
1038
1039 function TNetPanel.IsOnNode (x, y : integer; var SubNode : TSubNode) : boolean;
1040 begin
1041 result := Network.IsOnNode (x, y, SubNode);
1042 end;
1043
1044
1045 function TNetPanel.IsOnEdge (x, y : integer; var Index : integer) : boolean;
1046 begin
1047 result := Network.IsOnEdge (x, y, Index);
1048 end;
1049
1050
1051 function TNetPanel.IsOnEdge (x, y : integer; var Edge : TEdge) : boolean;
1052 begin
1053 result := Network.IsOnEdge (x, y, Edge);
1054 end;
1055
1056
1057 function TNetPanel.IsOnNetObject (x, y : integer; var NetObj : TNetObj) : Boolean;
1058 begin
1059 result := Network.IsOnNetObject (x, y, NetObj);
1060 end;
1061
1062
1063 function TNetPanel.AddNode (Name : string) : integer;
1064 begin
1065 result := Network.AddNode (Name);
1066 end;
1067
1068
1069 function TNetPanel.AddNode (Name : string; x, y, w, h : integer) : integer;
1070 begin
1071 result := Network.AddNode (Name, x, y, w, h);
1072 end;
1073
1074
1075 function TNetPanel.AddNode (Name : string; x, y : integer) : integer;
1076 begin
1077 result := Network.AddNode (Name, x, y);
1078 end;
1079
1080
1081 procedure TNetPanel.AddNodes;
1082 begin
1083 StandBy;
1084 FActionMode := sAddingNode;
1085 Cursor := 1;
1086 end;
1087
1088
1089 function TNetPanel.GetUniqueNodeName : string;
1090 begin
1091 Result := Network.GetUniqueNodeName;
1092 end;
1093
1094
1095 procedure TNetPanel.StartConnectingUU;
1096 begin
1097 StandBy;
1098 Cursor := 3;
1099 FActionMode := sUU;
1100 end;
1101
1102
1103 procedure TNetPanel.StartConnectingBiU;
1104 begin
1105 StandBy;
1106 Cursor := 3;
1107 FActionMode := sBiU;
1108 end;
1109
1110
1111 procedure TNetPanel.StartConnectingUBi;
1112 begin
1113 StandBy;
1114 Cursor := 3;
1115 FActionMode := sUBi;
1116 end;
1117
1118
1119 procedure TNetPanel.StartConnectingBiBi;
1120 begin
1121 StandBy;
1122 Cursor := 3;
1123 ActionMode := sBiBi;
1124 end;
1125
1126
1127 procedure TNetPanel.StandBy;
1128 begin
1129 SourceNode1 := nil;
1130 SourceNode2 := nil;
1131 DestNode1 := nil;
1132 DestNode2 := nil;
1133 ActionMode := sSelect;
1134 Cursor := crDefault;
1135 end;
1136
1137
1138 procedure TNetPanel.DeleteNode (Node : TNode);
1139 begin
1140 CurrentObject.ObjType := oNone;
1141 PrepareUndo;
1142 Network.DeleteNode (Node);
1143 Paint;
1144 end;
1145
1146
1147 procedure TNetPanel.DeleteEdge (Edge : TEdge);
1148 begin
1149 CurrentObject.ObjType := oNone;
1150 PrepareUndo;
1151 Network.DeleteEdge (Edge);
1152 Paint;
1153 end;
1154
1155
1156 // This is called after a node has moved. If a node moves, the control point
1157 // furthest away from the node for each connecting arc is moved relative to the node.
1158 // This makes the subarcs move more smoothly, it's a cosmetic feature, nothing more,
1159 // but it does make a difference
1160 procedure TNetPanel.AdjustBezierHandles (SubNode : TSubNode);
1161 var bnx, bny, bn_1x, bn_1y, c1x, c1y, Arc, i : integer;
1162 Edge : TEdge; Node : TNode; Direction : TDirection; EdgeSeg : integer;
1163 begin
1164 { Work your way through all connecting arcs }
1165 for i := 0 to SubNode.ConnectedEdgeList.Count - 1 do
1166 begin
1167 // Get the connecting edge
1168 Node := SubNode.ParentNode;
1169 Edge := SubNode.ConnectedEdgeList[i].Edge as TEdge;
1170
1171 bnx := Edge.ArcCentre.x;
1172 bny := Edge.ArcCentre.y;
1173 case Edge.EdgeType of
1174 eUniUni : begin end; { No constraints for a UniUni }
1175 eUniBi : begin
1176 { Find out if the arc is coming in or leaving the node }
1177 Edge.FindNode (Node, Edge, Direction, EdgeSeg);
1178 if Direction = dDest then
1179 //if ds.Pathway.GetStoichiometry (ds.Pathway.SelectedNode, Arc) > 0 then
1180 begin
1181 { Arc entering node, therefore adjust nearest handle to node
1182 the furthest handle away from the node is fixed }
1183 bn_1x := Edge.SubArcs[1].h2.x;
1184 bn_1y := Edge.SubArcs[1].h2.y;
1185
1186 { These are the nearest handles, two of them, handles on subarc 2 and 3 are merged }
1187 Edge.SubArcs[2].h1.x := (2*bnx - bn_1x);
1188 Edge.SubArcs[2].h1.y := (2*bny - bn_1y);
1189 Edge.SubArcs[3].h1.x := (2*bnx - bn_1x);
1190 Edge.SubArcs[3].h1.y := (2*bny - bn_1y);
1191 end
1192 else
1193 begin
1194 { Arc leaving node, furthest handles are fixed }
1195 bnx := Edge.ArcCentre.x;
1196 bny := Edge.ArcCentre.y;
1197 c1x := Edge.SubArcs[3].h1.x;
1198 c1y := Edge.SubArcs[3].h1.y;
1199
1200 Edge.SubArcs[1].h2.x := 2*bnx - c1x;
1201 Edge.SubArcs[1].h2.y := 2*bny - c1y;
1202 end;
1203 end;
1204 eBiUni : begin
1205 { Find out if the arc is coming in or leaving the node }
1206 Edge.FindNode (Node, Edge, Direction, EdgeSeg);
1207 if Direction = dDest then
1208 //if ds.Pathway.GetStoichiometry (ds.Pathway.SelectedNode, Arc) > 0 then
1209 begin
1210 // Arc entering node, therefore adjust nearest node, furthest is fixed
1211 Edge.SubArcs[1].h2 := Edge.SubArcs[2].h2;
1212 bnx := Edge.ArcCentre.x;
1213 bny := Edge.ArcCentre.y;
1214 bn_1x := Edge.SubArcs[1].h2.x;
1215 bn_1y := Edge.SubArcs[1].h2.y;
1216
1217 Edge.SubArcs[3].h1.x := (2*bnx - bn_1x);
1218 Edge.SubArcs[3].h1.y := (2*bny - bn_1y);
1219 end
1220 else
1221 begin
1222 { Arc leaving node, }
1223 Edge.SubArcs[1].h2 := Edge.SubArcs[2].h2;
1224 bnx := Edge.ArcCentre.x;
1225 bny := Edge.ArcCentre.y;
1226 c1x := Edge.SubArcs[3].h1.x;
1227 c1y := Edge.SubArcs[3].h1.y;
1228
1229 Edge.SubArcs[1].h2.x := 2*bnx - c1x;
1230 Edge.SubArcs[1].h2.y := 2*bny - c1y;
1231 Edge.SubArcs[2].h2.x := 2*bnx - c1x;
1232 Edge.SubArcs[2].h2.y := 2*bny - c1y;
1233 end;
1234 end;
1235 eBiBi : begin
1236 { Find out if the arc is coming in or leaving the node }
1237 Edge.FindNode (Node, Edge, Direction, EdgeSeg);
1238 if Direction = dDest then
1239 //if ds.Pathway.GetStoichiometry (ds.Pathway.SelectedNode, Arc) > 0 then
1240 begin
1241 { Arc entering node, therefore adjust nearest node, furthest is fixed }
1242 Edge.SubArcs[1].h2 := Edge.SubArcs[2].h2;
1243 bnx := Edge.ArcCentre.x;
1244 bny := Edge.ArcCentre.y;
1245 bn_1x := Edge.SubArcs[1].h2.x;
1246 bn_1y := Edge.SubArcs[1].h2.y;
1247
1248 Edge.SubArcs[3].h1.x := (2*bnx - bn_1x);
1249 Edge.SubArcs[3].h1.y := (2*bny - bn_1y);
1250 Edge.SubArcs[4].h1.x := (2*bnx - bn_1x);
1251 Edge.SubArcs[4].h1.y := (2*bny - bn_1y);
1252 end
1253 else
1254 begin
1255 { Arc leaving node, }
1256 Edge.SubArcs[3].h1 := Edge.SubArcs[3].h1;
1257 bnx := Edge.ArcCentre.x;
1258 bny := Edge.ArcCentre.y;
1259 bn_1x := Edge.SubArcs[3].h1.x;
1260 bn_1y := Edge.SubArcs[3].h1.y;
1261
1262 Edge.SubArcs[1].h2.x := (2*bnx - bn_1x);
1263 Edge.SubArcs[1].h2.y := (2*bny - bn_1y);
1264 Edge.SubArcs[2].h2.x := (2*bnx - bn_1x);
1265 Edge.SubArcs[2].h2.y := (2*bny - bn_1y);
1266 end;
1267 end; { BiBi }
1268 eTriBi : begin
1269 Edge.FindNode (Node, Edge, Direction, EdgeSeg);
1270 if Direction = dDest then
1271 { Find out if the arc is coming in or leaving the node }
1272 //if ds.Pathway.GetStoichiometry (ds.Pathway.SelectedNode, Arc) > 0 then
1273 begin
1274 { Arc entering node, therefore adjust nearest node, furthest is fixed }
1275 Edge.SubArcs[1].h2 := Edge.SubArcs[2].h2;
1276 bnx := Edge.ArcCentre.x;
1277 bny := Edge.ArcCentre.y;
1278 bn_1x := Edge.SubArcs[1].h2.x;
1279 bn_1y := Edge.SubArcs[1].h2.y;
1280
1281 Edge.SubArcs[4].h1.x := (2*bnx - bn_1x);
1282 Edge.SubArcs[4].h1.y := (2*bny - bn_1y);
1283 Edge.SubArcs[5].h1.x := (2*bnx - bn_1x);
1284 Edge.SubArcs[5].h1.y := (2*bny - bn_1y);
1285 end
1286 else
1287 begin
1288 { Arc leaving node, }
1289 Edge.SubArcs[4].h1 := Edge.SubArcs[4].h1;
1290 bnx := Edge.ArcCentre.x;
1291 bny := Edge.ArcCentre.y;
1292 bn_1x := Edge.SubArcs[4].h1.x;
1293 bn_1y := Edge.SubArcs[4].h1.y;
1294
1295 Edge.SubArcs[1].h2.x := (2*bnx - bn_1x);
1296 Edge.SubArcs[1].h2.y := (2*bny - bn_1y);
1297 Edge.SubArcs[2].h2.x := (2*bnx - bn_1x);
1298 Edge.SubArcs[2].h2.y := (2*bny - bn_1y);
1299 Edge.SubArcs[3].h2.x := (2*bnx - bn_1x);
1300 Edge.SubArcs[3].h2.y := (2*bny - bn_1y);
1301 end;
1302 end; { TriBi }
1303 end; { case }
1304 end; { if }
1305 end;
1306
1307
1308 // BIG and tedious procedure coming up, makes adjusting bezier look 'nice'
1309 // Called when handles are moved, makes sure that any constraints between
1310 // handles are satisfied, eg colinearity }
1311 procedure TNetPanel.AdjustMovedBezierHandle;
1312 var SubArcSeg : TArcSeg; bnx, bny, bn_1x, bn_1y, c1x, c1y : integer; Edge : TEdge;
1313 begin
1314 SubArcSeg := CurrentObject.Edge.SubArcs[CurrentObject.CurrentSubArc];
1315 Edge := CurrentObject.Edge;
1316 case CurrentObject.Edge.EdgeType of
1317
1318 eUniUni : case CurrentObject.CurrentSelectedHandle of
1319 1 : begin end; { No adjustments necessary, there are no dependencies }
1320 2 : begin end; { THERE ARE! handle 1 and 2 must move together when Merge = true }
1321 end;
1322 eUniBi : case CurrentObject.CurrentSubArc of
1323 1 : case CurrentObject.CurrentSelectedHandle of
1324 1 : begin end;
1325 2 : begin
1326 if SubArcSeg.Merged then
1327 begin
1328 // ... adjust handles on SubArc 2 and 3
1329 bnx := Edge.ArcCentre.x;
1330 bny := Edge.ArcCentre.y;
1331 bn_1x := CurrentObject.Edge.SubArcs[1].h2.x;
1332 bn_1y := CurrentObject.Edge.SubArcs[1].h2.y;
1333
1334 CurrentObject.Edge.SubArcs[2].h1.x := 2*bnx - bn_1x;
1335 CurrentObject.Edge.SubArcs[2].h1.y := 2*bny - bn_1y;
1336 CurrentObject.Edge.SubArcs[3].h1.x := 2*bnx - bn_1x;
1337 CurrentObject.Edge.SubArcs[3].h1.y := 2*bny - bn_1y;
1338 end;
1339 end;
1340 end;
1341 2 : begin
1342 case CurrentObject.CurrentSelectedHandle of
1343 1 :
1344 if SubArcSeg.Merged then
1345 begin
1346 // Set SubArc 3 handle to same position as moving handle
1347 CurrentObject.Edge.SubArcs[3].h1 := SubArcSeg.h1;
1348 // ... then adjust the handle on SubArc 1
1349 bnx := Edge.ArcCentre.x;
1350 bny := Edge.ArcCentre.y;
1351 c1x := CurrentObject.Edge.SubArcs[2].h1.x;
1352 c1y := CurrentObject.Edge.SubArcs[2].h1.y;
1353
1354 CurrentObject.Edge.SubArcs[1].h2.x := 2*bnx - c1x;
1355 CurrentObject.Edge.SubArcs[1].h2.y := 2*bny - c1y;
1356 end;
1357 2 : begin end;
1358 end;
1359 end;
1360
1361 3 : begin
1362 case CurrentObject.CurrentSelectedHandle of
1363 1 : begin
1364 if SubArcSeg.Merged then
1365 begin
1366 // Set SubArc 2 handle to same position as moving handle
1367 CurrentObject.Edge.SubArcs[2].h1 := SubArcSeg.h1;
1368 // ... then adjust the handle on SubArc 1
1369 bnx := Edge.ArcCentre.x;
1370 bny := Edge.ArcCentre.y;
1371 c1x := CurrentObject.Edge.SubArcs[3].h1.x;
1372 c1y := CurrentObject.Edge.SubArcs[3].h1.y;
1373
1374 CurrentObject.Edge.SubArcs[1].h2.x := 2*bnx - c1x;
1375 CurrentObject.Edge.SubArcs[1].h2.y := 2*bny - c1y;
1376 end;
1377 end;
1378 2 : begin end;
1379 end;
1380 end;
1381 end;
1382
1383 eBiUni : case CurrentObject.CurrentSubArc of
1384 1 : case CurrentObject.CurrentSelectedHandle of
1385 1 : begin end;
1386 2 : begin
1387 if SubArcSeg.Merged then
1388 begin
1389 CurrentObject.Edge.SubArcs[2].h2 := SubArcSeg.h2;
1390 // ... adjust handles on SubArc 3
1391 bnx := Edge.ArcCentre.x;
1392 bny := Edge.ArcCentre.y;
1393 bn_1x := CurrentObject.Edge.SubArcs[1].h2.x;
1394 bn_1y := CurrentObject.Edge.SubArcs[1].h2.y;
1395
1396 CurrentObject.Edge.SubArcs[3].h1.x := 2*bnx - bn_1x;
1397 CurrentObject.Edge.SubArcs[3].h1.y := 2*bny - bn_1y;
1398 end;
1399 end;
1400 end;
1401 2 : begin
1402 case CurrentObject.CurrentSelectedHandle of
1403 1 : if SubArcSeg.Merged then
1404 begin
1405 end;
1406 2 : begin
1407 { Set SubArc 3 handle to same position as moving handle }
1408 CurrentObject.Edge.SubArcs[2].h2 := SubArcSeg.h2;
1409 { ... then adjust the handle on SubArc 3 }
1410 bnx := Edge.ArcCentre.x;
1411 bny := Edge.ArcCentre.y;
1412 bn_1x := CurrentObject.Edge.SubArcs[2].h2.x;
1413 bn_1y := CurrentObject.Edge.SubArcs[2].h2.y;
1414
1415 CurrentObject.Edge.SubArcs[3].h1.x := 2*bnx - bn_1x;
1416 CurrentObject.Edge.SubArcs[3].h1.y := 2*bny - bn_1y;
1417 end;
1418 end;
1419 end;
1420
1421 3 : begin
1422 case CurrentObject.CurrentSelectedHandle of
1423 1 : begin
1424 if SubArcSeg.Merged then
1425 begin
1426 // Set SubArc2 handle to same position as moving handle }
1427 CurrentObject.Edge.SubArcs[2].h2 := CurrentObject.Edge.SubArcs[1].h2;
1428 // ... then adjust the handle on SubArc 1 }
1429 bnx := Edge.ArcCentre.x;
1430 bny := Edge.ArcCentre.y;
1431 c1x := CurrentObject.Edge.SubArcs[3].h1.x;
1432 c1y := CurrentObject.Edge.SubArcs[3].h1.y;
1433
1434 CurrentObject.Edge.SubArcs[1].h2.x := 2*bnx - c1x;
1435 CurrentObject.Edge.SubArcs[1].h2.y := 2*bny - c1y;
1436 CurrentObject.Edge.SubArcs[2].h2.x := 2*bnx - c1x;
1437 CurrentObject.Edge.SubArcs[2].h2.y := 2*bny - c1y;
1438 end;
1439 end;
1440 2 : begin end;
1441 end;
1442 end;
1443 end; { Inner case }
1444
1445 eBiBi : case CurrentObject.CurrentSubArc of
1446 1,2 : case CurrentObject.CurrentSelectedHandle of
1447 1 : begin end;
1448 2 : begin
1449 if SubArcSeg.Merged then
1450 begin
1451 CurrentObject.Edge.SubArcs[2].h2 := SubArcSeg.h2;
1452 // ... adjust handles on SubArc 3
1453 bnx := Edge.ArcCentre.x;
1454 bny := Edge.ArcCentre.y;
1455 bn_1x := CurrentObject.Edge.SubArcs[1].h2.x;
1456 bn_1y := CurrentObject.Edge.SubArcs[1].h2.y;
1457
1458 CurrentObject.Edge.SubArcs[3].h1.x := 2*bnx - bn_1x;
1459 CurrentObject.Edge.SubArcs[3].h1.y := 2*bny - bn_1y;
1460 CurrentObject.Edge.SubArcs[4].h1.x := 2*bnx - bn_1x;
1461 CurrentObject.Edge.SubArcs[4].h1.y := 2*bny - bn_1y;
1462 end;
1463 end;
1464 end;
1465
1466 3,4 : begin
1467 case CurrentObject.CurrentSelectedHandle of
1468 1 : begin
1469 if SubArcSeg.Merged then
1470 begin
1471 { Set SubArc2 handle to same position as moving handle }
1472 CurrentObject.Edge.SubArcs[4].h1 := SubArcSeg.h1;
1473 { ... then adjust the handle on SubArc 1 }
1474 bnx := Edge.ArcCentre.x;
1475 bny := Edge.ArcCentre.y;
1476 // Center of beziers, could use SubArcs[4] with equal effect
1477 c1x := CurrentObject.Edge.SubArcs[3].h1.x;
1478 c1y := CurrentObject.Edge.SubArcs[3].h1.y;
1479
1480 CurrentObject.Edge.SubArcs[1].h2.x := 2*bnx - c1x;
1481 CurrentObject.Edge.SubArcs[1].h2.y := 2*bny - c1y;
1482 CurrentObject.Edge.SubArcs[2].h2.x := 2*bnx - c1x;
1483 CurrentObject.Edge.SubArcs[2].h2.y := 2*bny - c1y;
1484 end;
1485 end;
1486 2 : begin end;
1487 end;
1488 end;
1489 end;
1490
1491 // Needs implementing !!!!!
1492
1493 {TriBi : case CurrentObject.CurrentSubArc of
1494 1,2,3 : case CurrentObject.CurrentSelectedHandle of
1495 1 : begin end;
1496 2 : begin
1497 if SubArcSeg.Merged then
1498 begin
1499 Network.EdgeList[SelectedArc].SubArcs[2].h2 := SubArcSeg.h2;
1500 Network.EdgeList[SelectedArc].SubArcs[3].h2 := SubArcSeg.h2;
1501 // ... adjust handles on SubArc 3 }
1502 {ArcCentre := ComputeCentroid (Network.EdgeList[SelectedEdge]);
1503 bnx := Network.EdgeList[SelectedArc].ArcCentre.x;
1504 bny := Network.EdgeList[SelectedArc].ArcCentre.y;
1505 bn_1x := Network.EdgeList[SelectedArc].SubArcs[1].h2.x;
1506 bn_1y := Network.EdgeList[SelectedArc].SubArcs[1].h2.y;
1507
1508 Network.EdgeList[SelectedArc].SubArcs[4].h1.x := 2*bnx - bn_1x;
1509 Network.EdgeList[SelectedArc].SubArcs[4].h1.y := 2*bny - bn_1y;
1510 Network.EdgeList[SelectedArc].SubArcs[5].h1.x := 2*bnx - bn_1x;
1511 Network.EdgeList[SelectedArc].SubArcs[5].h1.y := 2*bny - bn_1y;
1512 end;
1513 end;
1514 end;
1515 4,5 : begin
1516 case handleID of
1517 1 : begin
1518 if SubArcSeg.Merged then
1519 begin
1520 // Set SubArc2 handle to same position as moving handle }
1521 {Network.EdgeList[SelectedArc].SubArcs[4].h1 := SubArcSeg.h1;
1522 Network.EdgeList[SelectedArc].SubArcs[5].h1 := SubArcSeg.h1;
1523 // ... then adjust the handle on SubArc 1 }
1524 {ArcCentre := ComputeCentroid (Network.EdgeList[SelectedEdge]);
1525 bnx := Network.EdgeList[SelectedArc].ArcCentre.x;
1526 bny := Network.EdgeList[SelectedArc].ArcCentre.y;
1527 c1x := Network.EdgeList[SelectedArc].SubArcs[4].h1.x;
1528 c1y := Network.EdgeList[SelectedArc].SubArcs[4].h1.y;
1529
1530 Network.EdgeList[SelectedArc].SubArcs[1].h2.x := 2*bnx - c1x;
1531 Network.EdgeList[SelectedArc].SubArcs[1].h2.y := 2*bny - c1y;
1532 Network.EdgeList[SelectedArc].SubArcs[2].h2.x := 2*bnx - c1x;
1533 Network.EdgeList[SelectedArc].SubArcs[2].h2.y := 2*bny - c1y;
1534 Network.EdgeList[SelectedArc].SubArcs[3].h2.x := 2*bnx - c1x;
1535 Network.EdgeList[SelectedArc].SubArcs[3].h2.y := 2*bny - c1y;
1536 end;
1537 end;
1538 end
1539 end
1540 else begin end;
1541 end; { Inner case }
1542 end; { Outer case }
1543 end;
1544
1545
1546
1547 procedure TNetPanel.AddUniUniArcMouseDown (vx, vy : integer);
1548 begin
1549 if SourceNode1 = nil then // -1 means mode not specified
1550 begin
1551 // collect source node id
1552 if IsOnNode (vx, vy, SourceNode1) then
1553 begin
1554 SourceNode1.Selected := True;
1555 DestNode1 := nil;
1556 SourceNode1.ParentNode.Paint (FOrigin);
1557 end;
1558 end
1559 else
1560 if DestNode1 = nil then
1561 // collect destination node id
1562 if IsOnNode (vx, vy, DestNode1) then
1563 begin
1564 // check if nodes are the same, if they are then cancel operation
1565 if SourceNode1 <> DestNode1 then
1566 begin
1567 DestNode1.Selected := True;
1568 DestNode1.ParentNode.Paint (FOrigin);
1569 // PrepareUndo;
1570 Network.AddUniUniEdge (SourceNode1, DestNode1);
1571 end;
1572 // reset to make ready for another go
1573 SourceNode1.Selected := True;
1574 DestNode1.Selected := True;
1575
1576 SourceNode1 := nil; DestNode1 := nil;
1577 Network.UnSelect;
1578 end
1579 else
1580 begin
1581 // cancel operation ?
1582 SourceNode1.Selected := False;
1583 SourceNode1 := nil; DestNode1 := nil;
1584 end;
1585 Paint;
1586 end;
1587
1588
1589 procedure TNetPanel.AddBiUniArcMouseDown (x, y : integer);
1590 begin
1591 if SourceNode1 = nil then
1592 begin
1593 // collect the first source node id
1594 if IsOnNode (x, y, SourceNode1) then
1595 begin
1596 SourceNode1.Selected := True;
1597 SourceNode2 := nil; DestNode1 := nil;
1598 end;
1599 Paint;
1600 exit;
1601 end;
1602
1603 if SourceNode2 = nil then
1604 begin
1605 // collect the first source node id
1606 if IsOnNode (x, y, SourceNode2) then
1607 begin
1608 SourceNode2.Selected := True;
1609 DestNode1 := nil;
1610 end;
1611 Paint;
1612 exit;
1613 end;
1614
1615 if DestNode1 = nil then
1616 // collect destination node id
1617 if IsOnNode (x, y, DestNode1) then
1618 begin
1619 DestNode1.Selected := True;
1620 //PrepareUndo;
1621 Network.AddBiUniEdge (SourceNode1, SourceNode2, DestNode1);
1622 // reset to make ready for another go
1623 SourceNode1 := nil; SourceNode2 := nil; DestNode1 := nil;
1624 Network.UnSelect;
1625 end
1626 else
1627 begin
1628 // cancel operation ?
1629 SourceNode1 := nil; SourceNode2 := nil; DestNode1 := nil;
1630 Network.UnSelect;
1631 end;
1632 Paint;
1633 end;
1634
1635
1636 { Do reaction A -> B + C }
1637 procedure TNetPanel.AddUniBiArcMouseDown (x, y : integer);
1638 begin
1639 if SourceNode1 = nil then
1640 begin
1641 // collect the first source node id
1642 if IsOnNode (x, y, SourceNode1) then
1643 begin
1644 SourceNode1.Selected := True;
1645 DestNode1 := nil; DestNode2 := nil;
1646 end;
1647 Paint;
1648 exit;
1649 end;
1650
1651 if DestNode1 = nil then
1652 begin
1653 { collect the first source node id }
1654 if IsOnNode (x, y, DestNode1) then
1655 begin
1656 DestNode1.Selected := True;
1657 DestNode2 := nil;
1658 end;
1659 Paint;
1660 exit;
1661 end;
1662
1663 if DestNode2 = nil then
1664 // collect destination node id
1665 if IsOnNode (x, y, DestNode2) then
1666 begin
1667 DestNode2.Selected := True;
1668 //PrepareUndo;
1669 Network.AddUniBiEdge (SourceNode1, DestNode1, DestNode2);
1670 // reset to make ready for another go
1671 SourceNode1 := nil; SourceNode2 := nil; DestNode1 := nil; DestNode2 := nil;
1672 Network.UnSelect;
1673 end
1674 else
1675 begin
1676 // cancel operation ?
1677 SourceNode1 := nil; SourceNode2 := nil; DestNode1 := nil; DestNode2 := nil;
1678 Network.UnSelect;
1679 end;
1680 Paint;
1681 end;
1682
1683
1684 { Do reaction A + B -> C + D }
1685 procedure TNetPanel.AddBiBiArcMouseDown (x, y : integer);
1686 begin
1687 if SourceNode1 = nil then
1688 begin
1689 // collect the first source node id
1690 if IsOnNode (x, y, SourceNode1) then
1691 begin
1692 SourceNode1.Selected := True;
1693 SourceNode2 := nil; DestNode1 := nil;
1694 end;
1695 Paint;
1696 exit;
1697 end;
1698
1699 if SourceNode2 = nil then
1700 begin
1701 // collect the first source node id
1702 if IsOnNode (x, y, SourceNode2) then
1703 begin
1704 SourceNode2.Selected := True;
1705 DestNode1 := nil;
1706 end;
1707 Paint;
1708 exit;
1709 end;
1710
1711 if DestNode1 = nil then
1712 begin
1713 // collect destination node id
1714 if IsOnNode (x, y, DestNode1) then
1715 begin
1716 DestNode1.Selected := True;
1717 end;
1718 Paint;
1719 exit;
1720 end;
1721
1722 if DestNode2 = nil then
1723 // collect destination node id
1724 if IsOnNode (x, y, DestNode2) then
1725 begin
1726 DestNode2.Selected := True;
1727 //PrepareUndo;
1728 Network.AddBiBiEdge (SourceNode1, SourceNode2, DestNode1, DestNode2);
1729
1730 // reset to make ready for another go
1731 SourceNode1 := nil; SourceNode2 := nil; DestNode1 := nil; DestNode2 := nil;
1732 Network.UnSelect;
1733 end
1734 else
1735 begin
1736 // cancel operation ?
1737 SourceNode1 := nil; SourceNode2 := nil; DestNode1 := nil; DestNode2 := nil;
1738 Network.UnSelect;
1739 end;
1740 Paint;
1741 end;
1742
1743
1744 procedure TNetPanel.Read (FileName : string);
1745 var s : TFileStream;
1746 begin
1747 s := TFileStream.Create (FileName, fmOpenRead);
1748 Network.Clear;
1749 Network.Read (Bitmap.Canvas, s);
1750 s.Free;
1751 end;
1752
1753
1754 procedure TNetPanel.Save (FileName : string);
1755 var s : TFileStream;
1756 begin
1757 s := TFileStream.Create (FileName, fmCreate);
1758 Network.Save (s);
1759 s.free;
1760 end;
1761
1762
1763 procedure TNetPanel.PrepareUndo;
1764 begin
1765 Network.PrepareUndo;
1766 end;
1767
1768
1769 procedure TNetPanel.ApplyUndo;
1770 begin
1771 Network.Undo;
1772 end;
1773
1774
1775 function TNetPanel.UndoStackEmpty : boolean;
1776 begin
1777 result := Network.UndoStackEmpty;
1778 end;
1779
1780
1781 procedure TNetPanel.EmptyUndoStack;
1782 begin
1783 Network.EmptyUndoStack;
1784 end;
1785
1786
1787 procedure Register;
1788 begin
1789 RegisterComponents('Samples', [TNetPanel]);
1790 end;
1791
1792 end.