ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JDesigner/ufJDesigner.pas
Revision: 1.1.1.1 (vendor branch)
Committed: Mon Dec 10 19:29:12 2001 UTC (15 years 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 ufJDesigner;
2
3 // The JDesigner form
4
5 interface
6
7 uses
8 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9 ExtCtrls, uNetPanel, StdCtrls, Buttons, uNetwork, ComCtrls, ToolWin,
10 Menus, Grids, ClipBrd, uSBWAccess, uTSBW, ImgList, uSBWD, uCommon,
11 uSBWCallObject;
12
13 const
14 Version = '1.3c';
15
16 type
17 TStatusMode = (gIdle, gAddingNodes, gConnectingNodes);
18
19 TfrmNetworkEd = class(TForm)
20 pnlInfo: TPanel;
21 Splitter1: TSplitter;
22 StatusBar: TStatusBar;
23 ToolBar1: TToolBar;
24 OpenDialog: TOpenDialog;
25 SaveDialog: TSaveDialog;
26 ToolButton4: TToolButton;
27 pnlGrid: TPanel;
28 StringGrid: TStringGrid;
29 Label1: TLabel;
30 ObjectPopUp: TPopupMenu;
31 mnuPlaceText: TMenuItem;
32 Quit1: TMenuItem;
33 Square1: TMenuItem;
34 Triangle1: TMenuItem;
35 Triangle2: TMenuItem;
36 MainMenu: TMainMenu;
37 About1: TMenuItem;
38 pnlTop: TPanel;
39 BtnCloseInfoPanel: TSpeedButton;
40 Bevel1: TBevel;
41 Panel1: TPanel;
42 Label2: TLabel;
43 Label3: TLabel;
44 Shape2: TShape;
45 Shape1: TShape;
46 NetworkObj: TNetwork;
47 mnuEdit: TMenuItem;
48 mnuUndo: TMenuItem;
49 N1: TMenuItem;
50 mnuCut: TMenuItem;
51 mnuCopy: TMenuItem;
52 mnuPaste: TMenuItem;
53 N2: TMenuItem;
54 mnuEmptyUndoStack: TMenuItem;
55 mnuTools: TMenuItem;
56 Bevel2: TBevel;
57 mnuOptions: TMenuItem;
58 mnuColourOptions: TMenuItem;
59 ToolBar2: TToolBar;
60 ToolButton1: TToolButton;
61 ToolButton2: TToolButton;
62 pnlLeftToolPanel: TPanel;
63 sbw: TSBW;
64 ImageList: TImageList;
65 mnuSBW: TMenuItem;
66 File1: TMenuItem;
67 mnuNew: TMenuItem;
68 mnuOpen: TMenuItem;
69 mnuSave: TMenuItem;
70 mnuSaveAs: TMenuItem;
71 N3: TMenuItem;
72 mnuExit: TMenuItem;
73 N4: TMenuItem;
74 mnuExport: TMenuItem;
75 NetPanel: TNetPanel;
76 mnuRegisterSBW: TMenuItem;
77 BtnIdle: TSpeedButton;
78 BtnAddNewNode: TSpeedButton;
79 BtnConnectUniUni: TSpeedButton;
80 BtnUBi: TSpeedButton;
81 BtnBiUni: TSpeedButton;
82 BtnBiBi: TSpeedButton;
83 BtnAddText: TSpeedButton;
84 BtnGrid: TSpeedButton;
85 BtnExportNetwork: TSpeedButton;
86 BtnPaste: TSpeedButton;
87 BtnCopy: TSpeedButton;
88 BtnUndo: TSpeedButton;
89 BtnCut: TSpeedButton;
90 BtnSave: TSpeedButton;
91 BtnLoad: TSpeedButton;
92 BtnClear: TSpeedButton;
93 procedure BtnAddNodesClick(Sender: TObject);
94 procedure FormCreate(Sender: TObject);
95 procedure BtnIdleClick(Sender: TObject);
96 procedure BtnConnectClick(Sender: TObject);
97 procedure FormKeyDown(Sender: TObject; var Key: Word;
98 Shift: TShiftState);
99 procedure BiUClick(Sender: TObject);
100 procedure BtnUBiClick(Sender: TObject);
101 procedure BtnBiBiClick(Sender: TObject);
102 procedure BtnLoadClick(Sender: TObject);
103 procedure BtnClearClick(Sender: TObject);
104 procedure BtnGridClick(Sender: TObject);
105 procedure BtnExportNetworkClick(Sender: TObject);
106 procedure BtnObjectsClick(Sender: TObject);
107 procedure mnuPlaceTextClick(Sender: TObject);
108 procedure BtnAddTextClick(Sender: TObject);
109 procedure BtnConnectUniUniOnClick(Sender: TObject);
110 procedure BtnCloseInfoPanelClick(Sender: TObject);
111 procedure About1Click(Sender: TObject);
112 procedure NetworkObjBackgroundChange(Sender: TObject);
113 procedure NetworkObjGlobalArcColorChange(Sender: TObject);
114 procedure NetworkObjGlobalNodeColorChange(Sender: TObject);
115 procedure NetworkObjArcColorChange(Sender: TObject);
116 procedure NetworkObjNodeColorChange(Sender: TObject);
117 procedure NetworkObjFontChange(Sender: TObject);
118 procedure BtnUndoClick(Sender: TObject);
119 procedure BtnCutClick(Sender: TObject);
120 procedure NetworkObjUndoAction(Sender: TObject);
121 procedure mnuEmptyUndoStackClick(Sender: TObject);
122 procedure FormClose(Sender: TObject; var Action: TCloseAction);
123 procedure mnuColourOptionsClick(Sender: TObject);
124 procedure FormDestroy(Sender: TObject);
125 procedure sbwRegister(Sender: TObject);
126 procedure StatusBarDrawPanel(StatusBar: TStatusBar;
127 Panel: TStatusPanel; const Rect: TRect);
128 procedure mnuSaveClick(Sender: TObject);
129 procedure mnuSaveAsClick(Sender: TObject);
130 procedure mnuSBWCopyClick(Sender: TObject);
131 procedure Splitter1Moved(Sender: TObject);
132 procedure NetPanelDropFiles(Sender: TObject; X, Y: Integer;
133 AFiles: TStrings);
134 procedure mnuRegisterSBWClick(Sender: TObject);
135 procedure mnuExitClick(Sender: TObject);
136 private
137 { Private declarations }
138 SBWServiceDescriptorArrayPtr : PSBWServiceDescriptorArray;
139 SBWServiceDescriptorPtr : PSBWServiceDescriptor;
140 procedure SBWMenuHandler(Sender : TObject);
141 procedure BuildSBWMenu();
142 public
143 { Public declarations }
144 SBWMethods : TJDesignerSBWMethods;
145 m : TDynArray;
146 StatusMode : TStatusMode;
147 CurrentFileName : string;
148 NOMModuleId, NOMId : integer;
149 NOM_loadSBML, NOM_getSBML : TSBWCallObject;
150 StoichGridVisible : boolean;
151 StoichGridWidth : integer;
152 procedure SetStatusBar;
153 procedure GetSBML (var str : PChar);
154 procedure GetAnnotatedSBML (var str : PChar);
155 procedure AddMenu (Title : string; ServicePtr : cardinal);
156 procedure PrepareUndo;
157 procedure ApplyUndo;
158 procedure mnuSBWClick (Sender : TObject);
159 function LoadFile (FileName : string) : string;
160 procedure NewModel;
161 procedure ShutdownMsg;
162 procedure Save (Sender : TObject);
163 procedure SaveAs (Sender : TObject);
164 procedure GetNOMInterface();
165 procedure ApplyStoichGridVisible;
166 end;
167
168 var
169 frmNetworkEd: TfrmNetworkEd;
170 ServerPort : string;
171
172 implementation
173
174 uses ufExportJ, uSetup, uColorOpts, uNodeList;
175
176 {$R *.DFM}
177
178 const NL = #10#13;
179
180
181 procedure TfrmNetworkEd.BtnAddNodesClick(Sender: TObject);
182 begin
183 case StatusMode of
184 gIdle,
185 gConnectingNodes :
186 begin
187 NetPanel.ActionMode := sAddingNode;
188 StatusMode := gAddingNodes;
189 end;
190 end;
191 SetStatusBar;
192 end;
193
194
195 procedure TfrmNetworkEd.SetStatusBar;
196 begin
197 case StatusMode of
198 gAddingNodes : StatusBar.Panels[0].Text := 'Adding Nodes';
199 gConnectingNodes : StatusBar.Panels[0].Text := 'Connecting Nodes';
200 else
201 StatusBar.Panels[0].Text := 'Standing By';
202 end;
203 end;
204
205
206 procedure TfrmNetworkEd.SBWMenuHandler(Sender : TObject);
207 var moduleId, serviceId, methodId, Index, l : integer; mnu : TMenuItem;
208 sd : TSBWServiceDescriptor;
209 sd_ptr : PSBWServiceDescriptor;
210 begin
211 mnu := Sender as TMenuItem;
212 Index := mnu.tag;
213 sd := SBWServiceDescriptorArrayPtr[Index];
214 sd_ptr := @sd;
215 if SBWGetServiceInModuleInstance(sd_ptr, moduleId, serviceId) = 1 then
216 begin
217 methodId := SBWServiceGetMethod(moduleId, serviceId, PChar ('void doAnalysis (string)'));
218 if methodId = -1 then
219 showmessage ('Unable to locate category method, void doAnalysis (string)');
220 sbw.Call (moduleId, serviceId, methodId, [Netpanel.Network.GetXMLString], l);
221 end
222 else
223 showmessage (SBWExceptionGetMessage() + ' : ' + SBWExceptionGetDetailedMessage());
224 end;
225
226
227 procedure TfrmNetworkEd.BuildSBWMenu();
228 var numberOfServices, i : integer;
229 NewItem: TMenuItem;
230 begin
231 SBWServiceDescriptorArrayPtr := SBWFindServices(PChar ('Analysis'), numberOfServices, 1);
232 if SBWServiceDescriptorArrayPtr = nil then
233 showmessage ('SBW Menu building failed while attempting to obtain the Service descriptor')
234 else
235 begin
236 for i := 0 to numberOfServices - 1 do
237 begin
238 NewItem := TMenuItem.Create(Self);
239 NewItem.tag := i;
240 NewItem.Caption := SBWServiceDescriptorArrayPtr^[i].serviceDisplayName;
241 NewItem.OnClick := SBWMenuHandler;
242 mnuSBW.Add (NewItem);
243 end;
244 end;
245 end;
246
247
248 procedure TfrmNetworkEd.GetNOMInterface();
249 begin
250 {NOMModuleId := sbw.GetModuleId ('edu.caltech.NOM');
251 if NOMModuleId = -1 then
252 //mneSBWCopy.enabled := False
253 else
254 begin
255 //mneSBWCopy.enabled := True;
256 NomId := sbw.GetServiceId (NomModuleId, 'NOM');
257
258 NOM_loadSBML := sbw.GetMethodPtr (NOMModuleId, NomId, 'void loadSBML (string)');
259 //NOM_getSBML := sbw.GetMethodPtr (NOMModuleId, NomId, 'getSBML');
260 end;}
261 end;
262
263
264 procedure TfrmNetworkEd.FormCreate(Sender: TObject);
265 var MyTop, MyLeft, MyHeight, MyWidth : integer;
266 begin
267 SBWMethods := nil;
268 StoichGridWidth := 229; /// Default
269 pnlInfo.Width := 2; // Closed by default
270
271 StatusMode := gIdle;
272 if NetPanel.Network = nil then
273 NetPanel.Network := TNetwork.Create (Self);
274
275 CurrentFileName := '';
276
277 MyTop := Top;
278 MyLeft := Left;
279 MyHeight := Height;
280 MyWidth := Width;
281 WindowState := wsNormal;
282
283 if DefaultWindowTop <> -1 then
284 MyTop := DefaultWindowTop;
285
286 if DefaultWindowLeft <> -1 then
287 MyLeft := DefaultWindowLeft;
288
289 if DefaultWindowHeight <> -1 then
290 MyHeight := DefaultWindowHeight;
291
292 if DefaultWindowWidth <> -1 then
293 MyWidth := DefaultWindowWidth;
294
295 if sbw.connected then
296 BuildSBWMenu();
297
298 Self.SetBounds (MyLeft, MyTop, MyWidth, MyHeight);
299 SetStatusBar;
300
301 self.StoichGridWidth := uSetup.StoichGridWidth;
302 self.StoichGridVisible := uSetup.StoichGridVisible;
303 ApplyStoichGridVisible;
304
305 GetNOMInterface();
306 end;
307
308
309 procedure TfrmNetworkEd.BtnIdleClick(Sender: TObject);
310 begin
311 StatusMode := gIdle;
312 NetPanel.Standby;
313 SetStatusBar;
314 end;
315
316 procedure TfrmNetworkEd.BtnConnectClick(Sender: TObject);
317 begin
318 end;
319
320
321 {procedure TForm1.gEdgeHit(Sender: TObject; var Edge: TEdge);
322 begin
323 //label3.caption := 'Edge: ' + inttostr (Network.FindEdge (Edge));
324 end;
325
326
327 procedure TForm1.gNodeHit(Sender: TObject; var Node: TNode);
328 begin
329 //label2.caption := 'Index: ' + inttostr (Network.FindNode (Node));
330 end;}
331
332
333 procedure TfrmNetworkEd.FormKeyDown(Sender: TObject; var Key: Word;
334 Shift: TShiftState);
335 begin
336 if Key = VK_DELETE then
337 case NetPanel.CurrentObject.ObjType of
338 oNode : BtnCutClick(Sender);
339 oEdge : BtnCutClick (Sender);
340 end;
341 end;
342
343
344 procedure TfrmNetworkEd.BiUClick(Sender: TObject);
345 begin
346 StatusMode := gConnectingNodes;
347 NetPanel.StartConnectingBiU;
348 SetStatusBar;
349 end;
350
351
352 procedure TfrmNetworkEd.BtnUBiClick(Sender: TObject);
353 begin
354 StatusMode := gConnectingNodes;
355 NetPanel.StartConnectingUBi;
356 SetStatusBar;
357 end;
358
359
360 procedure TfrmNetworkEd.BtnBiBiClick(Sender: TObject);
361 begin
362 StatusMode := gConnectingNodes;
363 NetPanel.StartConnectingBiBi;
364 SetStatusBar;
365 end;
366
367 procedure TfrmNetworkEd.BtnLoadClick(Sender: TObject);
368 var ErrMsg : string;
369 begin
370 OpenDialog.InitialDir := DefaultPathToData;
371 if OpenDialog.Execute then
372 begin
373 ErrMsg := LoadFile (OpenDialog.FileName);
374 CurrentFileName := OpenDialog.FileName;
375 if ErrMsg <> '' then
376 MessageDlg (ErrMsg, mtError, [mbOK], 0);
377 end;
378 end;
379
380 procedure TfrmNetworkEd.BtnClearClick(Sender: TObject);
381 begin
382 NewModel;
383 end;
384
385
386 procedure TfrmNetworkEd.BtnGridClick(Sender: TObject);
387 var i, j : integer;
388 begin
389 if NetPanel.Network.nNodes + NetPanel.Network.nEdges = 0 then
390 begin
391 Showmessage ('Empty Network, unable to generate matrix');
392 Exit;
393 end;
394 NetPanel.Network.GetAdjacencyMatrix (m);
395 StringGrid.RowCount := NetPanel.Network.nNodes + 1;
396 StringGrid.ColCount := NetPanel.Network.nEdges + 1;
397 for i := 0 to NetPanel.Network.nEdges - 1 do
398 StringGrid.Cells[i+1, 0] := NetPanel.Network.EdgeList[i].Name;
399
400 for i := 0 to NetPanel.Network.nNodes - 1 do
401 begin
402 StringGrid.Cells[0, i+1] := NetPanel.Network[i].Name;
403 for j := 0 to NetPanel.Network.nEdges - 1 do
404 begin
405 StringGrid.Cells [j+1, i+1] := IntToStr (m[i, j]);
406 end;
407 end;
408 end;
409
410
411 procedure TfrmNetworkEd.BtnExportNetworkClick(Sender: TObject);
412 var m : TMemoryStream; f : TFileStream; Buf : PChar;
413 ModuleName, ModelName, ModelTitle : string;
414 begin
415 Buf := nil;
416 frmExportJarnac := TfrmExportJarnac.Create (nil);
417 frmExportJarnac.NetPanel := NetPanel;
418 try
419 if frmExportJarnac.ShowModal = mrCancel then
420 Exit;
421 ModuleName := frmExportJarnac.ModuleName;
422 ModelName := frmExportJarnac.ModelName;
423 ModelTitle := frmExportJarnac.ModelTitle;
424 finally
425 frmExportJarnac.Free;
426 end;
427
428 f := TFileStream.Create ('tmp$$$.jan', fmCreate);
429 try
430 NetPanel.Network.GetJarnacScript (f, ModuleName, ModelName, ModelTitle);
431 finally
432 f.Free;
433 end;
434
435 // Prepare to copy the file to the clipboard
436 m := TMemoryStream.Create;
437 try
438 // Load the file into a memory stream then dump it to a PChar buffer
439 m.LoadFromFile ('tmp$$$.jan');
440 GetMem (Buf, m.Size+1);
441 m.Position := 0;
442 m.Read (Buf^, m.Size);
443 Buf[m.Size] := #0;
444 ClipBoard.SetTextBuf (Buf);
445 finally
446 m.Free;
447 FreeMem (Buf);
448 DeleteFile ('tmp$$$.jan');
449 end;
450 end;
451
452 procedure TfrmNetworkEd.BtnObjectsClick(Sender: TObject);
453 var p : TPoint;
454 begin
455 Windows.GetCursorPos (p);
456 ObjectPopup.Popup (p.x, p.y);
457 end;
458
459 procedure TfrmNetworkEd.mnuPlaceTextClick(Sender: TObject);
460 begin
461 NetPanel.Cursor := crIBeam;
462 NetPanel.ActionMode := sAddText;
463 end;
464
465 procedure TfrmNetworkEd.BtnAddTextClick(Sender: TObject);
466 begin
467 NetPanel.Cursor := crIBeam;
468 NetPanel.ActionMode := sAddText;
469 end;
470
471 procedure TfrmNetworkEd.BtnConnectUniUniOnClick(Sender: TObject);
472 begin
473 StatusMode := gConnectingNodes;
474 NetPanel.StartConnectingUU;
475 SetStatusBar;
476 end;
477
478
479 procedure TfrmNetworkEd.ApplyStoichGridVisible;
480 begin
481 if not StoichGridVisible then
482 pnlInfo.Width := 2
483 else
484 begin
485 if StoichGridWidth > Netpanel.Width - 12 then
486 dec (StoichGridWidth, 12);
487 pnlInfo.Width := StoichGridWidth;
488 end;
489 end;
490
491
492 procedure TfrmNetworkEd.BtnCloseInfoPanelClick(Sender: TObject);
493 begin
494 if StoichGridVisible then
495 StoichGridVisible := False
496 else StoichGridVisible := True;
497 ApplyStoichGridVisible;
498 end;
499
500
501 procedure TfrmNetworkEd.GetSBML (var str : PChar);
502 begin
503 NetPanel.Network.GetSBML (str);
504 end;
505
506
507 procedure TfrmNetworkEd.GetAnnotatedSBML (var str : PChar);
508 begin
509 NetPanel.Network.GetAnnotatedSBML (str);
510 end;
511
512
513 procedure TfrmNetworkEd.About1Click(Sender: TObject);
514 begin
515 MessageDlg ('JDesigner' + NL + NL +
516 'Copyright (c) 1999/2001 Herbert M Sauro' + NL +
517 'Versions beyond 1.0 supported by ERATO/Kitano' + NL +
518 NL +
519 'Distributed under the LGPL licence' + NL + NL +
520 'Version ' + Version + NL + NL +
521 'Added drag and drop to drawing area', mtInformation, [mbOK], 0);
522 end;
523
524
525 procedure TfrmNetworkEd.AddMenu (Title : string; ServicePtr : cardinal);
526 var NewItem : TMenuItem;
527 begin
528 NewItem := TMenuItem.Create(Self);
529 NewItem.Caption := Title;
530 NewItem.Tag := ServicePtr;
531 NewItem.OnClick := mnuSBWClick;
532 end;
533
534
535 procedure TfrmNetworkEd.NetworkObjBackgroundChange(Sender: TObject);
536 begin
537 NetPanel.Paint;
538 end;
539
540 procedure TfrmNetworkEd.NetworkObjGlobalArcColorChange(Sender: TObject);
541 begin
542 NetPanel.Paint;
543 end;
544
545 procedure TfrmNetworkEd.NetworkObjGlobalNodeColorChange(Sender: TObject);
546 begin
547 NetPanel.Paint;
548 end;
549
550 procedure TfrmNetworkEd.NetworkObjArcColorChange(Sender: TObject);
551 begin
552 NetPanel.Paint;
553 end;
554
555 procedure TfrmNetworkEd.NetworkObjNodeColorChange(Sender: TObject);
556 begin
557 NetPanel.Paint;
558 end;
559
560 procedure TfrmNetworkEd.NetworkObjFontChange(Sender: TObject);
561 begin
562 NetPanel.Paint;
563 end;
564
565 procedure TfrmNetworkEd.BtnUndoClick(Sender: TObject);
566 begin
567 ApplyUndo;
568 end;
569
570 procedure TfrmNetworkEd.BtnCutClick(Sender: TObject);
571 begin
572 PrepareUndo;
573 if NetPanel.CurrentObject.ObjType = oNode then
574 NetPanel.DeleteNode (NetPanel.CurrentObject.SubNode.ParentNode);
575 if NetPanel.CurrentObject.ObjType = oEdge then
576 NetPanel.DeleteEdge (NetPanel.CurrentObject.Edge);
577 end;
578
579
580 procedure TfrmNetworkEd.PrepareUndo;
581 begin
582 NetPanel.PrepareUndo;
583 BtnUndo.enabled := True;
584 mnuUndo.enabled := True;
585 end;
586
587
588 procedure TfrmNetworkEd.ApplyUndo;
589 begin
590 NetPanel.ApplyUndo;
591 NetPanel.Paint;
592 end;
593
594
595 procedure TfrmNetworkEd.NetworkObjUndoAction(Sender: TObject);
596 begin
597 if NetPanel.UndoStackEmpty then
598 begin
599 BtnUndo.enabled := False;
600 mnuUndo.enabled := False;
601 end
602 else
603 begin
604 BtnUndo.enabled := True;
605 mnuUndo.enabled := True;
606 end;
607
608 end;
609
610 procedure TfrmNetworkEd.mnuEmptyUndoStackClick(Sender: TObject);
611 begin
612 NetPanel.EmptyUndoStack;
613 end;
614
615
616 procedure TfrmNetworkEd.mnuSBWClick (Sender : TObject);
617 begin
618 end;
619
620
621 procedure TfrmNetworkEd.FormClose(Sender: TObject;
622 var Action: TCloseAction);
623 begin
624 SaveIniFile (Self);
625 end;
626
627
628 function TfrmNetworkEd.LoadFile (FileName : string) : string;
629 begin
630 result := '';
631 if FileExists (FileName) then
632 begin
633 try
634 NetPanel.Read (FileName);
635 NetPanel.Invalidate;
636 except
637 on E: Exception do
638 result := 'Data file read error: ' + E.message;
639 end;
640 end
641 else
642 result := 'Unable to locate the file [' + FileName + ']';
643 end;
644
645
646 procedure TfrmNetworkEd.NewModel;
647 begin
648 StatusMode := gIdle;
649 NetPanel.Clear;
650 SetStatusBar;
651 end;
652
653
654 procedure TfrmNetworkEd.ShutdownMsg;
655 begin
656 MessageDlg ('JDesigner is being controlled from another application,'#10#13'please shutdown JDesigner from the other application',
657 mtWarning, [mbOk], 0);
658 end;
659
660
661 procedure TfrmNetworkEd.mnuColourOptionsClick(Sender: TObject);
662 var i : integer;
663 begin
664 frmColorOpts := TfrmColorOpts.Create (nil);
665 try
666 with frmColorOpts do
667 begin
668 cboFloatingSpecies.Clear;
669 cboBoundarySpecies.Clear;
670 cboReactions.Clear;
671 for i := 0 to Netpanel.Network.NodeList.Count - 1 do
672 if Netpanel.Network.NodeList[i].Status = nsFloating then
673 cboFloatingSpecies.Items.AddObject (Netpanel.Network.NodeList[i].Name, TObject (Netpanel.Network.NodeList[i]))
674 else cboBoundarySpecies.Items.AddObject (Netpanel.Network.NodeList[i].Name, TObject (Netpanel.Network.NodeList[i]));
675
676 if Netpanel.Network.GetnFloat > 0 then cboFloatingSpecies.ItemIndex := 0;
677 if Netpanel.Network.GetnFixed > 0 then cboBoundarySpecies.ItemIndex := 0;
678
679 for i := 0 to Netpanel.Network.EdgeList.Count - 1 do
680 cboReactions.Items.AddObject (Netpanel.Network.EdgeList[i].Name, TObject (Netpanel.Network.EdgeList[i]));
681 if Netpanel.Network.EdgeList.Count > 0 then cboReactions.ItemIndex := 0;
682
683 ccboGlobalFloatingSpeciesColor.Color := NetPanel.Network.GlobalFloatingNodeColor;
684 ccboGlobalBoundarySpeciesColor.Color := NetPanel.Network.GlobalBoundaryNodeColor;
685 ccboGlobalReactionsColor.Color := NetPanel.Network.GlobalArcColor;
686 ccboBackGround.Color := Netpanel.Network.BackGroundColor;
687 end;
688
689 frmColorOpts.ShowModal;// = mrOK then
690 finally
691 frmColorOpts.Free;
692 end;
693 end;
694
695 procedure TfrmNetworkEd.FormDestroy(Sender: TObject);
696 begin
697 //sbw.ShutDownModule (NOMId);
698 SBWMethods.Free;
699 end;
700
701 procedure TfrmNetworkEd.sbwRegister(Sender: TObject);
702 begin
703 try
704 sbw.addService ('jsys', '', '', '');
705 sbw.addService ('model', '', '', '');
706 sbw.addService ('visual', '', '', '');
707
708 SBWMethods := TJDesignerSBWMethods.Create;
709 sbw.addFunction ('jsys', SBWMethods.getVersion, 'string getVersion()', '');
710 sbw.addFunction ('jsys', SBWMethods.loadFile, 'string loadFile (string)', '');
711 sbw.addFunction('jsys', SBWMethods.saveFile, 'string saveFile(string)', '');
712 sbw.addFunction ('jsys', SBWMethods.setPath, 'string setPath(string)', '');
713 sbw.addMethod ('jsys', SBWMethods.newPathway, 'void newPathway()', '');
714
715 sbw.addFunction ('model', SBWMethods.GetSBML, 'string getSBML()', '');
716 sbw.addFunction ('model', SBWMethods.GetnReactions, 'int getnReactions()', '');
717 sbw.addFunction ('model', SBWMethods.GetnFloats, 'int getnFloats()', '');
718 sbw.addFunction ('model', SBWMethods.GetnFixed, 'int getnFixed()', '');
719
720 sbw.addFunction ('visual', SBWMethods.SetArcColour, 'string setArcColour(string,int)', '');
721 sbw.addMethod ('visual', SBWMethods.SetGlobalArcColour, 'void setGlobalArcColour (int)', '');
722 sbw.addFunction ('visual', SBWMethods.SetNodeColour, 'string setNodeColour(string,int)', '');
723 sbw.addMethod ('visual', SBWMethods.SetGlobalBoundaryNodeColour, 'void setGlobalBoundaryNodeColour(int)', '');
724 sbw.addMethod ('visual', SBWMethods.SetGlobalFloatNodeColour, 'void setGlobalFloatNodeColour (int)', '');
725 sbw.addMethod ('visual', SBWMethods.SetBackColour, 'void setBackColour(int)', '');
726 sbw.addMethod ('visual', SBWMethods.SetGlobalFont, 'void setGlobalFont(string,int,int)', '');
727 sbw.addMethod ('visual', SBWMethods.Redraw, 'void redraw()', '');
728
729 except
730 on E: Exception do
731 raise Exception.Create ('Failed: ' + E.message);
732 end;
733 end;
734
735
736 procedure TfrmNetworkEd.StatusBarDrawPanel(StatusBar: TStatusBar;
737 Panel: TStatusPanel; const Rect: TRect);
738 var str : string; Disp : integer;
739 begin
740 if sbw.Connected then
741 begin
742 str := ' SBW Connected ';
743 disp := 94;
744 end
745 else
746 begin
747 str := ' Failed to Connect to SBW ';
748 disp := 132;
749 end;
750
751 StatusBar.Canvas.TextOut(Rect.left, Rect.top, str);
752 with StatusBar.Canvas do
753 begin
754 if Panel.Index = 1 then
755 begin
756 FillRect(Rect);
757 if sbw.Connected then
758 ImageList.Draw (StatusBar.Canvas, Rect.Left + disp, Rect.Top+1, 0)
759 else ImageList.Draw (StatusBar.Canvas, Rect.Left + disp, Rect.Top+1, 1);
760 TextOut(Rect.left+2, Rect.top + 3, str);
761 end;
762 end;
763 end;
764
765
766 procedure TfrmNetworkEd.SaveAs (Sender : TObject);
767 begin
768 SaveDialog.InitialDir := DefaultPathToData;
769 if SaveDialog.Execute then
770 NetPanel.Save (SaveDialog.FileName);
771 CurrentFileName := SaveDialog.FileName;
772 end;
773
774
775 procedure TfrmNetworkEd.Save (Sender : TObject);
776 begin
777 NetPanel.Save (CurrentFileName);
778 end;
779
780 procedure TfrmNetworkEd.mnuSaveClick(Sender: TObject);
781 begin
782 Save (Sender);
783 end;
784
785 procedure TfrmNetworkEd.mnuSaveAsClick(Sender: TObject);
786 begin
787 SaveAs (Sender);
788 end;
789
790 procedure TfrmNetworkEd.mnuSBWCopyClick(Sender: TObject);
791 begin
792 //NOM_loadSBML.Call ([Netpanel.Network.GetXMLString]);
793 end;
794
795 procedure TfrmNetworkEd.Splitter1Moved(Sender: TObject);
796 begin
797 StoichGridWidth := pnlInfo.Width;
798 end;
799
800 procedure TfrmNetworkEd.NetPanelDropFiles(Sender: TObject; X, Y: Integer;
801 AFiles: TStrings);
802 var FileName, PathStr, ErrMsg : string;
803 begin
804 FileName := AFiles.strings[0];
805 PathStr := ExtractFilePath (FileName);
806 if PathStr <> '' then
807 SetCurrentDir (PathStr);
808 ErrMsg := LoadFile (FileName);
809 CurrentFileName := FileName;
810 if ErrMsg <> '' then
811 MessageDlg (ErrMsg, mtError, [mbOK], 0);
812 end;
813
814 procedure TfrmNetworkEd.mnuRegisterSBWClick(Sender: TObject);
815 begin
816 SBWModuleImplSetCommandLine (PChar (Application.ExeName));
817 SBWModuleImplRegister();
818 end;
819
820 procedure TfrmNetworkEd.mnuExitClick(Sender: TObject);
821 begin
822 Application.Terminate;
823 end;
824
825 end.