// frmBodyPlan.LogEvent('Button clicked'); unit uBodyPlan; {$Define Loger} // Turn Logger on or off {$ASSERTIONS OFF} // The conditional directives {$IFDEF}, {$IFNDEF}, {$IF}, {$ELSEIF}, {$ELSE}, {$ENDIF}, and {$IFEND} allow you to compile {$UNDEF DEBUG} interface uses Windows, Messages, SysUtils, Classes, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.Controls, Vcl.Grids, AdvShape, Vcl.StdCtrls, // RzPanel, Vcl.ComCtrls, System.Variants, Graphics, Forms, StrUtils, uNeuronTypes, System.Types, System.UITypes, AdvUtil, AdvObj, BaseGrid, AdvGrid, JvRollOut, JvExExtCtrls, JvExtComponent, JvExForms, ushldlg, uRegister, JvExControls, JvLED, {SDL_Colbut,} System.Generics.Collections, IOUtils, PropSaveMain, PropSaveGrids, StretchHandles, RzPanel, AdvSmoothMessageDialog, AbNumEdit, LoggerPro, LoggerPro.FileAppender; const CClickZone = 20; CMargen = 5; // Border margen CSource = 1; CTM = 10; CSink = CSource + 1; CISPSCol = CSink + 1; CSourcePort = CISPSCol + 1; CSourceX = CSourcePort + 1; CSourceY = CSourceX + 1; CSinkPort = CSourceY + 1; CSinkX = CSinkPort + 1; CSinkY = CSinkX + 1; CIniFileName = 'NeuronLab.Ini'; CIconsPerPanel = 12; // Number of icons in each body part panel Input = true; Output = NOT Input; RowMax = 120; // Jim Restore this // RowMax = 20; ColMax = 2; // BoGo chap 13 and Cable defaults/ // RMSpecific = 10000; // ohm / cm^2 // CMSpecific = 1E-6; // Frad / cm^2 // RASpecific = 100; // ohm * cm Type { A class to hold the dragged objects } TfrmBodyPlan = class(TForm) mnuMain: TMainMenu; mnuHelp: TMenuItem; mnuAbout: TMenuItem; mnuSound: TMenuItem; mnuHints: TMenuItem; mnuNetSetup: TMenuItem; mnuNeuronSelect: TMenuItem; mnuIPSP: TMenuItem; mnuGrid: TMenuItem; mnuCellsIons: TMenuItem; mnuIonicCurrent: TMenuItem; mnuNeuronSimulator: TMenuItem; mnuDendrites: TMenuItem; mnuSoma: TMenuItem; mnuAxon: TMenuItem; mnuNeuron: TMenuItem; mnuLoadPlan: TMenuItem; mnuSavePlanAs: TMenuItem; popDrag: TMenuItem; popChange: TMenuItem; mnuSee: TMenuItem; N1: TMenuItem; N2: TMenuItem; mnuDisableEnablethruSetup1: TMenuItem; popDragChange: TPopupMenu; dlgSaveAsPlan: TSaveDialog; dlgDeletePlan: TOpenDialog; rollBodyParts: TJvRollOut; pnlStatusRollout: TPanel; eMailMe1: TMenuItem; pnlSteps: TGroupBox; Step_1: TAdvShape; Step_2: TAdvShape; Step_3: TAdvShape; Step_4: TAdvShape; Step_5: TAdvShape; Step_6: TAdvShape; Step_7: TAdvShape; Step_8: TAdvShape; Step_9: TAdvShape; Step_10: TAdvShape; Step_11: TAdvShape; Step_12: TAdvShape; Step_13: TAdvShape; Step_14: TAdvShape; Step_15: TAdvShape; Step_16: TAdvShape; Step_17: TAdvShape; Step_18: TAdvShape; Step_19: TAdvShape; Step_20: TAdvShape; Step_21: TAdvShape; Step_22: TAdvShape; Step_23: TAdvShape; Step_24: TAdvShape; Step_25: TAdvShape; Step_26: TAdvShape; pnlSynapses: TGroupBox; Synapse_1: TAdvShape; Synapse_2: TAdvShape; Synapse_3: TAdvShape; Synapse_4: TAdvShape; Synapse_5: TAdvShape; Synapse_6: TAdvShape; Synapse_7: TAdvShape; Synapse_8: TAdvShape; Synapse_9: TAdvShape; Synapse_10: TAdvShape; Synapse_11: TAdvShape; Synapse_12: TAdvShape; Synapse_13: TAdvShape; Synapse_14: TAdvShape; Synapse_15: TAdvShape; Synapse_16: TAdvShape; Synapse_17: TAdvShape; Synapse_18: TAdvShape; Synapse_19: TAdvShape; Synapse_20: TAdvShape; Synapse_21: TAdvShape; Synapse_22: TAdvShape; Synapse_23: TAdvShape; Synapse_24: TAdvShape; Synapse_25: TAdvShape; Synapse_26: TAdvShape; Synapse_27: TAdvShape; Synapse_28: TAdvShape; Synapse_29: TAdvShape; Synapse_30: TAdvShape; Synapse_31: TAdvShape; Synapse_32: TAdvShape; Synapse_33: TAdvShape; Synapse_34: TAdvShape; Synapse_35: TAdvShape; Synapse_36: TAdvShape; Synapse_37: TAdvShape; Synapse_38: TAdvShape; Synapse_39: TAdvShape; Synapse_40: TAdvShape; Synapse_41: TAdvShape; Synapse_42: TAdvShape; Synapse_43: TAdvShape; Synapse_44: TAdvShape; Synapse_45: TAdvShape; Synapse_46: TAdvShape; Synapse_47: TAdvShape; Synapse_48: TAdvShape; Synapse_49: TAdvShape; Synapse_50: TAdvShape; Synapse_51: TAdvShape; pnlSomas: TGroupBox; Soma_1: TAdvShape; Soma_2: TAdvShape; Soma_3: TAdvShape; Soma_4: TAdvShape; Soma_5: TAdvShape; Soma_6: TAdvShape; Soma_7: TAdvShape; Soma_8: TAdvShape; Soma_9: TAdvShape; Soma_10: TAdvShape; Soma_11: TAdvShape; pnlDendrites: TGroupBox; Dendrite_1: TAdvShape; Dendrite_2: TAdvShape; Dendrite_3: TAdvShape; Dendrite_4: TAdvShape; Dendrite_5: TAdvShape; Dendrite_6: TAdvShape; Dendrite_7: TAdvShape; Dendrite_8: TAdvShape; Dendrite_9: TAdvShape; Dendrite_10: TAdvShape; Dendrite_11: TAdvShape; Dendrite_12: TAdvShape; Dendrite_13: TAdvShape; Dendrite_14: TAdvShape; Dendrite_15: TAdvShape; Dendrite_16: TAdvShape; Dendrite_17: TAdvShape; Dendrite_18: TAdvShape; Dendrite_19: TAdvShape; Dendrite_20: TAdvShape; Dendrite_21: TAdvShape; Dendrite_22: TAdvShape; Dendrite_23: TAdvShape; Dendrite_24: TAdvShape; Dendrite_25: TAdvShape; Dendrite_26: TAdvShape; Dendrite_27: TAdvShape; Dendrite_28: TAdvShape; Dendrite_29: TAdvShape; Dendrite_30: TAdvShape; Dendrite_31: TAdvShape; Dendrite_32: TAdvShape; Dendrite_33: TAdvShape; Dendrite_34: TAdvShape; Dendrite_35: TAdvShape; Dendrite_36: TAdvShape; Dendrite_37: TAdvShape; Dendrite_38: TAdvShape; Dendrite_39: TAdvShape; Dendrite_40: TAdvShape; Dendrite_41: TAdvShape; Dendrite_42: TAdvShape; Dendrite_43: TAdvShape; Dendrite_44: TAdvShape; Dendrite_45: TAdvShape; Dendrite_46: TAdvShape; Dendrite_47: TAdvShape; Dendrite_48: TAdvShape; Dendrite_49: TAdvShape; Dendrite_50: TAdvShape; Dendrite_51: TAdvShape; pnlScopes: TGroupBox; Scope_Blue: TAdvShape; Scope_Black: TAdvShape; Scope_Red: TAdvShape; Scope_Green: TAdvShape; Grid: TAdvStringGrid; pnlAxons: TGroupBox; Axon_1: TAdvShape; Axon_2: TAdvShape; Axon_3: TAdvShape; Axon_4: TAdvShape; Axon_5: TAdvShape; Axon_6: TAdvShape; Axon_7: TAdvShape; Axon_8: TAdvShape; Axon_9: TAdvShape; Axon_10: TAdvShape; Axon_11: TAdvShape; Axon_12: TAdvShape; Axon_13: TAdvShape; Axon_14: TAdvShape; Axon_15: TAdvShape; Axon_16: TAdvShape; Axon_17: TAdvShape; Axon_18: TAdvShape; Axon_19: TAdvShape; Axon_20: TAdvShape; Axon_21: TAdvShape; Axon_22: TAdvShape; Axon_23: TAdvShape; Axon_24: TAdvShape; Axon_25: TAdvShape; Axon_26: TAdvShape; FormatDialog1: TFormatDialog; dlgLoadPlan: TOpenDialog; File1: TMenuItem; mnuClearScreen: TMenuItem; DeletePlan: TMenuItem; sbBodyPlan: TStatusBar; btnTest: TButton; ledTest: TJvLED; pnlField: TRzPanel; nsRow: TAbNumSpin; PropSaveFile1: TPropSaveFile; PropSaveMain1: TPropSaveMain; GridsPropSave1: TGridsPropSave; STDP: TMenuItem; mnuBiopysics: TMenuItem; mnuSTDP: TMenuItem; moBodyPlanName: TMemo; mnuLog: TMenuItem; btnConnect: TButton; { Set up a shape for dragging } procedure mnuAboutClick(Sender: TObject); procedure mnuSoundClick(Sender: TObject); procedure mnuHintsClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnLoadFromFileClick(Sender: TObject); procedure btnSavetoFileClick(Sender: TObject); procedure pnlFieldDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure pnFieldDragDrop(Sender, Source: TObject; X, Y: Integer); procedure pnlFieldMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); function IconWithinGroupBox(Icon: TAdvShape; GroupBox: TGroupBox): Boolean; procedure FormActivate(Sender: TObject); procedure mnuResetClick(Sender: TObject); procedure mnuNeuronSelectClick(Sender: TObject); procedure mnuIPSPClick(Sender: TObject); procedure EndDrag(Sender, Target: TObject; X, Y: Integer); procedure GridCanClickCell(Sender: TObject; ARow, ACol: Integer; var Allow: Boolean); procedure GridDblClickCell(Sender: TObject; ARow, ACol: Integer); procedure btnClearClick(Sender: TObject); procedure GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnRemoveRowsClick(Sender: TObject); procedure btnSelectRowsClick(Sender: TObject); procedure GridRowUpdate(Sender: TObject; OldRow, NewRow: Integer); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure mnuCellsIonsClick(Sender: TObject); procedure mnuIonicCurrentClick(Sender: TObject); procedure mnuNeuronSimulatorClick(Sender: TObject); procedure mnuDendritesClick(Sender: TObject); procedure mnuSomaClick(Sender: TObject); procedure mnuAxonClick(Sender: TObject); procedure mnuNeuronClick(Sender: TObject); procedure AdvGlassButton1Click(Sender: TObject); procedure mnuGridClick(Sender: TObject); procedure eMailMe1Click(Sender: TObject); procedure pnlDragDrop(Sender, Source: TObject; X, Y: Integer); procedure gbStepsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure mnuExitClick(Sender: TObject); procedure IconMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure IconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure IconMouseLeave(Sender: TObject); procedure pnlScopesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure pnlStepsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure pnlSynapsesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure pnlDendritesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure pnlSomasDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure pnlAxonsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Exit1Click(Sender: TObject); procedure mnuClearScreenClick(Sender: TObject); procedure mnuLoadPlanClick(Sender: TObject); procedure mnuSavePlanAsClick(Sender: TObject); procedure DeletePlanClick(Sender: TObject); procedure GridDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure GridEndDrag(Sender, Target: TObject; X, Y: Integer); procedure GridDragDrop(Sender, Source: TObject; X, Y: Integer); procedure GridAutoDeleteRow(Sender: TObject; ARow: Integer); procedure pnlFieldMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormDestroy(Sender: TObject); procedure pnlFieldMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure pnlFieldPaint(Sender: TObject); procedure GridsPropSave1GetKeyString(Comp: TComponent; var Key: string); procedure pnlFieldMouseEnter(Sender: TObject); procedure FormResize(Sender: TObject); procedure mnuSeeClick(Sender: TObject); procedure popDragClick(Sender: TObject); procedure popChangeClick(Sender: TObject); procedure mnuDisableEnablethruSetup1Click(Sender: TObject); procedure mnuDCEClick(Sender: TObject); procedure mnuBiopysicsClick(Sender: TObject); procedure mnuSTDPClick(Sender: TObject); procedure btnTestClick(Sender: TObject); procedure moBodyPlanNameChange(Sender: TObject); procedure mnuLogClick(Sender: TObject); procedure btnConnectClick(Sender: TObject); private { Private declarations } MessageID: Integer; Fa: Single; Fb: Single; Fc: Single; Fk: Single; FVt_mV: Single; Fd: Single; FVpeak_mV: Single; FReset_mV: Single; FCap_uF: Single; FTick: Integer; FSomaType: Integer; FTopRow: Integer; // BodyPlanDirectory: string; FMode: Boolean; SourceIcon: TSourceIcon; SinkIcon: TSinkIcon; // CloseAndRestart: Boolean; FoundSource, FoundSink: Boolean; ptStart, ptEnd: TPoint; FCapturing: Boolean; BodyPlanName: String; Log: ILogWriter; function getGridBottomRow: Integer; procedure setGridBottomRow(value: Integer); procedure DisplayHint(Sender: TObject); function getRow: Integer; procedure setRow(value: Integer); function SetGridSourceSink(Icon: TAdvShape; Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; procedure ClearScreen; function IconWithinRegion(Icon: TAdvShape; RectTop, Rectleft, RectBottom, RectRight: Integer): Boolean; procedure GridMoveStuff; procedure GridFix; // C L I C K Property DragMode: Boolean read FMode write FMode; Property Row: Integer read getRow write setRow; Property GridBottomRow: Integer read getGridBottomRow write setGridBottomRow; public { Public declarations } // MembraneSpecific_Ohm2cM: Single; // = 10000; // ohm / cm^2 MembraneCapSpecific_F2cM: Single; // = 1E-6; // Frad / cm^2 MembraneAxialSpecific_OhmcM: Single; // = 100; // ohm * cm SourceRow, SourceCol: Integer; bool: Boolean; QualifiedWorkingIniFileName: string; intTest: Integer; BodyPartForm: TForm; generalPtr: Pointer; // A pointer to anything formPtr: ^TForm; // A pointer to a form object cont: TControl; ScopeBlueLast: Single; FStep1: Single; FStep2: Single; FDendrite1: Single; FDendrite2: Single; FsliderRangePositionRight: Integer; slIconNames: TStringList; FirstTime: Boolean; ScopeBottom: Integer; Paused: Boolean; MsgID: Integer; function SameFamily(CkName1, CkName2: String): Boolean; Procedure LogEvent(msg: String); function Family(CkName: String): String; Procedure setParentage(); procedure RenumberGrid; procedure RemoveEntry(ComponentName: String); procedure LoadGrid(StringGrid: TStringGrid; const FileName: TFileName); procedure SaveGrid(StringGrid: TStringGrid; const FileName: TFileName); function getConnection(index: Integer): TConnect; function InMyForms(FormName: String): Boolean; function SendMessageToCtrl(const Name: string; const msg: Cardinal; WParam, LParam: Integer): Boolean; procedure Dispatcher; procedure SendReset(ResetX, ResetY: Boolean); Procedure DrawWires; procedure AddGridRow(StringGrid: TStringGrid; aPos: Integer); procedure PositionScopeIcon(IconName: String); Procedure SetSmallestIconToFront(Panel: TGroupBox); function SourceFamilyIS(CkName: String): Boolean; function SinkFamilyIS(CkName: String): Boolean; property a: Single read Fa write Fa; property k: Single read Fk write Fk; property Vt_mV: Single read FVt_mV write FVt_mV; // most at -40mV property b: Single read Fb write Fb; property d: Single read Fd write Fd; property VPeak_mV: Single read FVpeak_mV write FVpeak_mV; property c: Single read Fc write Fc; property Vr_mV: Single read FReset_mV write FReset_mV; property Cap_uF: Single read FCap_uF write FCap_uF; property Tick: Integer read FTick write FTick; property SomaType: Integer read FSomaType write FSomaType; property Capturing: Boolean read FCapturing write FCapturing; end; var frmBodyPlan: TfrmBodyPlan; implementation {$R *.dfm} uses uOscilloscope, uAbout, uBiophysics, uIPSP, uNeuronSelect, ShellApi, SDL_StringL; {$REGION ' C R E A T E '} procedure TfrmBodyPlan.FormCreate(Sender: TObject); var DirPath: String; begin Cap_uF := 100; mnuHints.Checked := true; // TDirectory.CreateDirectory(CBodyPlanDirectory); DragMode := true; ControlStyle := ControlStyle + [csDisplayDragImage]; Caption := 'S E T I N e t NeuronLab Simulator ' + ' (' + IntToStr(SizeOf(Pointer) * 8) + ' Bit)'; {$IF Defined(EUREKALOG)} Caption := Caption + (' + EurekaLog '); {$IFEND} if (IsDebuggerPresent = true) Then Caption := Caption + ' -- D E L P H I -- '; {$IF Defined(PROFILE)} Caption := Caption + (' --- P R O F I L I N G --- '); {$IFEND} // setParentage; // Set all the icons that are not in group boxes to have frmField parentage Grid.RowCount := RowMax; mnuHintsClick(self); begin // Setup the dialogs. dlgLoadPlan.InitialDir := GetCurrentDir; dlgSaveAsPlan.InitialDir := GetCurrentDir; dlgDeletePlan.InitialDir := GetCurrentDir; { Initialize the dialog filters to open/save *.txt files and also files with arbitrary extension. } dlgLoadPlan.Filter := 'BodyPlan files (*.pln)|*.PLN|Any file (*.*)|*.*'; dlgSaveAsPlan.Filter := 'BodyPlan files (*.pln)|*.PLN|Any file (*.*)|*.*'; dlgSaveAsPlan.DefaultExt := 'pln'; end; Grid.Width := 190; Grid.AutoNumberOffset := 1; Grid.autonumbercol(0); Grid.ColWidths[0] := 30; Grid.ColWidths[1] := 70; Grid.ColWidths[2] := 70; Grid.ColWidths[3] := 40; Grid.Navigation.AdvanceDirection := adTopBottominCol; Grid.Navigation.AdvanceInsert := true; Grid.ColumnHeaders.Add('#'); Grid.ColumnHeaders.Add('Source'); Grid.ColumnHeaders.Add('Sink'); Grid.ColumnHeaders.Add('ISPS'); Grid.ColumnHeaders.Add('SourcePort'); Grid.ColumnHeaders.Add('Source X'); Grid.ColumnHeaders.Add('Source Y'); Grid.ColumnHeaders.Add('SinkPort'); Grid.ColumnHeaders.Add('Sink X'); Grid.ColumnHeaders.Add('Sink Y'); Grid.Navigation.AllowDeleteRow := true; Grid.DragMode := dmManual; // Grid Drag Drop Step 1 on RenumberGrid; Row := 1; rollBodyParts.Collapsed := false; pnlField.Color := clSkyBlue; FormsRegister; // setParentage; // Set all the icons that are not in group boxes to have frmField parentage FirstTime := true; ScopeBottom := 1; FCapturing := false; MessageID := 1; DirPath := 'logs'; {$IF Defined(Loger)} if TDirectory.Exists(DirPath) then // Clear old log directory TDirectory.Delete(DirPath, true); Log := BuildLogWriter([TLoggerProFileAppender.Create(5, 2000, 'logs')]); {$IFEND} MsgID := 0; end; procedure TfrmBodyPlan.LogEvent(msg: string); begin {$IF Defined(Loger)} if mnuLog.Checked then Log.Info(msg, 'UI'); {$IFEND} end; procedure TfrmBodyPlan.FormDestroy(Sender: TObject); begin // UnHookWindowsHookEx(KBHook); end; // Create {$ENDREGION} // function KeyboardHookProc(Code: Integer; WordParam: Word; LongParam: LongInt): LongInt; // var // State: TKeyboardState; begin; // GetKeyboardState(State); // if ((State[vk_Shift] and 128) = 0) then // frmGroupSet.Detach; // Result := 1; end; // function TfrmBodyPlan.IconWithinRegion(Icon: TAdvShape; RectTop, Rectleft, RectBottom, RectRight: Integer): Boolean; var TopBottom, LeftRight: Boolean; // IconName: String; begin Result := false; // IconName := Icon.Name; TopBottom := (Icon.Top > RectTop) AND (Icon.Top + Icon.height < RectBottom); LeftRight := (Icon.Left > Rectleft) AND (Icon.Left + Icon.Width < RectRight); Result := (TopBottom = true) AND (LeftRight = true); end; {$REGION ' G e t / Set '} procedure TfrmBodyPlan.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin ShowMessage('in ON KEYUP '); end; procedure TfrmBodyPlan.FormResize(Sender: TObject); begin DrawWires; end; function TfrmBodyPlan.getGridBottomRow: Integer; var i: Integer; begin for i := 1 to RowMax - 1 do // Find Top entries begin if ((Grid.Cells[CSource, i] = '') OR (Grid.Cells[CSink, i] = '')) then begin Result := i; break; end; end; end; procedure TfrmBodyPlan.setGridBottomRow(value: Integer); begin FTopRow := value; end; {$ENDREGION} // {$REGION ' D R A W W I R E S'} Procedure TfrmBodyPlan.DrawWires; var testSource, testSink: String; i: Integer; // SourceIcon, SinkIcon: TAdvShape; SourceIconLeft, SourceIconWidth, SourceIconMiddle: Integer; SinkIconLeft, SinkIconMiddle: Integer; SourceIcon, SinkIcon: TAdvShape; begin pnlField.Repaint; pnlField.Canvas.Pen.Color := clBlack; for i := 1 to Grid.RowCount - 1 do begin testSource := Grid.Cells[1, i]; testSink := Grid.Cells[2, i]; // if ((Grid.Cells[CSource, i] <> '') AND (Grid.Cells[CSink, i] <> '')) then if NOT((testSource = '') OR (testSink = '')) then begin SourceIcon := FindComponent(Grid.Cells[CSource, i]) as TAdvShape; SinkIcon := FindComponent(Grid.Cells[CSink, i]) as TAdvShape; if Grid.Cells[CISPSCol, i] = Yes then pnlField.Canvas.Pen.Color := clRed else pnlField.Canvas.Pen.Color := clBlack; SourceIconLeft := SourceIcon.Left; SourceIconWidth := SourceIcon.Width; SourceIconMiddle := SourceIcon.Top + (SourceIcon.height DiV 2); SinkIconLeft := SinkIcon.Left; SinkIconMiddle := SinkIcon.Top + (SinkIcon.height DIV 2); pnlField.Canvas.MoveTo(SourceIconLeft + SourceIconWidth, SourceIconMiddle); pnlField.Canvas.LineTo(SinkIconLeft, SinkIconMiddle); end; end; end; {$ENDREGION} // {$REGION ' M E N U S '} procedure TfrmBodyPlan.DeletePlanClick(Sender: TObject); begin if dlgDeletePlan.Execute then begin TFile.Delete(dlgDeletePlan.FileName); end; end; procedure TfrmBodyPlan.eMailMe1Click(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/bootstrap/recaptcha/contact_form.html'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuAxonClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/6.%20Axon/Axon.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuCellsIonsClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/1.%20Cells%20and%20Ions/Cells%20and%20Ions.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuSTDPClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/8.%20STDP/STDP.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.moBodyPlanNameChange(Sender: TObject); var str: String; begin str := ExtractFileName(moBodyPlanName.Lines[0]); str := moBodyPlanName.Lines[0]; sbBodyPlan.Panels[CsbBodyPlan].Text := moBodyPlanName.Lines[0]; end; procedure TfrmBodyPlan.mnuDendritesClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/4.%20Synapse%20and%20Dendrites/SynapseAndDendrites.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuSomaClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/5.%20Soma/Soma.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuIonicCurrentClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/2.%20Ionic%20Current/IonicCurrent.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuNeuronSimulatorClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://www.seti.net/Neuron%20Lab/3.%20NeuronLab%20Simulator/NeuronLab%20Simulator.php'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuSavePlanAsClick(Sender: TObject); begin if dlgSaveAsPlan.Execute then begin moBodyPlanName.Lines.Text := ExtractFileName(dlgSaveAsPlan.FileName); PropSaveMain1.SaveProperties; Sleep(1000); // PropSaveFile1.DisableAll := true; PropSaveFile1.SaveFile(dlgSaveAsPlan.FileName); BodyPlanName := ExtractFileName(dlgSaveAsPlan.FileName); // moBodyPlanName.Lines.Text := BodyPlanName; end; end; procedure TfrmBodyPlan.mnuLoadPlanClick(Sender: TObject); begin if dlgLoadPlan.Execute then begin // if IsDebuggerPresent then if false then begin PropSaveFile1.DisableAll := true; TFile.Copy(dlgLoadPlan.FileName, 'default.ini', true); // ShellExecute(Application.HANDLE, 'Open', PChar(Application.ExeName), nil, nil, SW_NORMAL); // sbBodyPlan.Panels[CsbBodyPlan].Text := ExtractFileName(dlgLoadPlan.FileName); BodyPlanName := ExtractFileName(dlgLoadPlan.FileName); ShowMessage('Jim - Your debugging so it Requires Restart...'); Close; end else begin moBodyPlanName.Lines.Text := ExtractFileName(dlgLoadPlan.FileName); PropSaveFile1.DisableAll := true; TFile.Copy(dlgLoadPlan.FileName, 'default.ini', true); BodyPlanName := moBodyPlanName.Lines.Text; BodyPlanName := ExtractFileName(dlgLoadPlan.FileName); // moBodyPlanName.Lines.Text := BodyPlanName; ShellExecute(HANDLE, nil, PChar(Application.ExeName), nil, nil, SW_SHOWNORMAL); Close; end; end; end; procedure TfrmBodyPlan.mnuLogClick(Sender: TObject); var directoryPath: String; begin {$IF Defined(Loger)} if mnuLog.Checked then begin if TDirectory.Exists(directoryPath) then // Clear old log directory TDirectory.Delete(directoryPath, true); Log := BuildLogWriter([TLoggerProFileAppender.Create(5, 2000, 'logs')]); end; {$IFEND} end; procedure TfrmBodyPlan.mnuAboutClick(Sender: TObject); begin frmAbout := TfrmAbout.Create(self); frmAbout.ShowVersion; frmAbout.Show; end; procedure TfrmBodyPlan.mnuBiopysicsClick(Sender: TObject); begin frmBiophysics.Visible := NOT frmBiophysics.Visible; if frmBiophysics.Visible then begin // frmBiophysics.Parent := frmBodyPlan; frmBiophysics.Left := frmBodyPlan.Left + 500; frmBiophysics.Top := frmBodyPlan.Top + 400; frmBiophysics.BringToFront; end; end; procedure TfrmBodyPlan.popChangeClick(Sender: TObject); begin popDrag.Checked := false; popChange.Checked := true; sbBodyPlan.Panels[CsbMessage].Text := ' Now in Change Mode'; // frmClone.Visible := true; end; procedure TfrmBodyPlan.mnuSeeClick(Sender: TObject); begin // popDrag.Checked := false; // frmClone.Visible := false; // // if popChange.Checked then // frmClone.Visible := true; // popChange.Checked := false; end; procedure TfrmBodyPlan.mnuClearScreenClick(Sender: TObject); begin ClearScreen; SetSmallestIconToFront(pnlAxons); SetSmallestIconToFront(pnlDendrites); SetSmallestIconToFront(pnlSomas); SetSmallestIconToFront(pnlSteps); SetSmallestIconToFront(pnlSynapses); TFile.Delete('default.ini'); end; procedure TfrmBodyPlan.mnuDisableEnablethruSetup1Click(Sender: TObject); begin popDragChange.AutoPopup := false; end; procedure TfrmBodyPlan.mnuDCEClick(Sender: TObject); begin ShowMessage('This function disabled for a bit'); // popDragChange.AutoPopup := true; end; procedure TfrmBodyPlan.popDragClick(Sender: TObject); begin // popDrag.Checked := true; // // Capturing := True; // Jim - Cannot do this // popChange.Checked := false; // sbBodyPlan.Panels[CsbMessage].Text := ' Now In Drag Mode'; // frmClone.Visible := false; end; procedure TfrmBodyPlan.mnuExitClick(Sender: TObject); begin Close; end; procedure TfrmBodyPlan.mnuGridClick(Sender: TObject); begin Grid.Visible := NOT Grid.Visible; end; procedure TfrmBodyPlan.mnuSoundClick(Sender: TObject); begin ShowMessage('Sounds are TBD'); end; procedure TfrmBodyPlan.mnuHintsClick(Sender: TObject); begin if mnuHints.Checked then begin mnuHints.Checked := false; frmBodyPlan.ShowHint := mnuHints.Checked; sbBodyPlan.Panels[CsbMessage].Text := ' Control HINTS from HELP Menu'; end else mnuHints.Checked := true; Application.OnHint := DisplayHint; frmBodyPlan.ShowHint := mnuHints.Checked; end; procedure TfrmBodyPlan.mnuIPSPClick(Sender: TObject); begin frmIPSP.Show; end; procedure TfrmBodyPlan.mnuResetClick(Sender: TObject); begin ClearScreen; end; procedure TfrmBodyPlan.mnuNeuronClick(Sender: TObject); begin ShellExecute(HANDLE, 'OPEN', PChar('https://tinyurl.com/yckrvndx'), nil, nil, SW_SHOWNORMAL); end; procedure TfrmBodyPlan.mnuNeuronSelectClick(Sender: TObject); begin frmNeuronSelect.Show; end; {$ENDREGION} // procedure TfrmBodyPlan.PositionScopeIcon(IconName: String); const allWidth = 50; Margin = 2; FirstRowTop = 20; SecondRowTop = FirstRowTop + 25; begin if IconName = 'Scope_Blue' then with Scope_Blue do begin Parent := pnlScopes; Left := pnlScopes.Left + Margin; Top := FirstRowTop; Width := allWidth; end; if IconName = 'Scope_Black' then with Scope_Black do begin Parent := pnlScopes; Left := pnlScopes.Left + Margin + allWidth + Margin; Top := FirstRowTop; Width := allWidth; end; if IconName = 'Scope_Red' then with Scope_Red do begin Parent := pnlScopes; Left := pnlScopes.Left + Margin; Top := SecondRowTop + Margin; Width := allWidth; end; if IconName = 'Scope_Green' then With Scope_Green do begin Parent := pnlScopes; Left := pnlScopes.Left + Margin + allWidth + Margin; Top := SecondRowTop + Margin; Width := allWidth; end; end; Procedure TfrmBodyPlan.SetSmallestIconToFront(Panel: TGroupBox); var InString: String; numControls: Integer; i: Integer; Smallest: TControl; SmallestName: String; SmallestNumberString: String; InNumString: String; str: String; function RemoveNonNumbers(const s: string): string; var i: Integer; begin Result := s; for i := Length(Result) downto 1 do begin if not(Result[i] in ['0' .. '9']) then Delete(Result, i, 1); end; end; begin numControls := Panel.ControlCount; str := Panel.Name; if numControls = 0 then exit; Smallest := Panel.Controls[0]; for i := 0 to numControls - 1 do begin InString := Panel.Controls[i].Name; InNumString := RemoveNonNumbers(InString); if InNumString = '' then break; SmallestNumberString := RemoveNonNumbers(Smallest.Name); If StrToInt(InNumString) < StrToInt(SmallestNumberString) then begin Smallest := Panel.Controls[i]; SmallestName := Smallest.Name; end; end; Smallest.BringToFront; Delete(str, 1, 3); if numControls > 0 then Panel.Caption := str + ' [' + IntToStr(numControls) + ']'; end; function TfrmBodyPlan.SameFamily(CkName1, CkName2: String): Boolean; var In1, In2: String; HH: String; begin HH := CkName1; if Pos('_', CkName1) > 0 then In1 := Trim(UpperCase(Copy(CkName1, 1, Pos('_', CkName1) - 1))) else In1 := Trim(UpperCase(CkName1)); if Pos('_', CkName2) > 0 then In2 := Trim(UpperCase(Copy(CkName2, 1, Pos('_', CkName2) - 1))) else In2 := Trim(UpperCase(CkName2)); In1 := ReplaceStringInString(In1, 'HH', ' ', true); // All SOMAHH_99 to be moved Result := Trim(In1) = Trim(In2); end; procedure TfrmBodyPlan.ClearScreen; (* RESET Plan *) var i: Integer; AdvShape: TAdvShape; begin i := pnlField.ControlCount; while i > 0 do begin if pnlField.Controls[i - 1].ClassType = TAdvShape then begin AdvShape := TAdvShape(pnlField.Controls[i - 1]); if SameFamily(AdvShape.Name, 'Axon') then AdvShape.Parent := pnlAxons; if SameFamily(AdvShape.Name, 'Dendrite') then AdvShape.Parent := pnlDendrites; if SameFamily(AdvShape.Name, 'Soma') then AdvShape.Parent := pnlSomas; if SameFamily(AdvShape.Name, 'Step') then AdvShape.Parent := pnlSteps; if SameFamily(AdvShape.Name, 'Synapse') then AdvShape.Parent := pnlSynapses; if SameFamily(AdvShape.Name, 'Scope') then AdvShape.Parent := pnlScopes; AdvShape.Top := 32; AdvShape.height := 21; AdvShape.Left := 5; RemoveEntry(AdvShape.Name); end; i := i - 1; end; DrawWires; end; procedure TfrmBodyPlan.DisplayHint(Sender: TObject); begin sbBodyPlan.Panels[CsbMessage].Text := GetLongHint(Application.Hint); end; function TfrmBodyPlan.IconWithinGroupBox(Icon: TAdvShape; GroupBox: TGroupBox): Boolean; var TL, TR, BL, BR: Boolean; IconName: String; begin IconName := Icon.Name; // if TOP LEFT icon inside panel TL := (Icon.Top >= GroupBox.Top) AND (Icon.Top <= GroupBox.Top + GroupBox.height) AND (Icon.Left >= GroupBox.Left) AND (Icon.Left <= GroupBox.Left + GroupBox.Width); // if TOP RIGHT icon inside panel TR := (Icon.Top >= GroupBox.Top) AND (Icon.Top <= GroupBox.Top + GroupBox.height) AND (Icon.Left + Icon.Width >= GroupBox.Left) AND (Icon.Left + Icon.Width <= GroupBox.Left + GroupBox.Width); // if BOTTOM LEFT icon inside panel BL := (Icon.Top + Icon.height >= GroupBox.Top) AND (Icon.Top + Icon.height <= GroupBox.Top + GroupBox.height) AND (Icon.Left >= GroupBox.Left) AND (Icon.Left <= GroupBox.Left + GroupBox.Width); // if BOTTOM RIGHT icon inside panel BR := (Icon.Top + Icon.height >= GroupBox.Top) AND (Icon.Top + Icon.height <= GroupBox.Top + GroupBox.height) AND (Icon.Left + Icon.Width >= GroupBox.Left) AND (Icon.Left + Icon.Width <= GroupBox.Left + GroupBox.Width); Result := (TL) AND (TR) AND (BL) AND (BR); end; // D i s p a t c h e r procedure TfrmBodyPlan.SendReset(ResetX, ResetY: Boolean); var i: Integer; ARow: TConnect; SourceForm, SinkForm: TForm; ResetMessage: TresetMessage; RstX, RstY: Boolean; begin MsgID := MsgID + 1; RstX := ResetX; RstY := ResetY; ResetMessage.ResetX := RstX; ResetMessage.ResetY := RstY; i := 1; ARow := frmBodyPlan.getConnection(i); while ((ARow.Source <> '') AND (ARow.Sink <> '')) do begin ResetMessage.ID := MsgID; SourceForm := CreateForm(ARow.Source); (SourceForm as TControl).Perform(WM_ResetFunction, 0, NativeInt(@ResetMessage)); MsgID := MsgID + 1; ResetMessage.ID := MsgID; SinkForm := CreateForm(ARow.Sink); (SinkForm as TControl).Perform(WM_ResetFunction, 0, NativeInt(@ResetMessage)); i := i + 1; ARow := frmBodyPlan.getConnection(i); MsgID := MsgID + 1; end; MsgID := 0; end; procedure TfrmBodyPlan.Dispatcher; var i: Integer; ARow: TConnect; SetMessage: TSetMessage; SourceTag, SinkTag: TTagRec; SourceForm, SinkForm: TForm; begin i := 1; ARow := frmBodyPlan.getConnection(i); // Get first table entry after the header while ((ARow.Source <> '') AND (ARow.Sink <> '')) do // Make sure a row has been filled begin // ********************************** Message Part A * S E N D ***************************** SourceForm := CreateForm(ARow.Source); SinkForm := CreateForm(ARow.Sink); SinkTag := PTagRec(SinkForm.Tag)^; SetMessage.command := Send; SetMessage.SinkInput_Ohm := SinkTag.Membrane_Ohm; // so source can convert I to V SetMessage.SourceName := ARow.Source; SetMessage.SinkName := ARow.Sink; SetMessage.Tick := Tick; // MsgID := MsgID + 1; // SetMessage.ID := MsgID; (SourceForm as TControl).Perform(WM_setFunction, 0, NativeInt(@SetMessage)); // TimeSend := FormatDateTime('[hh:nn:ss.zzz]', Now); // ********************************** End Message Part A ******************************* // Sleep(10 ); // MsgID := MsgID + 1; // ********************************** Message Part B *** R E C E I V E *************************** SourceTag := PTagRec(SourceForm.Tag)^; // Pick up the Source new result output SetMessage.command := Receive; // if Grid.Cells[CSourcePort, i] = '1' then // If port One selected // SetMessage.Input_mV := SourceTag.RecoveryOut_mA // Send the Uout variable // else SetMessage.Input_mV := SourceTag.Membrane_mV; // Send the membrain voltage and send it to the Sink SetMessage.SourceName := ARow.Source; SetMessage.SinkName := ARow.Sink; SetMessage.Tick := Tick; if Grid.Cells[3, i] = Yes then SetMessage.IPSP := true else SetMessage.IPSP := false; // SetMessage.ID := MsgID; (SinkForm as TControl).Perform(WM_setFunction, 0, NativeInt(@SetMessage)); // TimeReceive := FormatDateTime('[hh:nn:ss.zzz]', Now); // ********************************* End Message Part B ******************************** i := i + 1; ARow := frmBodyPlan.getConnection(i); end; end; Procedure TfrmBodyPlan.setParentage(); // Set the Owner based on the panel that the icon is in var AdvShapeParentName: String; X: Integer; ComponentCount: Integer; Component: TComponent; ComponentName: String; ComponentParentName1: String; begin ComponentCount := frmBodyPlan.ComponentCount; for X := 0 to ComponentCount - 1 do begin Component := frmBodyPlan.Components[X]; ComponentName := Component.Name; if Component.ClassType = TAdvShape then begin ComponentParentName1 := TControl(Component).Parent.Name; if ((Not(IconWithinGroupBox(TAdvShape(Component), pnlSteps))) AND (Not(IconWithinGroupBox(TAdvShape(Component), pnlDendrites))) AND (Not(IconWithinGroupBox(TAdvShape(Component), pnlSomas))) AND (Not(IconWithinGroupBox(TAdvShape(Component), pnlAxons))) AND (Not(IconWithinGroupBox(TAdvShape(Component), pnlScopes)))) then begin TControl(Component).Parent := pnlField; if NOT ContainsText(Component.Name, 'Scope') then // Jim Where form should be initiated. begin // Form := CreateForm(Component.Name); // Jim - Where is the magic (the old Visible := True/false? end; end else Begin AdvShapeParentName := TControl(Component).Parent.Name; End; end; end; end; function TfrmBodyPlan.SendMessageToCtrl(const Name: string; const msg: Cardinal; WParam, LParam: Integer): Boolean; var Idx: Integer; Ctrl: TControl; begin Result := false; // scan all components owned by the form for Idx := 0 to Pred(ComponentCount) do begin if Components[Idx] is TControl then begin // we have a TControl: check its name (case insensitive) Ctrl := Components[Idx] as TControl; if SameText(Ctrl.Name, Name) then begin // found it: send message and bail out ShowMessage('why am i in SendMessageToCtrl Jim'); (Ctrl as TControl).Perform(WM_setFunction, 0, 0); Result := true; exit; end; end; end; end; function TfrmBodyPlan.InMyForms(FormName: String): Boolean; var i, j: Integer; begin Result := false; for i := 0 to Application.ComponentCount - 1 do if Application.Components[i] is TForm then begin FormName := Application.Components[i].Name; for j := Low(myFormsNames) to High(myFormsNames) do if FormName = myFormsNames[j] then begin Result := true; exit; end; end; end; function TfrmBodyPlan.getConnection(index: Integer): TConnect; begin if index <= RowMax then begin Result.Source := Grid.Cells[1, index]; Result.Sink := Grid.Cells[2, index]; end; // end; procedure TfrmBodyPlan.FormActivate(Sender: TObject); var i: Integer; Shape: TControl; ShapeName: String; Form: TForm; begin if FirstTime then // JIM - THE TRICK HERE begin FirstTime := false; setParentage; // Set all the icons that are not in group boxes to have frmField parentage Application.OnHint := DisplayHint; // This stuff first. pnlField.Color := clSkyBlue; DrawWires; for i := 0 to pnlField.ControlCount - 1 do // JIM - THE TRICK HERE begin Shape := pnlField.Controls[i]; ShapeName := Shape.Name; Form := CreateForm(ShapeName); Form.WindowState := wsMinimized; Form.Visible := true;; Form.Visible := false; Form.WindowState := wsNormal; // End Trick end; SetSmallestIconToFront(pnlAxons); SetSmallestIconToFront(pnlDendrites); SetSmallestIconToFront(pnlSomas); SetSmallestIconToFront(pnlSteps); SetSmallestIconToFront(pnlSynapses); end; // str := moBodyPlanName.i.Lines.Text; BodyPlanName := moBodyPlanName.Lines.Text; end; procedure TfrmBodyPlan.RenumberGrid; var i: Integer; begin with Grid do begin for i := 1 to RowCount + 1 do Cells[0, i] := IntToStr(i); end; end; function TfrmBodyPlan.getRow: Integer; begin Result := Grid.Row; end; procedure TfrmBodyPlan.setRow(value: Integer); begin if value <> 0 then Grid.Row := value; end; procedure TfrmBodyPlan.pnlScopesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := SameFamily((Source as TComponent).Name, 'Scope'); end; procedure TfrmBodyPlan.pnlSomasDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := SameFamily((Source as TComponent).Name, 'Soma'); end; procedure TfrmBodyPlan.pnlStepsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := SameFamily((Source as TComponent).Name, 'Step'); end; procedure TfrmBodyPlan.pnlSynapsesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := SameFamily((Source as TComponent).Name, 'Synapse'); end; procedure TfrmBodyPlan.pnlAxonsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := SameFamily((Source as TComponent).Name, 'Axon'); end; procedure TfrmBodyPlan.pnlDendritesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := SameFamily((Source as TComponent).Name, 'Dendrite'); end; procedure TfrmBodyPlan.pnlDragDrop(Sender, Source: TObject; X, Y: Integer); var str1, str2: String; begin str1 := (Sender as TComponent).Name; str2 := (Source as TComponent).Name; if Sender <> pnlScopes then begin if Source is TAdvShape then begin TAdvShape(Source).Parent := (Sender as TWincontrol); TAdvShape(Source).Left := 15; TAdvShape(Source).Top := 40; end; SetSmallestIconToFront(Sender as TGroupBox); end else begin // If it is a scope if Source is TAdvShape then begin TAdvShape(Source).Parent := (Sender as TWincontrol); if TAdvShape(Source).Name = 'Scope_Blue' then PositionScopeIcon('Scope_Blue'); if TAdvShape(Source).Name = 'Scope_Black' then PositionScopeIcon('Scope_Black'); if TAdvShape(Source).Name = 'Scope_Green' then PositionScopeIcon('Scope_Green'); if TAdvShape(Source).Name = 'Scope_Red' then PositionScopeIcon('Scope_Red'); end; end; end; procedure TfrmBodyPlan.gbStepsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var str1, str2: String; begin str1 := (Sender as TComponent).Name; str2 := (Source as TComponent).Name; Accept := SameFamily((Source as TComponent).Name, 'Step'); // if Accept = false then // ShowMessage('false'); end; procedure TfrmBodyPlan.SaveGrid(StringGrid: TStringGrid; const FileName: TFileName); var f: TextFile; i, k: Integer; begin AssignFile(f, FileName); ReWrite(f); with StringGrid do begin // Write number of Columns/Rows WriteLn(f, ColCount); WriteLn(f, RowCount); // loop through cells for i := 0 to ColCount - 1 do for k := 0 to RowCount - 1 do WriteLn(f, Cells[i, k]); end; CloseFile(f); end; procedure TfrmBodyPlan.LoadGrid(StringGrid: TStringGrid; const FileName: TFileName); var f: TextFile; iTmp, i, k: Integer; strTemp: String; begin AssignFile(f, FileName); Reset(f); with StringGrid do begin // Get number of columns ReadLn(f, iTmp); ColCount := iTmp; // Get number of rows ReadLn(f, iTmp); RowCount := iTmp; // loop through cells & fill in values for i := 0 to ColCount - 1 do for k := 0 to RowCount - 1 do begin ReadLn(f, strTemp); Cells[i, k] := strTemp; end; end; CloseFile(f); end; procedure TfrmBodyPlan.btnLoadFromFileClick(Sender: TObject); begin LoadGrid(Grid, 'Connections.txt'); RenumberGrid; end; procedure TfrmBodyPlan.btnSavetoFileClick(Sender: TObject); begin RenumberGrid; SaveGrid(Grid, 'Connections.txt'); end; procedure TfrmBodyPlan.btnSelectRowsClick(Sender: TObject); begin Grid.RowSelect[3] := true; end; procedure TfrmBodyPlan.btnTestClick(Sender: TObject); begin // end; procedure TfrmBodyPlan.GridFix; // G R I D F I X // Function FindBodyPartInSource(ABodyPart: String): Integer; var X: Integer; begin Result := -1; for X := 1 to GridBottomRow do begin if Grid.Cells[1, X] = ABodyPart then begin Result := X; break; end; end; end; var i: Integer; SinkBodyPart: String; RowFound: Integer; FixCount: Integer; LoopCnt: Integer; begin LoopCnt := 0; Repeat FixCount := 0; for i := 1 to GridBottomRow - 1 do begin SinkBodyPart := Grid.Cells[CSink, i]; RowFound := FindBodyPartInSource(SinkBodyPart); if RowFound <> -1 then begin if RowFound < i then begin Grid.MoveRow(RowFound, i); // LookRow or something FixCount := FixCount + 1; Refresh; RenumberGrid; Grid.Row := i; end; end; end; // Check every Sink LoopCnt := LoopCnt + 1; if LoopCnt > 200 then begin Grid.RemoveRows(RowFound, 1); DrawWires; ShowMessage('Don''t loop me out - bro'); break; end; until FixCount = 0; // RenumberGrid; end; procedure TfrmBodyPlan.btnRemoveRowsClick(Sender: TObject); begin Grid.RemoveRows(1, 1); Grid.autonumbercol(0); end; // Reload the Field of controls procedure TfrmBodyPlan.AdvGlassButton1Click(Sender: TObject); begin frmOscilloscope.Start; end; procedure TfrmBodyPlan.btnClearClick(Sender: TObject); begin Grid.ClearRows(1, RowMax); DrawWires; Row := 1; end; procedure TfrmBodyPlan.btnConnectClick(Sender: TObject); var i, num: Integer; begin // renumberGrid; num := getGridBottomRow; Grid.moveRows(5, num + 2, 1); // Grid.Cells[CSourceX, num] := IntToStr(SourceIcon.X); // Grid.Cells[CSourceY, num] := IntToStr(SourceIcon.Y); Grid.Cells[CSink, num] := 'Dendriet_1'; // Grid.Cells[CSinkPort, num] := SinkIcon.Port; // Grid.Cells[CSinkX, num] := IntToStr(SinkIcon.X); // Grid.Cells[CSinkY, num] := IntToStr(SinkIcon.Y); Grid.RemoveRowsEx(5, 1); RenumberGrid; // GridMoveStuff; // DrawWires; end; procedure TfrmBodyPlan.AddGridRow(StringGrid: TStringGrid; aPos: Integer); var iRow: Integer; begin StringGrid.RowCount := StringGrid.RowCount + 1; for iRow := StringGrid.RowCount - 1 downto aPos do StringGrid.Rows[iRow] := StringGrid.Rows[iRow - 1]; StringGrid.Rows[aPos].Clear; RenumberGrid; end; function TfrmBodyPlan.Family(CkName: String): String; begin Result := Copy(CkName, 1, Pos('_', CkName) - 1); end; function TfrmBodyPlan.SourceFamilyIS(CkName: String): Boolean; begin Result := Family(SourceIcon.Name) = CkName; end; function TfrmBodyPlan.SinkFamilyIS(CkName: String): Boolean; begin Result := Family(SinkIcon.Name) = CkName; end; // ******************* S e t G r i d S o u r c e S i n k **************** function TfrmBodyPlan.SetGridSourceSink(Icon: TAdvShape; Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; Function FillRow(num: Integer): Integer; begin Grid.Cells[CSource, num] := SourceIcon.Name; Grid.Cells[CSourcePort, num] := SourceIcon.Port; Grid.Cells[CSourceX, num] := IntToStr(SourceIcon.X); Grid.Cells[CSourceY, num] := IntToStr(SourceIcon.Y); Grid.Cells[CSink, num] := SinkIcon.Name; Grid.Cells[CSinkPort, num] := SinkIcon.Port; Grid.Cells[CSinkX, num] := IntToStr(SinkIcon.X); Grid.Cells[CSinkY, num] := IntToStr(SinkIcon.Y); Result := num + 1; end; procedure Reset; begin FoundSink := false; FoundSource := false; SourceIcon.Name := ''; SinkIcon.Name := ''; end; procedure Refresh; // R E F R E S H begin RenumberGrid; Grid.Refresh; DrawWires; end; var i: Integer; begin // ----------------- S T A R T --------------------- Result := true; if ((X < Icon.Width - 15) AND (X > Icon.Width - CClickZone) AND (Y < Icon.height) AND (Y > Icon.height - 10)) Then begin // FOUND Port reference SourceIcon.Name := Icon.Name; SourceIcon.Port := '1'; SourceIcon.X := X; SourceIcon.Y := Y; FoundSource := true; end; // ---------------- ONE SIDED TESTS ----------------- if (X > Icon.Width - CClickZone) then // mouse withing the SOURCE shape edge begin SourceIcon.Name := Icon.Name; if SourceFamilyIS('Scope') then begin sbBodyPlan.Panels[CsbMessage].Text := ' Scope''s cannot source'; Result := false; Reset; end else begin FoundSource := true; SourceIcon.Port := '0'; SourceIcon.X := X; SourceIcon.Y := Y; end; end; if (X < CClickZone) then // mouse withing the Sink shape edge begin SinkIcon.Name := Icon.Name; if SinkFamilyIS('Step') then begin sbBodyPlan.Panels[CsbMessage].Text := ' Step''s cannot sink'; Result := false; Reset; end else begin FoundSink := true; SinkIcon.Port := '0'; SinkIcon.X := X; SinkIcon.Y := Y; end; if FoundSink AND NOT FoundSource then begin // if NOT SinkFamilyIS('Scope') then // // begin // dlgSelectSource.Execute; // Reset; // end; end; end; if (SinkFamilyIS('Scope')) then // D O U B L E C L I C K S C O P E begin // This allows rapid scope movement with double click don't remove for i := RowMax downto 1 do if SinkIcon.Name = Grid.Cells[CSink, i] then begin Grid.RemoveRows(i, 1); SinkIcon.Name := Icon.Name; SourceIcon.Name := ''; FoundSink := false; FoundSource := false; Row := Row - 1; end; Refresh; end; // -------------------B O T H F O U N D ---------------------- if (FoundSource AND FoundSink) then begin if (SourceIcon.Name = SinkIcon.Name) then // No S E L F begin // ('Can''t connect to ''self'''); Result := false; Reset; exit; end; for i := GridBottomRow - 1 DownTo 1 do // No D U P E S begin if Grid.Cells[CSource, i] = SourceIcon.Name then if Grid.Cells[CSink, i] = SinkIcon.Name then begin Result := false; Reset; exit; end; end; for i := GridBottomRow - 1 DownTo 1 do // No empty PORT entries begin if ((Grid.Cells[CSourcePort, i] = '') OR (Grid.Cells[CSinkPort, i] = '')) then begin Grid.RemoveRows(i, 1); // exit; end; end; if SourceFamilyIS('Synapse') then // Check SYNAPSE SOURCE begin if NOT(SinkFamilyIS('Dendrite') OR SinkFamilyIS('Scope') OR SinkFamilyIS('Soma')) then begin ShowMessage('Synapses can only output to Scopes, Soma''s and Dendrites'); Result := false; Reset; exit; end; end; if SinkFamilyIS('Synapse') then // Check SYNAPSE SINK begin if NOT(SourceFamilyIS('Axon') OR SourceFamilyIS('Step')) then begin ShowMessage('Synapses can only receive input from Axons or Steps'); Result := false; Reset; exit; end; end; If (SourceFamilyIS('Dendrite') AND SinkFamilyIS('Axon')) then // Check DENDRITE Source begin ShowMessage('Dendrites cannot drive Axons '); Result := false; Reset; exit; end; If (SourceFamilyIS('Soma') AND SinkFamilyIS('Soma')) then // Check SOMAs begin ShowMessage('Somas cannot directly interconnect'); // Result := false; // ; exit; end; If (SourceFamilyIS('Soma') AND SinkFamilyIS('Dendrite')) then // Check Dendrite begin ShowMessage('Somas cannot drive Dendrites. Use Axon, Synapse then Dendrite'); Result := false; Reset; exit; end; If (SourceFamilyIS('Axon') AND SinkFamilyIS('Soma')) then begin ShowMessage('Axons cannot drive Somas directly. Use Synapse then Soma'); Result := false; Reset; exit; end; If (SourceFamilyIS('Axon') AND SinkFamilyIS('Dendrite')) then begin ShowMessage('Axons cannot drive Dendrites directly. Use Synapse then Dendrite'); Result := false; Reset; exit; end; If NOT(SourceFamilyIS('Soma') OR SourceFamilyIS('Axon') OR SourceFamilyIS('Step')) AND SinkFamilyIS('Axon') then begin ShowMessage('Only Soma''s and Axon segments can drive Axons'); Result := false; Reset; exit; end; // --------------------------------------------- Move Stuff ------------------------------- FillRow(GridBottomRow); GridMoveStuff; RenumberGrid; GridFix; Refresh; Result := true; Reset; end; // END Both Found end; // S e t G r i d S o u r c e S i n k procedure TfrmBodyPlan.GridMoveStuff; // ........................... G R I D M o v e S t u f f var // START GRID MOVE Stuff i: Integer; Source, Sink: String; begin for i := GridBottomRow - 1 DownTo 1 do // Insure to go Bottom Up begin Source := Grid.Cells[CSource, i]; Sink := Grid.Cells[CSink, i]; if (Family(Source) = 'Step') AND Not(Family(Sink) = 'Scope') then begin Grid.moveRows(i, 1, 1); Refresh; end; if (Family(Sink) = 'Scope') AND Not(Family(Source) = 'Step') then begin Grid.moveRows(i, GridBottomRow - 1, 1); Refresh; end; end; for i := 1 to GridBottomRow - 1 do begin if ((Grid.Cells[CSourcePort, i] = '') OR (Grid.Cells[CSinkPort, i] = '')) then // Clear any emptys Grid.RemoveRows(i, 1); end; end; // {$REGION ' G R I D E V E N T S '} procedure TfrmBodyPlan.GridAutoDeleteRow(Sender: TObject; ARow: Integer); begin Grid.RemoveRows(ARow, 1); DrawWires; RenumberGrid; end; procedure TfrmBodyPlan.GridCanClickCell(Sender: TObject; ARow, ACol: Integer; var Allow: Boolean); begin if ACol = 3 then begin if Grid.Cells[ACol, ARow] = Yes then Grid.Cells[ACol, ARow] := '' else Grid.Cells[ACol, ARow] := Yes; DrawWires; end; end; procedure TfrmBodyPlan.GridDblClickCell(Sender: TObject; ARow, ACol: Integer); begin if ACol = 3 then begin if Grid.Cells[ACol, ARow] = Yes then Grid.Cells[ACol, ARow] := '' else Grid.Cells[ACol, ARow] := Yes end; end; procedure TfrmBodyPlan.GridDragDrop(Sender, Source: TObject; X, Y: Integer); Var DestCol, DestRow: Integer; begin // Grid Drag Drop Step 4 Grid.MouseToCell(X, Y, DestCol, DestRow); // Convert Mouse to Row/Column Grid.MoveRow(SourceRow, DestRow); // Do the work RenumberGrid; end; procedure TfrmBodyPlan.GridDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var CurrentCol, CurrentRow: Integer; str: String; ThisObject: TObject; begin // Grid Drag Drop Step 3 Grid.MouseToCell(X, Y, CurrentCol, CurrentRow); // Pick up mouse current row/column ThisObject := Source; str := ThisObject.ClassName; if ThisObject.ClassName = 'TAdvShape' then // Don't accept errant Icon drop Accept := false else Accept := (CurrentCol > 0) and (CurrentRow > 0); // Don't accept for Row/Column 0 end; procedure TfrmBodyPlan.GridEndDrag(Sender, Target: TObject; X, Y: Integer); begin Grid.Refresh; end; procedure TfrmBodyPlan.GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // if Button = mbLeft then // Grid Drag Drop Step 2 begin Grid.MouseToCell(X, Y, SourceCol, SourceRow); // Convert mouse position if SourceRow <> 0 then // Make sure we are not moving row = 0 begin Grid.BeginDrag(false); end; end; end; procedure TfrmBodyPlan.GridRowUpdate(Sender: TObject; OldRow, NewRow: Integer); begin RenumberGrid; end; procedure TfrmBodyPlan.GridsPropSave1GetKeyString(Comp: TComponent; var Key: string); begin end; {$ENDREGION} procedure TfrmBodyPlan.Exit1Click(Sender: TObject); begin Close; end; procedure TfrmBodyPlan.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin rollBodyParts.Collapsed := false; // Necessary to preserve the BodyParts roll status. CanClose := true; end; procedure TfrmBodyPlan.RemoveEntry(ComponentName: String); var // used by components when docking X, Y: Integer; CellContents: String; Component: String; begin // Component := Copy(ComponentName, 4, MaxInt); Component := ComponentName; for X := RowMax - 1 DownTo 1 do for Y := 1 to ColMax do begin CellContents := Grid.Cells[Y, X]; if CellContents = Component then begin Grid.RemoveRows(X, 1); // Remove the offending component // Grid.InsertRows(RowMax - 1, 1); // Add a row at the bottom to keep nature in balance RenumberGrid; // Row := Row - 1; end; end; DrawWires; end; // {$REGION ' M A N A G E M O U S E '} // {$REGION ' pnlField '} // pnlField Mouse Move procedure TfrmBodyPlan.pnlFieldMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Capturing then begin ptEnd.X := X; ptEnd.Y := Y; pnlField.Canvas.Rectangle(ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y); pnlField.Canvas.Pen.Style := psDashDot; pnlField.Canvas.Brush.Color := clSkyBlue; end; pnlField.Canvas.Pen.Style := psSolid; pnlField.Canvas.Brush.Color := clSkyBlue; // sbBodyPlan.Panels[CsbMessage].Text := 'X: ' + IntToStr(X) + ' Y: ' + IntToStr(Y); end; // End PnlField Mouse Move // PnlFieldPaint procedure TfrmBodyPlan.pnlFieldPaint(Sender: TObject); begin if FCapturing then begin pnlField.Canvas.Rectangle(ptStart.X, ptStart.Y, ptEnd.X, ptEnd.Y); end; end; // End PnlFieldPaint // pnlField DragDrop procedure TfrmBodyPlan.pnFieldDragDrop(Sender, Source: TObject; X, Y: Integer); { Dropping a shape on the Main form } var // str1, str2, str3: String; IconPanel: TGroupBox; Icon: TControl; Form: TForm; str: String; begin Icon := TAdvShape(Source); str := Icon.Name; IconPanel := TGroupBox(Icon.Parent); Delete(str, 1, 3); if IconPanel.ControlCount = 1 then IconPanel.Caption := str; pnlField.Caption := ''; if Source is TAdvShape then begin with (Source as TAdvShape) do begin Parent := pnlField; Icon.Left := X; Icon.Top := Y; Icon.Enabled := true; end; begin // Corral any escaping Icons if Icon.Left + Icon.Width > pnlField.Width then while Icon.Left + Icon.Width > pnlField.Width do Icon.Left := Icon.Left - 1; if Icon.Top < pnlField.Top then while Icon.Top < pnlField.Top do Icon.Top := Icon.Top + 1; if Icon.Left = 1 then while Icon.Left = 1 do Icon.Left := Icon.Left + 1; if Icon.Top + Icon.height > pnlField.height then while Icon.Top + Icon.height > pnlField.height do Icon.Top := Icon.Top - 1; end; SetSmallestIconToFront(IconPanel); Form := CreateForm(TAdvShape(Source).Name); Form.WindowState := wsMinimized; Form.Visible := true; Form.Next; Form.Visible := false; Form.WindowState := wsNormal; // End Trick for single Icons comming onto the pnlField end; DrawWires; end; // End pnlField DragDrop procedure TfrmBodyPlan.pnlFieldDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := true; // DrawWires; // Causes flashing Jim Jim end; // pnlField Mouse Down procedure TfrmBodyPlan.pnlFieldMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // frmClone.Detach; // frmClone.Visible := false; mnuSee.Caption := 'See Selected Parts'; if (Button = mbRight) AND (popDrag.Checked = false) AND (popChange.Checked = false) then DrawWires; if Button = mbLeft then begin popDrag.Checked := false; popChange.Checked := false; Capturing := false; end; if (popDrag.Checked) AND (Button = mbRight) then begin ptStart.X := X; ptStart.Y := Y; ptEnd.X := X; ptEnd.Y := Y; Capturing := true; // pnlField.Repaint; end; if (popChange.Checked) AND (Button = mbRight) then begin ptStart.X := X; ptStart.Y := Y; ptEnd.X := X; ptEnd.Y := Y; Capturing := true; // frmClone.Visible := true; // DrawWires; end; end; procedure TfrmBodyPlan.pnlFieldMouseEnter(Sender: TObject); begin end; // End PnlField Mouse Down // pnlField Mouse Up procedure TfrmBodyPlan.pnlFieldMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var control: TControl; Count: Integer; i: Integer; tempPt: TPoint; begin if Capturing then begin pnlField.Canvas.Pen.Style := psClear; pnlField.Canvas.Brush.Color := clNone; if ((ptEnd.X < 1) OR (ptEnd.Y < 0)) then begin exit; end; ptEnd.X := X; ptEnd.Y := Y; if (ptEnd.X < ptStart.X) then begin tempPt.X := ptEnd.X; ptEnd.X := ptStart.X; ptStart.X := tempPt.X; end; if (ptEnd.Y < ptStart.Y) then begin tempPt.Y := ptEnd.Y; ptEnd.Y := ptStart.Y; ptStart.Y := tempPt.Y; end; // with frmClone do // begin // pnlCloneSteps.Visible := false; // pnlCloneSynapse.Visible := false; // pnlCloneDendrites.Visible := false; // pnlCloneSomas.Visible := false; // pnlCloneAxons.Visible := false; // end; Count := pnlField.ControlCount; for i := 0 to Count - 1 do begin control := pnlField.Controls[i]; if IconWithinRegion(TAdvShape(control), ptStart.Y, ptStart.X, ptEnd.Y, ptEnd.X) then begin // str := control.Name; // frmClone.Attach(control); end; end; // frmClone.Visible := true; end; Capturing := false; end; // End pnlField Mouse UP {$ENDREGION} // {$REGION ' Icon '} // Icon Mouse Down procedure TfrmBodyPlan.IconMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var control: TControl; ClickedAdvShapeName: String; frmIcon: TForm; begin if ssShift in Shift then begin ClickedAdvShapeName := TComponent(Sender).Name; exit; end; ClickedAdvShapeName := TComponent(Sender).Name; control := TControl(Sender); // Form := FindFormByName('frm' + ClickedAdvShapeName); frmIcon := CreateForm(ClickedAdvShapeName); if (Button = mbLeft) AND NOT(pnlField.ContainsControl(control)) then begin control.BeginDrag(false, -1); // Allows stuff to be moved inside in its own panel... with frmOscilloscope.Scope do begin if Sender = Scope_Blue then Scale1Y.Visible := true; if Sender = Scope_Red then Scale2Y.Visible := true; if Sender = Scope_Green then Scale3Y.Visible := true; if Sender = Scope_Black then Scale4Y.Visible := true; end; end else begin if Button = mbRight then // RIGHT Button inside Field Panel gets Form... begin if frmIcon.Visible then begin // Blink the form if already active frmIcon.Visible := false; Sleep(50); frmIcon.BringToFront; frmIcon.Visible := true; // exit; end; frmIcon.Parent := frmBodyPlan.pnlField; frmIcon.Left := (Sender as TAdvShape).Left; frmIcon.Top := (Sender as TAdvShape).Top + (Sender as TAdvShape).height + CMargen; if (frmIcon.Top + frmIcon.height) > pnlField.height then begin while frmIcon.Top + frmIcon.height > pnlField.height do frmIcon.Top := frmIcon.Top - CMargen - 30; End; if (frmIcon.Left + frmIcon.Width) > pnlField.Width Then begin While (frmIcon.Left + frmIcon.Width + CMargen) > pnlField.Width Do frmIcon.Left := frmIcon.Left - CMargen; end; // ShowMessage('Name: ' + frmIcon.Name); frmIcon.Visible := true; end else begin // LEFT Button and inside the Field Panel If SetGridSourceSink(Sender as TAdvShape, Button, Shift, X, Y) then control.BeginDrag(false, 0); // Allows the clicked control to be dragged end; end; end; // End Icon Mouse Down // Icon Mouse Move procedure TfrmBodyPlan.IconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if TAdvShape(Sender).Parent = pnlField then begin if (X > TAdvShape(Sender).Width - CClickZone) then // mouse withing the SOURCE shape edge Screen.Cursor := crUpArrow else if X < +CClickZone then Screen.Cursor := crUpArrow else Screen.Cursor := crDefault; end end; // End Icon Mouse Move procedure TfrmBodyPlan.IconMouseLeave(Sender: TObject); begin Screen.Cursor := crDefault; end; procedure TfrmBodyPlan.EndDrag(Sender, Target: TObject; X, Y: Integer); begin DrawWires; end; {$ENDREGION} // {$ENDREGION} // end.