unit U_SCSObjectsProp; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, RzTabs, cxLookAndFeelPainters, StdCtrls, cxRadioGroup, cxCheckBox, cxButtons, RzBorder, cxMemo, cxControls, cxContainer, cxEdit, cxTextEdit, ExtCtrls, RzPanel, /// PowerCad PCPanel, PCDrawBox, PCDrawing, PowerCad, PCTypesUtils, DrawObjects, ExtDlgs, PCLayerDlg, OleCtnrs, PCgui, GuiStrings, DrawEngine, U_ESCadClasess, U_SCSEngineTest, cxImage, cxMaskEdit, RzButton, ToolWin, cxDropDownEdit, cxColorComboBox, Mask, cxImageComboBox, RzCmboBx, RzEdit, RzSpnEdt, Contnrs, siComp, siLngLnk, U_SCSLists, U_Common, cxLabel, RzRadChk, //Tolik ActnList, U_Progress, U_Splash, Math, U_Navigator, LibJpeg, ClipBrd, U_HouseClasses, {01/07/2016 }U_SCSClasses, cxGraphics, cxLookAndFeels, Menus; type TOrtholineProp = record fName: string; fCaption: string; fIndex: double; fIndexWithName: Boolean; fGap: string; fCount: string; fAngle: string; fX: string; fY: string; fZ: string; fDrawFigurePercent: string; fForAllSameType: boolean; fLength: string; fShowLength: boolean; fShowLengthGrayed: boolean; fIsAutoLength: boolean; fCaptionsGroup: TStringList; fCaptionsShow: boolean; fCaptionsShowGrayed: boolean; fCaptionsFontSize: string; fCaptionsFontBold: boolean; fCaptionsFontBoldGrayed: boolean; fCaptionsFontColor: Integer; fCaptionsShowType: TLineCaptionsViewType; fNotesGroup: TStringList; fNotesShow: boolean; fNotesShowGrayed: boolean; fNotesFontSize: string; fNotesFontColor: Integer; fNotesShowType: TNotesRowsType; fColor: Integer; fStyle: Integer; fWidth: string; fShowBlock: boolean; fShowBlockGrayed: boolean; fBlockStep: string; fBlock: TBitmap; end; POrtholineProp = ^TOrtholineProp; TConnectorProp = record fName: string; fIndex: double; fIndexWithName: Boolean; fWidth: string; fHeight: string; fAngle: string; fX: string; fY: string; fZ: string; fDrawFigurePercent: string; fForAllSameType: boolean; fCaptionsGroup: TStringList; fCaptionsShow: boolean; fCaptionsShowGrayed: boolean; fCaptionsFontSize: string; fCaptionsFontColor: Integer; fCaptionsShowType: TConnCaptionsViewType; fNotesGroup: TStringList; fNotesShow: boolean; fNotesShowGrayed: boolean; fNotesFontSize: string; fNotesFontColor: Integer; fNotesShowType: TNotesRowsType; fCornerType: TCornerType; fBlock: TBitmap; end; PConnectorProp = ^TConnectorProp; type TF_SCSObjectsProp = class(TForm) PageSCSObjects: TRzPageControl; TabConn: TRzTabSheet; TabLine: TRzTabSheet; gbConnCaptionsGroup: TRzGroupBox; mConnCaptionsGroup: TcxMemo; gbObjectProperties: TRzGroupBox; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; RzBorder2: TRzBorder; Label8: TLabel; bConnOK: TcxButton; gbParams: TRzGroupBox; Label9: TLabel; Label10: TLabel; gbLengthChange: TRzGroupBox; rbLineAutoLength: TcxRadioButton; rbLineUserLength: TcxRadioButton; gbLineCaptionsGroup: TRzGroupBox; mLineCaptionsGroup: TcxMemo; gbCaptionChange: TRzGroupBox; edLineCaption: TcxTextEdit; RzGroupBox1: TRzGroupBox; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; RzBorder4: TRzBorder; bLineOK: TcxButton; RzGroupBox2: TRzGroupBox; edConnName: TcxTextEdit; RzGroupBox3: TRzGroupBox; edLineName: TcxTextEdit; bConnClose: TcxButton; bLineClose: TcxButton; Label1: TLabel; Label11: TLabel; RzGroupBox4: TRzGroupBox; edLineBlockStep: TcxMaskEdit; Label16: TLabel; imgLineBlock: TcxImage; bLineBlockChange: TcxButton; RzGroupBox5: TRzGroupBox; imgConnBlock: TcxImage; bConnBlockChange: TcxButton; gbLineNotesGroup: TRzGroupBox; mLineNotesGroup: TcxMemo; gbConnNotesGroup: TRzGroupBox; mConnNotesGroup: TcxMemo; toolLineNotesType: TToolBar; tbLine_UpLeftSide: TToolButton; tbLine_UpRightSide: TToolButton; tbLine_DownLeftSide: TToolButton; tbLine_DownRightSide: TToolButton; ToolBar1: TToolBar; tbConn_UpLeftSide: TToolButton; tbConn_UpRightSide: TToolButton; tbConn_DownLeftSide: TToolButton; tbConn_DownRightSide: TToolButton; gbTraceColor: TRzGroupBox; cbTraceColor: TcxColorComboBox; edLineAutoLength: TcxMaskEdit; edLineUserLength: TcxMaskEdit; edLineGap: TcxMaskEdit; edLineCount: TcxMaskEdit; edLineAngle: TcxMaskEdit; edLineX: TcxMaskEdit; edLineY: TcxMaskEdit; edLineZ: TcxMaskEdit; edConnWidth: TcxMaskEdit; edConnHeight: TcxMaskEdit; edConnAngle: TcxMaskEdit; edConnX: TcxMaskEdit; edConnY: TcxMaskEdit; edConnZ: TcxMaskEdit; edTraceWidth: TcxMaskEdit; Label17: TLabel; Label18: TLabel; Label19: TLabel; cbTraceStyle: TcxImageComboBox; bLineBlockClear: TcxButton; bConnBlockClear: TcxButton; toolLineCaptionsType: TToolBar; tbLine_OverLine: TToolButton; tbLine_UnderLine: TToolButton; //Tolik -- 01/12/2015 tbLine_Center: TToolButton; tbLine_Auto: TToolButton; // ToolBar2: TToolBar; ToolButton1: TToolButton; tbConn_CaptionUp: TToolButton; ToolButton3: TToolButton; tbConn_CaptionLeft: TToolButton; tbConn_CaptionRight: TToolButton; tbConn_CaptionDown: TToolButton; Label20: TLabel; Label21: TLabel; seConnIndex: TRzSpinEdit; seLineIndex: TRzSpinEdit; RzGroupBox6: TRzGroupBox; rbCornerNone: TcxRadioButton; rbCornerOut: TcxRadioButton; rbCornerIn: TcxRadioButton; rbCornerVertical: TcxRadioButton; rbCornerAdapter: TcxRadioButton; lng_Forms: TsiLangLinked; cbConnCaptionsFontSize: TRzComboBox; cbConnNotesFontSize: TRzComboBox; cbLineCaptionsFontSize: TRzComboBox; cbLineNotesFontSize: TRzComboBox; bLineDrawMinus: TcxButton; bLineDrawPlus: TcxButton; edConnDrawFigurePercent: TcxMaskEdit; Label22: TLabel; Label23: TLabel; edLineDrawFigurePercent: TcxMaskEdit; Label24: TLabel; Label25: TLabel; Label26: TLabel; Label27: TLabel; gbTypes: TRzGroupBox; cxLabel2: TcxLabel; cxLabel3: TcxLabel; cbConnObjects: TcxRadioButton; cbConnConnectors: TcxRadioButton; cbConnRaises: TcxRadioButton; cbLineTraces: TcxRadioButton; cbLineRaises: TcxRadioButton; cbLineCaptionsFontColor: TcxColorComboBox; Label28: TLabel; cbLineNotesFontColor: TcxColorComboBox; Label29: TLabel; Label30: TLabel; cbConnCaptionsFontColor: TcxColorComboBox; Label31: TLabel; cbConnNotesFontColor: TcxColorComboBox; cbLineShowLength: TRzCheckBox; cbLineShowBlock: TRzCheckBox; cbLineShowNotes: TRzCheckBox; cbLineShowCaptions: TRzCheckBox; cbLineCaptionsFontBold: TRzCheckBox; cbLineForAllSameType: TRzCheckBox; cbConnShowCaptions: TRzCheckBox; cbConnShowNotes: TRzCheckBox; cbConnForAllSameType: TRzCheckBox; Label32: TLabel; Label33: TLabel; Label34: TLabel; Label35: TLabel; Label36: TLabel; Label37: TLabel; Label38: TLabel; Label39: TLabel; Label40: TLabel; Label41: TLabel; cbUserLength: TRzCheckBox; cbLineIndexWithName: TRzCheckBox; cbConnIndexWithName: TRzCheckBox; Label42: TLabel; procedure bLineOKClick(Sender: TObject); procedure bConnOKClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure edLineNameKeyPress(Sender: TObject; var Key: Char); procedure edConnNameKeyPress(Sender: TObject; var Key: Char); procedure bConnCloseClick(Sender: TObject); procedure bLineCloseClick(Sender: TObject); procedure bLineBlockChangeClick(Sender: TObject); procedure bConnBlockChangeClick(Sender: TObject); procedure cbConnShowCaptionsClick(Sender: TObject); procedure cbConnShowNotesClick(Sender: TObject); procedure cbLineShowCaptionsClick(Sender: TObject); procedure cbLineShowNotesClick(Sender: TObject); procedure edConnWidthExit(Sender: TObject); procedure edConnHeightExit(Sender: TObject); procedure bConnBlockClearClick(Sender: TObject); procedure bLineBlockClearClick(Sender: TObject); procedure edConnNameExit(Sender: TObject); procedure edConnAngleExit(Sender: TObject); procedure edConnXExit(Sender: TObject); procedure edConnYExit(Sender: TObject); procedure edConnZExit(Sender: TObject); procedure edLineNameExit(Sender: TObject); procedure edLineGapExit(Sender: TObject); procedure edLineCountExit(Sender: TObject); procedure edLineAngleExit(Sender: TObject); procedure edLineXExit(Sender: TObject); procedure edLineYExit(Sender: TObject); procedure edLineZExit(Sender: TObject); procedure edTraceWidthExit(Sender: TObject); procedure edLineBlockStepExit(Sender: TObject); procedure rbLineAutoLengthClick(Sender: TObject); procedure rbLineUserLengthClick(Sender: TObject); procedure edLineAutoLengthExit(Sender: TObject); procedure edLineUserLengthExit(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure cbLineCaptionsFontSizeKeyPress(Sender: TObject; var Key: Char); procedure cbLineNotesFontSizeKeyPress(Sender: TObject; var Key: Char); procedure cbLineCaptionsFontSizeExit(Sender: TObject); procedure cbLineNotesFontSizeExit(Sender: TObject); procedure cbConnCaptionsFontSizeKeyPress(Sender: TObject; var Key: Char); procedure cbConnNotesFontSizeKeyPress(Sender: TObject; var Key: Char); procedure cbConnCaptionsFontSizeExit(Sender: TObject); procedure cbConnNotesFontSizeExit(Sender: TObject); procedure bLineDrawPlusClick(Sender: TObject); procedure bLineDrawMinusClick(Sender: TObject); procedure edConnDrawFigurePercentExit(Sender: TObject); procedure edLineDrawFigurePercentExit(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure cbConnObjectsClick(Sender: TObject); procedure cbConnConnectorsClick(Sender: TObject); procedure cbConnRaisesClick(Sender: TObject); procedure cbLineTracesClick(Sender: TObject); procedure cbLineRaisesClick(Sender: TObject); procedure mLineCaptionsGroupKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure mConnCaptionsGroupKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure edLineDrawFigurePercentKeyPress(Sender: TObject; var Key: Char); procedure edConnDrawFigurePercentKeyPress(Sender: TObject; var Key: Char); procedure cbUserLengthClick(Sender: TObject); procedure tbLine_OverLineClick(Sender: TObject); procedure tbLine_UnderLineClick(Sender: TObject); procedure tbLine_CenterClick(Sender: TObject); procedure tbLine_AutoClick(Sender: TObject); procedure Label42Click(Sender: TObject); procedure edConnAngleEditing(Sender: TObject; var CanEdit: Boolean); procedure edConnXEditing(Sender: TObject; var CanEdit: Boolean); procedure edConnYEditing(Sender: TObject; var CanEdit: Boolean); procedure edConnZEditing(Sender: TObject; var CanEdit: Boolean); procedure edConnDrawFigurePercentEditing(Sender: TObject; var CanEdit: Boolean); private { Private declarations } FIsMultiSelection: Boolean; public CaptionsLHandle: Integer; NotesLHandle: Integer; /// FNormalModeSize: Integer; FExtModeSize: Integer; FForAllConnsSameType: Boolean; FForAllLinesSameType: Boolean; FClickConn: TConnectorObject; FClickLine: TOrthoLine; FConnProp: PConnectorProp; FLineProp: POrtholineProp; FObjectsTypeProp: TObjectsTypeProp; FGroupObjectsList: TList; AngleEdited: Boolean; xEdited: Boolean; yEdited: Boolean; zEdited: Boolean; GsEdited: Boolean; procedure SaveConnProp(var aConnProp: PConnectorProp); procedure SaveLineProp(var aLineProp: POrtholineProp); /// // Connector procedure ChangeConnCaptionsGroup(aObject: TConnectorObject; aCaptions: TStringList); procedure ChangeConnNotesGroup(aObject: TConnectorObject; aNotes: TStringList); procedure ChangeConnName(aObject: TConnectorObject; aName: string); procedure ChangeConnWidth(aObject: TConnectorObject; aWidth: Double); procedure ChangeConnHeight(aObject: TConnectorObject; aHeight: Double); procedure ChangeConnAngle(aObject: TConnectorObject; aAngle: Double); procedure ChangeConnX(aObject: TConnectorObject; aX: Double); procedure ChangeConnY(aObject: TConnectorObject; aY: Double); //Tolik -- 01/07/2016 -- Procedure PutNBObjectOnHeight(aObject: TConnectorObject; aHeight: Double; ATraceList: TList; WayList: TList); Procedure CheckAddObjInPM(aObject: TConnectorObject); // Tolik 25/10/2017 -- // procedure ChangeConnZ(aObject: TConnectorObject; aZ: Double); procedure ChangeConnDrawFigurePercent(aObject: TConnectorObject; aPercent: Double); procedure ChangeConnBlock(aObject: TConnectorObject); procedure ChangeConnCornerType(aObject: TConnectorObject; aCornerType: TCornerType); procedure ClearConnBlock(aObject: TConnectorObject); procedure ChangeConnIndex(aObject: TConnectorObject; aIndex: Double); procedure ChangeConnCaptionsFontSize(aObject: TConnectorObject; aSize: Integer); procedure ChangeConnNotesFontSize(aObject: TConnectorObject; aSize: Integer); procedure ChangeConnCaptionsFontColor(aObject: TConnectorObject; aColor: Integer); procedure ChangeConnNotesFontColor(aObject: TConnectorObject; aColor: Integer); procedure ChangeConnCaptionsViewType(aObject: TConnectorObject; aValue: TConnCaptionsViewType); procedure ChangeConnNotesViewType(aObject: TConnectorObject; aValue: TNotesRowsType); // OrthoLine procedure ChangeLineCaptionsGroup(aObject: TOrthoLine; aCaptions: TStringList); procedure ChangeLineNotesGroup(aObject: TOrthoLine; aNotes: TStringList); procedure ChangeLineGapCount(aObject: TOrthoLine; aGap: Double; aCount: Integer); procedure ChangeLineAutoLength(aObject: TOrthoLine; aLength: Double); procedure ChangeLineUserLength(aObject: TOrthoLine; aLength: Double); procedure ChangeLineCaption(aObject: TOrthoLine; aCaption: string); procedure ChangeLineName(aObject: TOrthoLine; aName: string); procedure ChangeLineAngle(aObject: TOrthoLine; aAngle: Double); procedure ChangeLineX(aObject: TOrthoLine; aX: Double); procedure ChangeLineY(aObject: TOrthoLine; aY: Double); procedure ChangeLineZ(aObject: TOrthoLine; aZ: Double); procedure ChangeLineDrawFigurePercent(aObject: TOrthoLine; aPercent: Double); procedure ChangeLineShowLength(aObject: TOrthoLine; aShowLength: Boolean); procedure ChangeLineBlock(aObject: TOrthoLine); procedure ChangeLineShowBlock(aObject: TOrthoLine; aShowBlock: Boolean); procedure ChangeLineBlockStep(aObject: TOrthoLine; aBlockStep: Double); procedure ClearLineBlock(aObject: TOrthoLine); procedure ChangeLineColor(aObject: TOrthoLine; aColor: Integer); procedure ChangeLineStyle(aObject: TOrthoLine; aStyle: Integer); procedure ChangeLineWidth(aObject: TOrthoLine; aWidth: Integer); procedure ChangeLineIndex(aObject: TOrthoLine; aIndex: Double); procedure ChangeLineCaptionsFontSize(aObject: TOrthoLine; aSize: Integer; aBold: Boolean); procedure ChangeLineNotesFontSize(aObject: TOrthoLine; aSize: Integer); procedure ChangeLineCaptionsFontColor(aObject: TOrthoLine; aColor: Integer); procedure ChangeLineNotesFontColor(aObject: TOrthoLine; aColor: Integer); procedure ChangeLineCaptionsViewType(aObject: TOrthoLine; aValue: TLineCaptionsViewType); procedure ChangeLineNotesViewType(aObject: TOrthoLine; aValue: TNotesRowsType); procedure ChangeLineDrawPlus(aObject: TOrthoLine); procedure ChangeLineDrawMinus(aObject: TOrthoLine); /// Загрузить свойства // типовые Procedure OrtholinePropertiesForRaise; Procedure OrtholinePropertiesForNormal; Procedure ConnectorPropertiesForRaise; Procedure ConnectorPropertiesForNormal(AConnType: TConnectorType); // свойства самих объектов Procedure LoadOrtholineProperties(AObject: TOrtholine); Procedure LoadConnectorProperties(AObject: TConnectorObject); Procedure LoadPropertiesForFewOrtholines; Procedure LoadPropertiesForFewConnectors; Procedure LoadPropertiesForFewConnObjects; Procedure LoadPropertiesForFewConnConnectors; procedure LoadPropertiesForFewConnRaises; Procedure LoadPropertiesForFewLineTraces; procedure LoadPropertiesForFewLineRaises; /// очистить все Procedure ClearAllProperties; // Tolik --26/09/2017 -- Procedure RedefineObjIcon(aObj: TConnectorObject); // процедура на нажатии ОК и по Enter в поле procedure ConnOKExecute(aTag: Integer = -1); procedure LineOKExecute(aTag: Integer = -1); // применить для объекта - группы объектов данного типа 1 свойтсво Procedure ApplyConnectorProperty(AObject: TConnectorObject; aNewProperties: PConnectorProp; aTag: Integer); Procedure ApplyOrtholineProperty(AObject: TOrthoLine; aNewProperties: POrtholineProp; aTag: Integer); // применить для объекта - группы объектов данного типа Procedure ApplyConnectorProperties(AObject: TConnectorObject; aNewProperties: PConnectorProp; aMultiple: Boolean); Procedure ApplyOrtholineProperties(AObject: TOrthoLine; aNewProperties: POrtholineProp; aMultiple: Boolean); // получить лист с однотипными объектами function GetFiguresByObjectsType(aObjectsTypeProp: TObjectsTypeProp): TList; function Execute(aSCSObject: TFigure): Boolean; function FindFirstByObjectsType(aObjectsTypeProp: TObjectsTypeProp): TFigure; // установить систему измерений procedure SetUOM; procedure SetMaskEdits; { Public declarations } end; var F_SCSObjectsProp: TF_SCSObjectsProp; // Tolik -- 11/07/2016 -- ObjectToSnap: TConnectorObject; // isConnector: Boolean; implementation uses USCS_Main, U_CAD, U_BaseCommon, U_TrunkSCS, U_Constants, U_SCSComponent, {Tolik--17/12/2015}U_ChoiceConnectSide, U_MAIN; {$R *.dfm} { TF_SCSObjectsProp } procedure TF_SCSObjectsProp.ChangeConnAngle(aObject: TConnectorObject; aAngle: Double); var OldAngleRad: Double; NewAngleRad: Double; AngleRad: Double; AngleDeg: Double; inFigure: TFigure; inFigureGrp: TFigureGrpNotMod; Bnd: TDoubleRect; NewAngleDegree: Double; //Tolik -- 07/07/2017 NewCenterPoint, OldCenterPoint: TDoublePoint; // begin try OldAngleRad := aObject.FDrawFigureAngle; NewAngleRad := aAngle / 180 * pi; NewAngleDegree := aAngle; AngleRad := NewAngleRad - OldAngleRad; if CheckTrunkObject(aObject) then begin RotatetrunkObject(aObject, AngleRad * 180 / pi); Exit; end; aObject.Rotate(AngleRad, aObject.ActualPoints[1]); // Tolik 07/07/2017 -- OldCenterPoint := aObject.DrawFigure.CenterPoint; // aObject.DrawFigure.Rotate(AngleRad, aObject.CenterPoint); aObject.FDrawFigureAngle := NewAngleRad; //Tolik -- 07/07/2017 NewCenterPoint := aObject.DrawFigure.CenterPoint; // { if ((CompareValue(OldCenterPoint.x, NewCenterPoint.y) <> 0) or (CompareValue(OldCenterPoint.y, NewCenterPoint.y) <> 0)) then aObject.Move(OldCenterPoint.x - NewCenterPoint.x, OldCenterPoint.y - NewCenterPoint.y); } // while aObject.FDrawFigureAngle >= 2 * pi do aObject.FDrawFigureAngle := aObject.FDrawFigureAngle - 2 * pi; Bnd := aObject.DrawFigure.GetBoundRect; aObject.GrpSizeX := Bnd.Right - Bnd.Left; aObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // if (NewAngleDegree >= 0) and (NewAngleDegree <= 45) then aObject.FCaptionsViewType := cv_Right else if (NewAngleDegree > 45) and (NewAngleDegree < 135) then aObject.FCaptionsViewType := cv_Down else if (NewAngleDegree >= 135) and (NewAngleDegree <= 225) then aObject.FCaptionsViewType := cv_Left else if (NewAngleDegree > 225) and (NewAngleDegree < 315) then aObject.FCaptionsViewType := cv_Up else if (NewAngleDegree >= 315) and (NewAngleDegree <= 360) then aObject.FCaptionsViewType := cv_Right; aObject.DefRaizeDrawFigurePos; // RefreshCAD(GCadForm.PCad); aObject.ReCreateCaptionsGroup(false, false); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnAngle', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnHeight(aObject: TConnectorObject; aHeight: Double); var MapScale: Double; OldSizeY: Double; NewSizeY: Double; begin try MapScale := GCadForm.PCad.MapScale; OldSizeY := aObject.GrpSizeY; NewSizeY := aHeight / Mapscale * 1000; // вернуть на 0 градус aObject.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]); if aObject.DrawFigure <> nil then aObject.DrawFigure.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]); // изменить размеры aObject.Scale(1, NewSizeY / OldSizeY, aObject.ActualPoints[1]); aObject.DrawFigure.Scale(1, NewSizeY / OldSizeY, aObject.DrawFigure.CenterPoint); aObject.GrpSizeY := NewSizeY; // повернуть назад aObject.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]); if aObject.DrawFigure <> nil then aObject.DrawFigure.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]); // Recreate aObject.ReCreateCaptionsGroup(True, false); aObject.ReCreateNotesGroup(True); aObject.DefRaizeDrawFigurePos; except on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeHeight', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnCaptionsGroup(aObject: TConnectorObject; aCaptions: TStringList); var i: integer; FName: string; begin try if aObject.OutTextCaptions.Count > 0 then FName := aObject.OutTextCaptions[0] else FName := ''; aObject.OutTextCaptions.Clear; if GCadForm.FShowObjectCaptionsType = st_Short then begin aObject.OutTextCaptions.Add(aCaptions[0]); for i := 1 to aCaptions.Count - 1 do aObject.OutTextCaptions.Add(aCaptions[i]); end else begin aObject.OutTextCaptions.Add(FName); for i := 0 to aCaptions.Count - 1 do aObject.OutTextCaptions.Add(aCaptions[i]); end; aObject.ReCreateCaptionsGroup(True, True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnCaptionsGroup', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnNotesGroup(aObject: TConnectorObject; aNotes: TStringList); var i: integer; begin try i := 0; while i < aObject.OutTextNotes.Count do aObject.OutTextNotes.Delete(i); // засыпать маркировки for i := 0 to aNotes.Count - 1 do begin aObject.OutTextNotes.Add(aNotes[i]); end; aObject.ReCreateNotesGroup(True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnNotesGroup', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnName(aObject: TConnectorObject; aName: string); begin try aObject.Name := aName; SetNewObjectNameInPM(aObject.ID, aObject.Name); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnName', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnWidth(aObject: TConnectorObject; aWidth: Double); var MapScale: Double; OldSizeX: Double; NewSizeX: Double; begin try MapScale := GCadForm.PCad.MapScale; OldSizeX := aObject.GrpSizeX; NewSizeX := aWidth / Mapscale * 1000; // вернуть на 0 градус aObject.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]); if aObject.DrawFigure <> nil then aObject.DrawFigure.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]); // изменить размеры aObject.Scale(NewSizeX / OldSizeX, 1, aObject.ActualPoints[1]); aObject.DrawFigure.Scale(NewSizeX / OldSizeX, 1, aObject.DrawFigure.CenterPoint); aObject.GrpSizeX := NewSizeX; // повернуть назад aObject.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]); if aObject.DrawFigure <> nil then aObject.DrawFigure.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]); // Recreate aObject.ReCreateCaptionsGroup(True, false); aObject.ReCreateNotesGroup(True); aObject.DefRaizeDrawFigurePos; except on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeWidth', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnX(aObject: TConnectorObject; aX: Double); var OldPointX: Double; NewPointX: Double; MapScale: Double; begin try MapScale := GCadForm.PCad.MapScale; OldPointX := aObject.ActualPoints[1].x; NewPointX := aX / MapScale * 1000; aObject.Move(NewPointX - OldPointX, 0); except on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeX', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnY(aObject: TConnectorObject; aY: Double); var OldPointY: Double; NewPointY: Double; MapScale: Double; begin try MapScale := GCadForm.PCad.MapScale; OldPointY := aObject.ActualPoints[1].y; NewPointY := aY / MapScale * 1000; aObject.Move(0, NewPointY - OldPointY); except on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeY', E.Message); end; end; Procedure TF_SCSObjectsProp.CheckAddObjInPM(aObject: TConnectorObject); var ObjCatalog: TSCSCatalog; begin ObjCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(aObject.ID); if ObjCatalog = nil then begin AddConnObjectInPM(aObject.ID, aObject.FCabinetID, aObject.Name); end; end; Procedure TF_SCSObjectsProp.PutNBObjectOnHeight(aObject: TConnectorObject; aHeight: Double; aTraceList: TList; WayList: TList); var i, j, k: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; NB_Connector: TConnectorObject; // объект на коннекторе (если есть и коннектор пустой) VertLine: TOrthoLine; // вертикаль LowVConn, HighVConn: TConnectorObject; // коннекторы вертикали CanSnapToVertical: Boolean; DirectionUP, DirectionDown: Boolean; // направление сдвига от базового положения коннектора (вверх/вниз) LastObject: TConnectorObject; // следующий коннектор (вверх/вниз) если есть коленчастое построение(пока не получим последний возможный) // WayList: TList; // путь до точки спуска/подъема (трассы) CanLook: Boolean; RaisedLinesList: TList; // список поднятых трасс от коннектора CanRaiseLine: Boolean; ConnectorToSnap, TempConn: TConnectorObject; CanRaiseAllTracesAtOnce: Boolean; ObjParams: TObjectParams; NeedToCreateVLine: Boolean; // добавить вертикаль от точки спуска/подъема, если перескочим CreateDConn: TConnectorObject; // созданный коннектор (если поднимаемся/опускаемся от пересечения трасс и не все трассы можно двигать) RaiseLineToVertical: TOrthoLine; // райз, который нужно преобразовать в вертикаль (если поймаем) CanDelEmptyLines: Boolean; // произвести удаление пройденных вертикалей, если они ни к чему не подключены с одной стороны CanDelConnectorsFromPointObject: Boolean; // можно удалять коннекторы с точечного объекта TempLineList: TList; aObjectVLinesCount : integer; RaiseLine: TOrthoLine; // райз на поинте, если есть HasVLines: Boolean; // есть ли вертикали на объекте function CanRaiseAllTraces(aConnector: TConnectorObject): Boolean; var i, j: Integer; VLine1, VLine2: TOrthoLine; JoinedVLine: TOrthoLine; // RaiseLine: TOrthoLine; LastConn: TConnectorObject; JoinedLinesCount: Integer; begin Result := False; // если не разрешено размещение трасс на уровне точечных и есть приконнекченные Нерайзы и Невертикали -- нах if ((ATraceList.Count > 0) and (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM)) then Exit; if RaiseLine <> nil then Exit; JoinedLinesCount := 0; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectoRObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if not TOrthoLine(TConnectoRObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and Not TOrthoLine(TConnectoRObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then Inc(JoinedLinesCount); end; end; // если есть нерайзы и невертикали и не разрешено размещение трасс на высоте рабочих мест - все сместе перемещеть нельзя if ((JoinedLinesCount > 0) and (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM)) then exit; Result := True; // проверяем, можно ли с объектом вместе двинуть все приконнекченные вертикали VLine1 := nil; VLine2 := Nil; RaiseLine := nil; // RaiseLine := Nil; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); Break; //// BREAK ////; end; if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin if VLine1 = nil then VLine1 := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]) else VLine2 := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); end; end; if ((RaiseLine <> nil) or (VLine2 <> nil)) then Break; //// BREAK //// end; // если есть вертикали - смотрим направление движения и определяем "перепрыгивание" или // снап на вертикаль через коннектор if ((VLine1 <> nil) and (VLine2 = nil)) then begin if DirectionUP then begin LastConn := Nil; // коннектор вертикали, который выше if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then LastConn := TConnectorObject(VLine1.JoinConnector1) else if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then LastConn := TConnectorObject(VLine1.JoinConnector2); end else if DirectionDown then begin // коннектор вертикали, который ниже if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then LastConn := TConnectorObject(VLine1.JoinConnector1) else if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then LastConn := TConnectorObject(VLine1.JoinConnector2); end; if LastConn <> nil then begin if LastConn.JoinedConnectorsList.Count > 0 then LastConn := TConnectorObject(LastConn.JoinedConnectorsList[0]); end; if ((DirectionUP and (CompareValue(LastConn.ActualZOrder[1], aHeight) = -1)) or (DirectionDown and (CompareValue(LastConn.ActualZOrder[1], aHeight) = 1))) then begin if LastConn.ConnectorType = ct_Clear then begin for i := 0 to LastConn.JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(LastConn.JoinedOrtholinesList[i]).FIsVertical and (TOrthoLine(LastConn.JoinedOrtholinesList[i]).ID <> VLine1.ID)) then begin Result := False; Exit; end; end; end else if LastConn.ConnectorType = ct_NB then begin for i := 0 to LastConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(LastConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(LastConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(LastConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> VLine1.ID)) then begin Result := False; Exit; end; end; end; end; end; end else // если вертикали -- две if ((VLine1 <> nil) and (VLine2 <> nil)) then begin Result := False; // здесь можно двигать вертикали, если двигаемся, не выходя за пределы этих самых вертикалей // попадание на первую вертикаль if ( (((CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], aHeight) = 1) and (CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], aHeight) = -1)) or ((CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], aHeight) = 1))) // попадание на вторую вертикаль or (((CompareValue(TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1], aHeight) = 1) and (CompareValue(TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1], aHeight) = -1)) or ((CompareValue(TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1], aHeight) = 1))) ) then Result := True; end; end; Function HasConnectorVertLine(AConnector: TConnectorObject; aList: TList): Boolean; var i, j: Integer; JoinedLine: TOrthoLine; begin Result := False; for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(AConnector.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(AConnector.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); if AList.IndexOf(JoinedLine) = -1 then begin Result := True; break; end; end; end; end; Procedure CreateVertLineOnHeight; var i, j : Integer; VConn1, VConn2 : TConnectorObject; vLine: TOrthoLine; SnapConn, TempConn: TConnectorObject; function GetLastConnFromWay: TConnectorObject; var i: Integer; WayListLine: TOrthoLine; begin Result := Nil; if WayList.Count > 0 then begin WayListLine := TOrthoLine(WayList[0]); Result := TConnectorObject(WayListLine.JoinConnector1); if DirectionUP and (CompareValue(Result.ActualZOrder[1], TConnectorObject(WayListLine.JoinConnector2).ActualZOrder[1]) = -1) then Result := TConnectorObject(WayListLine.JoinConnector2) else if DirectionDown and (CompareValue(Result.ActualZOrder[1], TConnectorObject(WayListLine.JoinConnector2).ActualZOrder[1]) = 1) then Result := TConnectorObject(WayListLine.JoinConnector2); for i := 1 to WayList.Count - 1 do begin WayListLine := TOrthoLine(WayList[i]); if DirectionUP and (CompareValue(Result.ActualZOrder[1], TConnectorObject(WayListLine.JoinConnector1).ActualZOrder[1]) = -1) then Result := TConnectorObject(WayListLine.JoinConnector2) else if DirectionDown and (CompareValue(Result.ActualZOrder[1], TConnectorObject(WayListLine.JoinConnector1).ActualZOrder[1]) = 1) then Result := TConnectorObject(WayListLine.JoinConnector2); if DirectionUP and (CompareValue(Result.ActualZOrder[1], TConnectorObject(WayListLine.JoinConnector2).ActualZOrder[1]) = -1) then Result := TConnectorObject(WayListLine.JoinConnector2) else if DirectionDown and (CompareValue(Result.ActualZOrder[1], TConnectorObject(WayListLine.JoinConnector2).ActualZOrder[1]) = 1) then Result := TConnectorObject(WayListLine.JoinConnector2); end; end; end; begin TempConn := nil; if (CanRaiseAllTracesAtOnce and (aObjectVLinesCount = 1) and (WayList.Count = 1)) then begin VLine := Nil; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin VLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); break; end; end; if VLine <> nil then Break; //// BREAK //// end; { // переворот вертикали if (TOrthoLine(WayList[0]).Id = VLine.Id) and (aObject.JoinedConnectorsList.Count = 1) then Exit;} end; // выровнять коннекторы по объекту для вертикалей или райзов for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin TempConn := TConnectorObject(aObject.JoinedConnectorsList[i]); TempConn.Move(aObject.ActualPoints[1].x - TempConn.ActualPoints[1].x, aObject.ActualPoints[1].y - TempConn.ActualPoints[1].y); end; end; TempConn := Nil; // вверх if DirectionUP then begin if CreatedConn = nil then CreatedConn := GetLastConnFromWay; if HighVConn = nil then begin if CreatedConn <> nil then HighVConn := CreatedConn; end; if HighVConn <> nil then begin VConn1 := HighVConn; if aObject.ConnectorType = ct_Clear then Vconn2 := AObject else if aObject.ConnectorType = ct_NB then begin //VConn2 := TConnectorObject.Create(HighVConn.ActualPoints[1].x, HighVConn.ActualPoints[1].y, aObject.ActualZOrder[1], HighVConn.LayerHandle, mydsNormal, GCadForm.PCad); VConn2 := TConnectorObject.Create(aObject.ActualPoints[1].x, AObject.ActualPoints[1].y, aObject.ActualZOrder[1], HighVConn.LayerHandle, mydsNormal, GCadForm.PCad); VConn2.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(aObject.LayerHandle), VConn2, False); VConn2.Name := cCadClasses_Mes12; SetNewObjectNameInPM(VConn2.ID, VConn2.Name); ObjParams := GetFigureParams(VConn2.ID); VConn2.Name := ObjParams.Name; VConn2.FIndex := ObjParams.MarkID; VConn2.JoinedConnectorsList.Insert(0, aObject); aObject.JoinedConnectorsList.Add(VConn2); DeleteObjectFromPM(VConn2.ID, VConn2.Name); // Tolik 19/11/2019 -- end; {if WayList.Count > 1 then TempConn := TConnectorObject(TOrthoLine(WayList[WayList.Count - 1]).JoinConnector1) else TempConn := HighVConn;} { TConnectorObject(aObject).Move(TempConn.ActualPoints[1].x - TConnectorObject(aObject).ActualPoints[1].x, TempConn.ActualPoints[1].y - TConnectorObject(aObject).ActualPoints[1].y); } // выровнять по точечному (на всякий) VConn1.Move(aObject.ActualPoints[1].x - VConn1.ActualPoints[1].x, aObject.ActualPoints[1].y - VConn1.ActualPoints[1].y); VConn2.Move(aObject.ActualPoints[1].x - VConn2.ActualPoints[1].x, aObject.ActualPoints[1].y - VConn2.ActualPoints[1].y); // VertLine := TOrthoLine.Create(VConn1.ActualPoints[1].x, VConn1.ActualPoints[1].y, VConn1.ActualZOrder[1], VConn1.ActualPoints[1].x, VConn1.ActualPoints[1].y, VConn2.ActualZOrder[1], 1,ord(psSolid), clBlack, 0, AObject.LayerHandle, mydsNormal, GCadForm.PCad, False); VertLine.SetJConnector1(TConnectorObject(VConn1)); VertLine.SetJConnector2(TConnectorObject(VConn2)); VertLine.ActualZOrder[1] := VConn1.ActualZOrder[1]; VertLine.ActualZOrder[2] := VConn2.ActualZOrder[1]; GCadForm.PCad.AddCustomFigure (GLN(aObject.LayerHandle), VertLine, False); SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]); SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]); VertLine.Name := cCadClasses_Mes32; SetNewObjectNameInPM(VertLine.ID, VertLine.Name); ObjParams := GetFigureParams(VertLine.ID); VertLine.Name := ObjParams.Name; VertLine.FIndex := ObjParams.MarkID; VertLine.FIsVertical := True; VertLine.LockMove := False; VertLine.LockModify := True; VertLine.CalculLength := VertLine.LengthCalc; VertLine.LineLength := VertLine.CalculLength; SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength); VertLine.ReCreateCaptionsGroup(True, false); VertLine.UpdateLengthTextBox(True, false); VertLine.ReCreateNotesGroup(True); VertLine.ShowCaptions := False; VertLine.ShowNotes := False; VertLine.IsShowBlock := False; end; end else // вниз if DirectionDown then begin if CreatedConn = nil then CreatedConn := GetLastConnFromWay; if LowVConn = Nil then begin if CreatedConn <> nil then LowVConn := CreatedConn; end; { if WayList.Count > 1 then TempConn := TConnectorObject(TOrthoLine(WayList[WayList.Count - 1]).JoinConnector1) else TempConn := LowVConn;} if LowVConn <> nil then begin // создать коннекторы { if CreatedConn <> nil then VConn1 := CreateDConn else VConn1 := LowVConn;} VConn2 := LowVConn; if aObject.ConnectorType = ct_Clear then VConn1 := AObject else if aObject.ConnectorType = ct_NB then begin // VConn1 := TConnectorObject.Create(VConn2.ActualPoints[1].x, VConn2.ActualPoints[1].y, aObject.ActualZOrder[1], VConn2.LayerHandle, mydsNormal, GCadForm.PCad); VConn1 := TConnectorObject.Create(aObject.ActualPoints[1].x, aObject.ActualPoints[1].y, aObject.ActualZOrder[1], VConn2.LayerHandle, mydsNormal, GCadForm.PCad); VConn1.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(aObject.LayerHandle), VConn1, False); VConn1.Name := cCadClasses_Mes12; SetNewObjectNameInPM(VConn1.ID, VConn1.Name); ObjParams := GetFigureParams(VConn1.ID); VConn1.Name := ObjParams.Name; VConn1.FIndex := ObjParams.MarkID; VConn1.JoinedConnectorsList.Insert(0, aObject); aObject.JoinedConnectorsList.Add(VConn1); DeleteObjectFromPM(VConn1.ID, VConn1.Name); end; // Vconn2 := LowVConn; {TConnectorObject(aObject).Move(VConn2.ActualPoints[1].x - TConnectorObject(aObject).ActualPoints[1].x, VConn2.ActualPoints[1].y - TConnectorObject(aObject).ActualPoints[1].y);} // выровнять по точечному (на всякий) VConn1.Move(aObject.ActualPoints[1].x - VConn1.ActualPoints[1].x, aObject.ActualPoints[1].y - VConn1.ActualPoints[1].y); VConn2.Move(aObject.ActualPoints[1].x - VConn2.ActualPoints[1].x, aObject.ActualPoints[1].y - VConn2.ActualPoints[1].y); // VertLine := TOrthoLine.Create(VConn1.ActualPoints[1].x, VConn1.ActualPoints[1].y, VConn1.ActualZOrder[1], VConn1.ActualPoints[1].x, VConn1.ActualPoints[1].y, VConn2.ActualZOrder[1], 1,ord(psSolid), clBlack, 0, AObject.LayerHandle, mydsNormal, GCadForm.PCad, False); VertLine.SetJConnector1(TConnectorObject(VConn1)); VertLine.SetJConnector2(TConnectorObject(VConn2)); VertLine.ActualZOrder[1] := VConn1.ActualZOrder[1]; VertLine.ActualZOrder[2] := VConn2.ActualZOrder[1]; GCadForm.PCad.AddCustomFigure (GLN(aObject.LayerHandle), VertLine, False); SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]); SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]); VertLine.Name := cCadClasses_Mes32; SetNewObjectNameInPM(VertLine.ID, VertLine.Name); ObjParams := GetFigureParams(VertLine.ID); VertLine.Name := ObjParams.Name; VertLine.FIndex := ObjParams.MarkID; VertLine.FIsVertical := True; VertLine.LockMove := False; VertLine.LockModify := True; VertLine.CalculLength := VertLine.LengthCalc; VertLine.LineLength := VertLine.CalculLength; SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength); VertLine.ReCreateCaptionsGroup(True, false); VertLine.UpdateLengthTextBox(True, false); VertLine.ReCreateNotesGroup(True); VertLine.ShowCaptions := False; VertLine.ShowNotes := False; VertLine.IsShowBlock := False; end; end; end; Procedure LookUPDOWN; var i: Integer; VLineConn, TempConn: TConnectorObject; VLine: TOrthoLine; VLineFound: boolean; JoinedConn: TConnectorObject; RaiseLineFound: Boolean; function LookForVLine(aConn: TConnectorObject): TConnectorObject; var i, j: Integer; TempConnector: TConnectorObject; JoinedLine: TOrthoLine; HighLineConn, LowLineConn: TConnectorObject; begin Result := nil; if DirectionUP then begin for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin // если вертикаль JoinedLine := TOrthoLine(aConn.JoinedOrtholinesList[i]); if JoinedLine.FIsVertical then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор вертикали if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector2); if ((CompareValue(HighLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = 1) and (CompareValue(HighLineConn.ActualZOrder[1], aHeight) = -1)) then begin if HighLineConn.JoinedConnectorsList.Count > 0 then Result := TConnectorObject(HighLineConn.JoinedConnectorsList[0]) else Result := HighLineConn; Exit; end; end; end else // если райз if JoinedLine.FIsRaiseUpDown then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор райза if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector2); if CompareValue(HighLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = 1 then WayList.Add(JoinedLine); Exit; // по-любому, т.к. вертикалей в таком случае не будет end; end; end; end else if DirectionDown then begin for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin // если вертикаль JoinedLine := TOrthoLine(aConn.JoinedOrtholinesList[i]); if JoinedLine.FIsVertical then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор вертикали if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector2); if ((CompareValue(LowLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = -1) and (CompareValue(LowLineConn.ActualZOrder[1], aHeight) = 1)) then begin if LowLineConn.JoinedConnectorsList.Count > 0 then Result := TConnectorObject(LowLineConn.JoinedConnectorsList[0]) else Result := LowLineConn; Exit; end; end; end else // если райз if JoinedLine.FIsRaiseUpDown then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор райза if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector2); if CompareValue(LowLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = -1 then WayList.Add(JoinedLine); Exit; // по-любому, т.к. вертикалей в таком случае не будет end; end; end; end; end; begin JoinedConn := aObject; CanLook := True; While CanLook do begin CanLook := False; if JoinedConn.ConnectorType = ct_NB then begin for i := 0 to JoinedConn.JoinedConnectorsList.Count - 1 do begin TempConn := TConnectorObject(JoinedConn.JoinedConnectorsList[i]); TempConn := LookForVLine(TempConn); if TempConn <> nil then begin JoinedConn := TempConn; TempConn := nil; CanLook := True; Break; //// BREAK ////; end; if RaiseLineFound then Exit; end; end else if JoinedConn.ConnectorType = ct_Clear then begin JoinedConn := LookForVLine(JoinedConn); if JoinedConn <> nil then CanLook := True; end; end; end; function CheckNeedToCreateVLine : boolean; var i, j: Integer; vConn: TConnectorObject; currLine: TOrthoLine; RaiseLine: TOrthoLine; CanAddLine: Boolean; VLineCount: Integer; begin Result := False; // если стоим на точечном - создаем однозначно (или поднимаеи/опускаем без прохождения // вертикали/райза, причем не все трассы пересечения) if (((aObject.JoinedConnectorsList.Count > 0) and (WayList.Count = 0)) or ((WayList.Count = 0) and (aObject.JoinedConnectorsList.Count = 0) and (not CanRaiseAllTracesAtOnce))) then begin Result := True; {if CreatedConn = Nil then begin // создаем коннектор вертикали CreateDConn := TConnectorObject.Create(aObject.ActualPoints[1].x, aObject.ActualPoints[1].y, aObject.ActualZOrder[1], aObject.LayerHandle, mydsNormal, GCadForm.PCad); CreateDConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(aObject.LayerHandle), CreateDConn, False); CreateDConn.Name := cCadClasses_Mes12; // SetNewObjectNameInPM(CreateDConn.ID, CreateDConn.Name); ObjParams := GetFigureParams(CreateDConn.ID); CreateDConn.Name := ObjParams.Name; CreateDConn.FIndex := ObjParams.MarkID; // прицепить к объекту(если есть) if aObject.JoinedCOnnectorsList.Count > 0 then begin CreatedConn.JoinedConnectorsList.Add(TConnectorObject(aObject.JoinedConnectorsList[0])); TConnectorObject(aObject.JoinedConnectorsList[0]).JoinedConnectorsList.Add(CreatedConn); end // если не все трассы двигаем и точечного нет - переконнектить все, что не двигаем на созданный коннектор else begin if not CanRaiseAllTracesAtOnce then begin CanAddLine := True; While CanAddLine do begin CanAddLine := False; for i := 0 to aObject.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(aObject.JoinedOrtholinesList[i]); if ATraceList.IndexOf(CurrLine) = -1 then begin // перепривязка aObject.JoinedOrtholinesList.Remove(CurrLine); CreateDConn.JoinedOrtholinesList.Add(CurrLine); if TConnectorObject(currLine.JoinConnector1).Id = aObject.ID then CurrLine.SetJConnector1(CreatedConn) else if TConnectorObject(CurrLine.JoinConnector2).Id = aObject.ID then CurrLine.SetJConnector2(CreatedConn); CanAddLine := True; end; end; end; end; end; end; } // выравнять коннектор по точечному объекту {if aObject.JoinedConnectorsList.Count > 0 then CreatedConn.Move(TConnectorObject(aObject.JoinedConnectorsList[0]).ActualPoints[1].x - CreatedConn.ActualPoints[1].x, TConnectorObject(aObject.JoinedConnectorsList[0]).ActualPoints[1].y - CreatedConn.ActualPoints[1].y); } // Exit; end; // если пересечение трасс vConn := Nil; // Если есть пройденные вертикали // if WayList.Count > 0 then if WayList.Count > 0 then begin currLine := Nil; // на пути могут быть и точечные объекты, нужно найти ортолинию !!! for i := (WayList.Count - 1) downto 0 do begin if CheckFigureByClassName(TFigure(WayList[i]), cTOrthoLine) then currLine := TOrthoLine(WayList[i]); if currLine <> nil then Break; //// BREAK //// end; if currLine <> nil then begin if DirectionUp then begin if CompareValue(TConnectorObject(currLine.JoinConnector1).ActualZOrder[1], TConnectorObject(currLine.JoinConnector2).ActualZOrder[1]) = 1 then VConn := TConnectorObject(TConnectorObject(currLine.JoinConnector1)) else if CompareValue(TConnectorObject(currLine.JoinConnector1).ActualZOrder[1], TConnectorObject(currLine.JoinConnector2).ActualZOrder[1]) = -1 then VConn := TConnectorObject(TConnectorObject(currLine.JoinConnector2)); end else if DirectionDown then begin if CompareValue(TConnectorObject(currLine.JoinConnector1).ActualZOrder[1], TConnectorObject(currLine.JoinConnector2).ActualZOrder[1]) = -1 then VConn := TConnectorObject(TConnectorObject(currLine.JoinConnector1)) else if CompareValue(TConnectorObject(currLine.JoinConnector1).ActualZOrder[1], TConnectorObject(currLine.JoinConnector2).ActualZOrder[1]) = 1 then VConn := TConnectorObject(TConnectorObject(currLine.JoinConnector2)); end; if VConn <> nil then begin if (CompareValue(VConn.ActualZOrder[1], aHeight) <> 0) and ((VConn.JoinedConnectorsList.Count > 0) or (vConn.JoinedOrtholinesList.Count > 1)) then begin // Tolik -- 14/07/2016 -- если вертикаль - одна и разрешено размещение трасс на уровне РМ, то вертикаль не создаем, // а просто подвинем коннектор if (F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM and (WayList.Count = 1)) then begin VLineCount := 0; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then Inc(VLineCount); end; end; // переворот вертикали if VLineCount <= 1 then Exit; end; //07/04/2016 -- создавать вертикаль только в том случае, если не она не будет переворачиваться в результате сдвига // нужно создать вертикаль Result := True; // создаем нижний коннектор вертикали {if CreatedConn = nil then begin if (VConn.ConnectorType = ct_Clear) and (VConn.JoinedConnectorsList.Count = 0) and (VConn.JoinedOrtholinesList.Count > 1) then CreatedConn := vConn else begin CreateDConn := TConnectorObject.Create(VConn.ActualPoints[1].x, VConn.ActualPoints[1].y, VConn.ActualZOrder[1], VConn.LayerHandle, mydsNormal, GCadForm.PCad); CreateDConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(VConn.LayerHandle), CreateDConn, False); CreateDConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(CreateDConn.ID, CreateDConn.Name); ObjParams := GetFigureParams(CreateDConn.ID); CreateDConn.Name := ObjParams.Name; CreateDConn.FIndex := ObjParams.MarkID; // прицепить сразу (к объекту, если есть) if VConn.ConnectorType = ct_NB then begin vConn.JoinedConnectorsList.Add(CreatedConn); CreateDConn.JoinedConnectorsList.Add(VConn); DeleteObjectFromPm(CreatedConn.ID, CreatedConn.Name); end else if vConn.ConnectorType = ct_Clear then begin if VConn.JoinedConnectorsList.Count > 0 then begin // ct_NB TConnectorObject(VConn.JoinedConnectorsList[0]).JoinedConnectorsList.Add(CreatedConn); CreatedConn.JoinedCOnnectorsList.Add(TConnectorObject(VConn.JoinedConnectorsList[0])); DeleteObjectFromPm(CreatedConn.ID, CreatedConn.Name); end end; end; end;} end // просто поднять коннектор последней вертикали else ConnectorToSnap := VConn; end; end; end // если не проходим вертикаль - пляшем от пустого коннектора else begin end; end; // переконнектить трассы, которые не будут подниматься, на новый коннектор (* function ReconnectOnPointByConn\(AConn: TConnectorObject): TConnectorObject; Var ConnectedConn: TConnectorObject; i, j: Integer; ReconnLine, LastVLine: TOrthoLine; CanReconnect: Boolean; LastConnector, NB_Conn, LineConn: TConnectorObject; CanCreateNewConn: Boolean; VLineCount: Integer; // количество вертикалей на поинте CanDisJoinVLines: Boolean; VLine1, VLine2: TOrthoLine; // вертикали на точечном, если есть JoinedLinesCount: Integer; JoinedRaiseLine: TOrthoLine; // райз, если есть function CheckCanDisJoinVLinesFromPointObj (aVLine1, aVLine2: TOrthoLine): Boolean; var i,j: Integer; LastConnector: TConnectorObject; begin Result := False; if VLine1 = nil then Exit; // -- нет вертикалей // тут смотрим, только если вертикалей - 2 шт // НЕЗАВИСИМО ОТ НАСТРОЕК (РАЗМЕЩАТЬ/НЕ РАзМЕЩАТЬ ТРАССЫ НА ВЫСОТЕ РМ) if (VLine1 <> nil) and (VLine2 <> nil) then begin // если вертикалей - 2 шт и перепрыгиваем через вертикаль, то нужно отрывать однозначно, // иначе -- нет if DirectionUP then begin // берем коннектор, который выше всех LastConnector := TConnectorObject(VLine1.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then LastConnector := TConnectorObject(VLine1.JoinConnector2); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = -1 then LastConnector := TConnectorObject(VLine2.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = -1 then LastConnector := TConnectorObject(VLine2.JoinConnector2); // если перескочим вертикаль или попадем на другой коннектор - отрывать однозначно if CompareValue(LastConnector.ActualZOrder[1], aHeight) = -1 then Result := True; end else if DirectionDown then begin // берем коннектор, который ниже всех LastConnector := TConnectorObject(VLine1.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then LastConnector := TConnectorObject(VLine1.JoinConnector2); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = 1 then LastConnector := TConnectorObject(VLine2.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = 1 then LastConnector := TConnectorObject(VLine2.JoinConnector2); // если перескочим вертикаль или попадем на другой коннектор - отрывать однозначно if CompareValue(LastConnector.ActualZOrder[1], aHeight) = 1 then Result := True; end; end; // если вертикаль - одна, и не разрешено размещение трасс на высоте РМ if (not Result) and (VLine2 = nil) and (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) then begin for i := 0 to AConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(AConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if ((not TOrthoLine(TConnectorObject(AConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical) or (not TOrthoLine(TConnectorObject(AConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown)) then Result := True; Break; //// BREAK ////; end; end; end; end; begin Result := nil; JoinedLinesCount := 0; JoinedRaiseLine := nil; CreatedConn := Nil; CanDisJoinVLines := False; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedLinesCount := JoinedLinesCount + TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count; if JoinedRaiseLine = nil then begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrthoLinesList[j]).FIsRaiseUpDown then JoinedRaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrthoLinesList[j]); CreateDConn := TConnectorObject(aObject.JoinedConnectorsList[i]); // коннектор райза должен остаться приконнекчен к райзу Break; //// BREAK ////; end; end; end; CanCreateNewConn := False; ConnectedConn := nil; VLineCount := 0; // смотрим, можно ли отрывать вертикали от поинта if WayList <> nil then begin for i := 0 to WayList.Count - 1 do begin if CheckFigureByClassName(TFigure(WayList[i]), cTOrthoLine) then if TOrthoLine(WayList[i]).FIsVertical then Inc(VLineCount); end; end; {if VLineCount > 1 then CanDisJoinVLines := True;} if not CanDisJoinVLines then begin VLine1 := nil; VLine2 := nil; // смотрим количество вертикалей for i := 0 to AConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin if VLine1 = Nil then VLine1 := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]) else VLine2 := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); inc(VLineCount); end; end; end; CanDisJoinVLines := CheckCanDisJoinVLinesFromPointObj(VLine1, VLine2); end; // переконнектить только для пересечения трасс без точечного объекта //if AConn.JoinedConnectorsList.Count = 0 then begin // нужно ли пересоединение трасс {for i := 0 to AConn.JoinedOrthoLinesList.count - 1 do begin ReconnLine := TOrthoLine(AConn.JoinedOrtholinesList[i]); // если двигаем не все - нужно if (not ReconnLine.FIsVertical) and (not ReconnLine.FIsRaiseUpDown) and (ATraceList.IndexOf(ReconnLine) = -1) then begin CanCreateNewConn := True; Break; //// BREAK ////; end; // end; if CanCreateNewConn then } begin if aObject.JoinedConnectorsList.Count > 0 then begin // если не разрешено расположение трасс на уровне рабочих мест -- переконнектить присоединенные трассы между собой if not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin if CreateDConn = nil then begin CreateDConn := TConnectorObject(aObject.JoinedConnectorsList[0]); // 25/07/2016 -- CreatedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(CreateDConn); end; // if aObject.JoinedConnectorsList.Count > 0 then begin for i := aObject.JoinedConnectorsList.Count - 1 downto 0 do begin LineConn := TConnectorObject(aObject.JoinedConnectorsList[i]); if LineConn.Id <> CreateDConn.ID then begin for j := LineConn.JoinedOrtholinesList.Count - 1 downto 0 do begin ReconnLine := TOrthoLine(LineConn.JoinedOrtholinesList[j]); if not ReconnLine.Deleted then begin if ((not ReconnLine.FIsVertical) or (ReconnLine.FIsVertical and CanDisJoinVLines)) then begin if TConnectorObject(ReconnLine.JoinConnector1).ID = LineConn.ID then begin ReconnLine.JoinConnector1 := CreateDConn; ReconnLine.ActualPoints[1] := CreateDConn.ActualPoints[1]; if CreateDConn.JoinedOrtholinesList.IndexOf(ReconnLine) = -1 then CreateDConn.JoinedOrtholinesList.Add(ReconnLine); end else if TConnectorObject(ReconnLine.JoinConnector2).ID = LineConn.ID then begin ReconnLine.JoinConnector2 := CreateDConn; ReconnLine.ActualPoints[2] := CreateDConn.ActualPoints[1]; if CreateDConn.JoinedOrtholinesList.IndexOf(ReconnLine) = -1 then CreateDConn.JoinedOrtholinesList.Add(ReconnLine) end; ReconnLine.CalculLength := ReconnLine.LengthCalc; ReconnLine.LineLength := ReconnLine.CalculLength; ReconnLine.UpdateLengthTextBox(true, true); SetLineFigureLengthInPM(ReconnLine.ID, ReconnLine.LineLength); ReconnLine.ReCreateCaptionsGroup(True, True); ReconnLine.ReCreateNotesGroup(True); ReconnLine.ReCreateDrawFigureBlock; end; end; LineConn.JoinedOrtholinesList.Remove(ReconnLine); end; LineConn.Delete(False, false); end; end; end; // просто сбросить соединение // if JoinedRaiseLine = Nil then // райз не сбрасываем, иначе не сможем удалить begin CreateDConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(CreateDConn); end; end else // трассы - на высоте рабочих мест (оторвать только вертикали, если можно) begin if aObject.JoinedConnectorsList.Count > 1 then begin for i := aObject.JoinedConnectorsList.Count - 1 downto 0 do begin LineConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := LineConn.JoinedOrtholinesList.Count - 1 downto 0 do begin ReconnLine := TOrthoLine(LineConn.JoinedOrtholinesList[j]); if not ReconnLine.Deleted then begin if (ReconnLine.FIsVertical and CanDisJoinVLines) then begin if CreateDConn = Nil then begin if TConnectorObject(ReconnLine.JoinConnector1).ID = LineConn.ID then CreateDConn := TConnectorObject(ReconnLine.JoinConnector1) else if TConnectorObject(ReconnLine.JoinConnector2).ID = LineConn.ID then CreateDConn := TConnectorObject(ReconnLine.JoinConnector2); // сбросить первое найденное соединение if CreateDConn.JoinedConnectorsList.IndexOf(aObject) <> -1 then begin CreateDConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(CreateDConn); end; end else begin if TConnectorObject(ReconnLine.JoinConnector1).ID = LineConn.ID then begin ReconnLine.JoinConnector1 := CreateDConn; ReconnLine.ActualPoints[1] := CreateDConn.ActualPoints[1]; if CreateDConn.JoinedOrtholinesList.IndexOf(ReconnLine) = -1 then CreateDConn.JoinedOrtholinesList.Add(ReconnLine); end else if TConnectorObject(ReconnLine.JoinConnector2).ID = LineConn.ID then begin ReconnLine.JoinConnector2 := CreateDConn; ReconnLine.ActualPoints[2] := CreateDConn.ActualPoints[1]; if CreateDConn.JoinedOrtholinesList.IndexOf(ReconnLine) = -1 then CreateDConn.JoinedOrtholinesList.Add(ReconnLine) end; ReconnLine.CalculLength := ReconnLine.LengthCalc; ReconnLine.LineLength := ReconnLine.CalculLength; ReconnLine.UpdateLengthTextBox(true, true); SetLineFigureLengthInPM(ReconnLine.ID, ReconnLine.LineLength); ReconnLine.ReCreateCaptionsGroup(True, True); ReconnLine.ReCreateNotesGroup(True); ReconnLine.ReCreateDrawFigureBlock; LineConn.JoinedOrtholinesList.Remove(ReconnLine); LineConn.Delete(False, false); end; end; end; end; end; end; // просто сбросить соединение if CreateDConn <> nil then begin CreateDConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(CreateDConn); end; if RaiseLine <> nil then begin ReverseRaise(aObject); end; end; end; LineConn := CreateDConn; CreateDConn := nil; // создать коннектор // если на по пути подъема/спуска проходим несколько трасс - ищем последний коннектор if WayList.Count > 0 then begin // ищем последнюю вертикаль для коннекта, если не попадаем на вертикаль, ищем коннектор LastVLine := nil; for i := (WayList.Count - 1) downto 0 do begin if CheckFigureByClassName(TFigure(WayList[i]), cTOrthoLine) then begin LastVLine := TOrthoLine(WayList[i]); break; end; end; // LastVLine := TOrthoLine(WayList[WayList.Count - 1]); if LastVLine <> nil then begin // если попадаем на вертикаль - создавать коннектор не нужно, а созданный коннектор - сбросить if ((CompareValue(TConnectorObject(LastVLine.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(LastVLine.JoinConnector2).ActualZOrder[1], aHeight) = 1)) or ((CompareValue(TConnectorObject(LastVLine.JoinConnector1).ActualZOrder[1], aHeight) = 1) and (CompareValue(TConnectorObject(LastVLine.JoinConnector2).ActualZOrder[1], aHeight) = -1)) then ConnectedConn := nil else begin LastConnector := nil; // ищем последний коннектор на пути if DirectionUP then begin if (CompareValue(TConnectorObject(LastVLine.JoinConnector1).ActualZOrder[1], TConnectorObject(LastVLine.JoinConnector2).ActualZOrder[1]) = 1) then LastConnector := TConnectorObject(LastVLine.JoinConnector1) else if (CompareValue(TConnectorObject(LastVLine.JoinConnector1).ActualZOrder[1], TConnectorObject(LastVLine.JoinConnector2).ActualZOrder[1]) = -1) then LastConnector := TConnectorObject(LastVLine.JoinConnector2); end else if DirectionDown then begin if (CompareValue(TConnectorObject(LastVLine.JoinConnector1).ActualZOrder[1], TConnectorObject(LastVLine.JoinConnector2).ActualZOrder[1]) = -1) then LastConnector := TConnectorObject(LastVLine.JoinConnector1) else if (CompareValue(TConnectorObject(LastVLine.JoinConnector1).ActualZOrder[1], TConnectorObject(LastVLine.JoinConnector2).ActualZOrder[1]) = 1) then LastConnector := TConnectorObject(LastVLine.JoinConnector2); end; // смотрим куда приконнектить вертикаль (нужно ли создавать коннектор и новую вертикаль или приконнектить // к существующей вертикали и поднять ее, если можно на высоту) if LastConnector <> nil then begin // на точечном создаем однозначно новый и приконнектим к точечному сразу if LastConnector.JoinedConnectorsList.Count > 0 then begin NB_Conn := TConnectorObject(LastConnector.JoinedConnectorsList[0]); if ((NB_Conn <> nil) and (not NB_Conn.Deleted) and (CompareValue(NB_Conn.ActualZOrder[1], aHeight) <> 0)) then begin // создать коннектор ConnectedConn := TConnectorObject.Create(NB_Conn.ActualPoints[1].x, NB_Conn.ActualPoints[1].y, NB_Conn.ActualZOrder[1], NB_Conn.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(NB_Conn.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; // приконнектить к точечному ConnectedConn.JoinedConnectorsList.Add(NB_Conn); NB_Conn.JoinedConnectorsList.Add(ConnectedConn); end; end else begin ConnectedConn := nil; if ((LastConnector.JoinedOrtholinesList.Count = 1) and ((TOrthoLine(LastConnector.JoinedOrtholinesList[0]).FIsVertical) or (TOrthoLine(LastConnector.JoinedOrtholinesList[0]).FIsRaiseUpDown))) then ConnectedConn := LastConnector else begin for i := 0 to LastConnector.JoinedOrtholinesList.Count - 1 do begin ReconnLine := TOrthoLine(LastConnector.JoinedOrtholinesList[i]); if ((not ReconnLine.FIsVertical) and (not ReconnLine.FIsRaiseUpDown) and (ATraceList.IndexOf(ReconnLine) = -1)) then begin ConnectedConn := LastConnector; break; end; end; end; end; end; end; end; end; end; end; if (ConnectedConn <> nil) then Result := ConnectedConn else Result := LineConn; end; *) function ReconnectOnPointByConn(AConn: TConnectorObject): TConnectorObject; Var ConnectedConn: TConnectorObject; i, j: Integer; ReconnLine, LastVLine: TOrthoLine; CanReconnect: Boolean; LastConnector, NB_Conn, LineConn: TConnectorObject; CanCreateNewConn: Boolean; VLineCount: Integer; // количество вертикалей на поинте CanDisJoinVLines: Boolean; VLine1, VLine2: TOrthoLine; // вертикали на точечном, если есть JoinedLinesCount: Integer; JoinedRaiseLine: TOrthoLine; // райз, если есть RaiseLineConn1, RaiseLineConn2: TConnectorObject;// коннекторы райза JoinedConn: TConnectorObject; function CheckCanDisJoinVLinesFromPointObj (aVLine1, aVLine2: TOrthoLine): Boolean; var i: Integer; LastConnector: TConnectorObject; begin Result := False; if VLine1 = nil then Exit; // -- нет вертикалей // тут смотрим, только если вертикалей - 2 шт // НЕЗАВИСИМО ОТ НАСТРОЕК (РАЗМЕЩАТЬ/НЕ РАзМЕЩАТЬ ТРАССЫ НА ВЫСОТЕ РМ) if (VLine1 <> nil) and (VLine2 <> nil) then begin // если вертикалей - 2 шт и перепрыгиваем через вертикаль, то нужно отрывать однозначно, // иначе -- нет if DirectionUP then begin // берем коннектор, который выше всех LastConnector := TConnectorObject(VLine1.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then LastConnector := TConnectorObject(VLine1.JoinConnector2); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = -1 then LastConnector := TConnectorObject(VLine2.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = -1 then LastConnector := TConnectorObject(VLine2.JoinConnector2); // если перескочим вертикаль или попадем на другой коннектор - отрывать однозначно if CompareValue(LastConnector.ActualZOrder[1], aHeight) = -1 then Result := True; end else if DirectionDown then begin // берем коннектор, который ниже всех LastConnector := TConnectorObject(VLine1.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then LastConnector := TConnectorObject(VLine1.JoinConnector2); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = 1 then LastConnector := TConnectorObject(VLine2.JoinConnector1); if CompareValue(LastConnector.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = 1 then LastConnector := TConnectorObject(VLine2.JoinConnector2); // если перескочим вертикаль или попадем на другой коннектор - отрывать однозначно if CompareValue(LastConnector.ActualZOrder[1], aHeight) = 1 then Result := True; end; // если попадем на коннектор вертикали if (not Result) then begin if CompareValue(LastConnector.ActualZOrder[1], aHeight) = 0 then begin // коннектор для снапа ConnectorToSnap := TConnectorObject(LastConnector); if ConnectorToSnap.JoinedConnectorsList.Count > 0 then ConnectorToSnap := TConnectorObject(ConnectorToSnap.JoinedConnectorsList[0]); // отрывать будем! Result := True; end; end; end; // если вертикаль - одна if (not Result) and (VLine2 = nil) then begin // если попадем на коннектор вертикали - отрывать однозначно if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], aHeight) = 0 then begin Result := True; // коннектор для снапа ConnectorToSnap := TConnectorObject(VLine1.JoinConnector1); if ConnectorToSnap.JoinedConnectorsList.Count > 0 then ConnectorToSnap := TConnectorObject(ConnectorToSnap.JoinedConnectorsList[0]); end else if CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], aHeight) = 0 then begin Result := True; // коннектор для снапа ConnectorToSnap := TConnectorObject(VLine1.JoinConnector2); if ConnectorToSnap.JoinedConnectorsList.Count > 0 then ConnectorToSnap := TConnectorObject(ConnectorToSnap.JoinedConnectorsList[0]); end; // если не попали на коннектор вертикали If not Result then begin // если на пути прохода есть более чем 1 объект - отрывать однозначно if ((WayList <> nil) and (WayList.Count > 1)) then begin Result := True; // коннектор для снапа for i := (WayList.Count - 1) downto 0 do begin if CheckFigureByClassName(TFigure(WayList[i]), cTOrthoLine) then begin if CompareValue(TConnectorObject(TOrthoLine(WayList[i]).JoinConnector1).ActualZOrder[1], aHeight) = 0 then ConnectorToSnap := TConnectorObject(TOrthoLine(WayList[i]).JoinConnector1) else if CompareValue(TConnectorObject(TOrthoLine(WayList[i]).JoinConnector2).ActualZOrder[1], aHeight) = 0 then ConnectorToSnap := TConnectorObject(TOrthoLine(WayList[i]).JoinConnector2); if ((ConnectorToSnap <> nil) and (ConnectorToSnap.JoinedConnectorsList.Count > 0)) then ConnectorToSnap := TConnectorObject(ConnectorToSnap.JoinedConnectorsList[0]); Break; //// BREAK ////; end; end; end; end; end; end; function checkCanReverseRaise : Boolean; var RaiseConn: TConnectorObject; begin Result := False; RaiseConn := nil; if TConnectorObject(JoinedRaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseConn := TConnectorObject(JoinedRaiseLine.JoinConnector2) else if TConnectorObject(JoinedRaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseConn := TConnectorObject(JoinedRaiseLine.JoinConnector1); if RaiseConn <> nil then begin Result := True; if CompareValue(RaiseConn.ActualZOrder[1], aHeight) = 0 then begin Result := False; // Tolik 11/10/2021 -- exit; end; if DirectionUP then begin if ((CompareValue(RaiseConn.ActualZOrder[1], aHeight) <> 1) and (CompareValue(aObject.ActualZOrder[1], RaiseConn.ActualZOrder[1]) = -1)) then Exit else Result := False; end else if DirectionDown then begin if ((CompareValue(RaiseConn.ActualZOrder[1], aHeight) <> -1) and (CompareValue(aObject.ActualZOrder[1], RaiseConn.ActualZOrder[1]) = 1)) then exit else Result := False; end; end; end; begin Result := nil; JoinedLinesCount := 0; JoinedRaiseLine := nil; CreatedConn := Nil; CanDisJoinVLines := False; JoinedConn := nil; CanCreateNewConn := False; ConnectedConn := nil; VLineCount := 0; LineConn := nil; // присоединеные трассы { for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if ((not TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical) and (not TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown)) then Inc(JoinedLinesCount); // райз if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then JoinedRaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); end; end; } for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin Inc(JoinedLinesCount); // райз if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then JoinedRaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); end; end; if JoinedRaiseLine <> nil then begin if CheckCanReverseRaise then ReverseRaise(aObject); end; // если есть нерайзы и невертикали if JoinedLinesCount > 0 then begin // нельзя двигать присоединенные трассы вместе с РМ - переконнектить в точке if Not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then // просто переконнектить на точке все коннекторы в один begin RaiseLineConn1 := nil; if JoinedRaiseLine <> nil then // если есть райз - определить коннектор райза, чтобы не потерять begin if TConnectorObject(JoinedRaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector1) else if TConnectorObject(JoinedRaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector2); end; if RaiseLineConn1 = nil then // нет райза - взять первый попавшийся коннектор и переконнектить на нем RaiseLineConn1 := TConnectorObject(aObject.JoinedConnectorsList[0]); // сбросить соединение RaiseLineConn1.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn1); SetNewObjectNameInPM(RaiseLineConn1.ID, RaiseLineConn1.Name); // перекинуть свойста райза на пустой коннектор if JoinedRaiseLine <> nil then begin if aObject.FConnRaiseType <> crt_None then begin RaiseLineConn1.FConnRaiseType := aObject.FConnRaiseType; aObject.FConnRaiseType := crt_None; end; if JoinedRaiseLine.FObjectFromRaisedLine = aObject then JoinedRaiseLine.FObjectFromRaisedLine := RaiseLineConn1; if aObject.FObjectFromRaise <> nil then begin RaiseLineConn1.FObjectFromRaise := aObject.FObjectFromRaise; aObject.FObjectFromRaise := nil; end; end; // переконнектить трассы на пустой коннектор for i := (aObject.JoinedConnectorsList.Count - 1) downto 0 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := (JoinedConn.JoinedOrtholinesList.Count - 1) downto 0 do begin if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1).ID = JoinedConn.ID then begin TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1 := TFigure(RaiseLineConn1); RaiseLineConn1.JoinedOrthoLinesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])); end else if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector2).ID = JoinedConn.ID then begin TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector2 := TFigure(RaiseLineConn1); RaiseLineConn1.JoinedOrthoLinesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])); end; end; // сбросить соединение JoinedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(JoinedConn); JoinedConn.JoinedOrtholinesList.Clear; JoinedConn.Delete(false, false); end; // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn1.ID, RaiseLineConn1.Name); // если есть райз -- не потерять коннектор райза {if JoinedRaiseLine <> nil then begin RaiseLineConn1 := nil; if TConnectorObject(JoinedRaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector1) else if TConnectorObject(JoinedRaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector2); RaiseLineConn1.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn1); // переконнектить на райзе for i := (aObject.JoinedConnectorsList.Count - 1) downto 0 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := (JoinedConn.JoinedOrtholinesList.Count - 1) downto 0 do begin if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1).ID = JoinedConn.ID then begin TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1 := TFigure(RaiseLineConn1); end else if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1).ID = JoinedConn.ID then begin TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1 := TFigure(RaiseLineConn1); end; end; JoinedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(JoinedConn); JoinedConn.JoinedOrtholinesList.Clear; JoinedConn.Delete(false, false); end; end else // просто переконнектить все begin RaiseLineConn1 := TConnectorObject(aObject.JoinedConnectorsList[0]); RaiseLineConn1.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn1); for i := (aObject.JoinedConnectorsList.Count - 1) downto 0 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := (JoinedConn.JoinedOrtholinesList.Count - 1) downto 0 do begin if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1).ID = JoinedConn.ID then begin TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector1 := TFigure(RaiseLineConn1); if RaiseLineConn1.JoinedOrthoLinesList.IndexOf(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])) = -1 then RaiseLineConn1.JoinedOrthoLinesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])); end else if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector2).ID = JoinedConn.ID then begin TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).JoinConnector2 := TFigure(RaiseLineConn1); if RaiseLineConn1.JoinedOrthoLinesList.IndexOf(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])) = -1 then RaiseLineConn1.JoinedOrthoLinesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])); end; end; JoinedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(JoinedConn); JoinedConn.JoinedOrtholinesList.Clear; JoinedConn.Delete(false, false); end; end; } end else // Можно двигать присоединенные трассы // проверяем снапы и возможность двигать райзы/вертикали begin // райз (если есть) if JoinedRaiseLine <> nil then begin // Если попадем на второй коннектор райза - отсоединиться от текущего нах RaiseLineConn1 := nil; if CompareValue(TConnectorObject(JoinedRaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 0 then begin RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector1); RaiseLineConn2 := TConnectorObject(JoinedRaiseLine.JoinConnector2); end else if CompareValue(TConnectorObject(JoinedRaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 0 then begin RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector2); RaiseLineConn2 := TConnectorObject(JoinedRaiseLine.JoinConnector1); end; // если попадем - отсоединить if RaiseLineConn1 <> nil then begin // определить заодно и коннектор для снапа ConnectorToSnap := RaiseLineConn1; if ConnectorToSnap.JoinedConnectorsList.Count > 0 then ConnectorToSnap := TConnectorObject(RaiseLineConn1.JoinedConnectorsList[0]); RaiseLineConn2.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn2); // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn2.ID, RaiseLineConn2.Name); end; end // вертикали(если есть) // райза нет -- проверяем есть ли вертикали и будем ли мы их отрывать от коннектора else begin VLine1 := nil; VLine2 := nil; // смотрим количество вертикалей for i := 0 to AConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin if VLine1 = Nil then VLine1 := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]) else VLine2 := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); inc(VLineCount); end; end; end; CanDisJoinVLines := CheckCanDisJoinVLinesFromPointObj(VLine1, VLine2); // если оторвем коннектор от вертикалей - переконнектить вертикали if CanDisJoinVLines then begin RaiseLineConn1 := nil; RaiseLineConn2 := nil; if TConnectorObject(VLine1.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(VLine1.JoinConnector1) else if TConnectorObject(VLine1.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(VLine1.JoinConnector2); if RaiseLineConn1 <> nil then begin // отсоединить от объекта RaiseLineConn1.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn1); // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn1.ID, RaiseLineConn1.Name); if VLine2 <> nil then begin if TConnectorObject(VLine2.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then begin RaiseLineConn2 := TConnectorObject(VLine2.JoinConnector1); VLine1.JoinConnector1 := TFigure(RaiseLineConn1); RaiseLineConn2.JoinedOrtholinesList.Remove(VLine2); end else if TConnectorObject(VLine2.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then begin RaiseLineConn2 := TConnectorObject(VLine2.JoinConnector2); VLine1.JoinConnector2 := TFigure(RaiseLineConn1); RaiseLineConn2.JoinedOrtholinesList.Remove(VLine2); end; if RaiseLineConn2 <> nil then begin // отсоединить от объекта RaiseLineConn2.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn2); // удалить нах if RaiseLineConn2.JoinedOrtholinesList.Count = 0 then RaiseLineConn2.Delete(False, False) else // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn2.ID, RaiseLineConn2.Name); end; end; end; end; end; end; end else // если трасс нет begin // если есть Raise if JoinedRaiseLine <> nil then begin // Если попадем на второй коннектор райза - отсоединиться от текущего нах RaiseLineConn1 := nil; if CompareValue(TConnectorObject(JoinedRaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 0 then begin RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector1); RaiseLineConn2 := TConnectorObject(JoinedRaiseLine.JoinConnector2); end else if CompareValue(TConnectorObject(JoinedRaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 0 then begin RaiseLineConn1 := TConnectorObject(JoinedRaiseLine.JoinConnector2); RaiseLineConn2 := TConnectorObject(JoinedRaiseLine.JoinConnector1); end; // если попадем - отсоединить if RaiseLineConn1 <> nil then begin // определить заодно и коннектор для снапа ConnectorToSnap := RaiseLineConn1; if ConnectorToSnap.JoinedConnectorsList.Count > 0 then ConnectorToSnap := TConnectorObject(RaiseLineConn1.JoinedConnectorsList[0]); RaiseLineConn2.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn2); // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn2.ID, RaiseLineConn2.Name); RaiseLineConn2.FConnRaiseType := aObject.FConnRaiseType; aObject.FConnRaiseType := crt_None; if RaiseLine.FObjectFromRaisedLine <> nil then begin if RaiseLine.FObjectFromRaisedLine.ID = aObject.ID then begin if RaiseLineConn2.FConnRaiseType = crt_None then RaiseLine.FObjectFromRaisedLine := RaiseLineConn2 // Tolik 05/11/2018 nil -- нельзя!!!! else if RaiseLineConn1.FConnRaiseType = crt_None then RaiseLine.FObjectFromRaisedLine := RaiseLineConn1; {if RaiseLineConn1.JoinedConnectorsList.Count = 0 then begin RaiseLine.FObjectFromRaisedLine := nil; end else begin RaiseLine.FObjectFromRaisedLine := TConnectorObject(RaiseLineConn1.JoinedConnectorsList[0]); end;} end; end else begin if RaiseLineConn2.FConnRaiseType = crt_None then RaiseLine.FObjectFromRaisedLine := RaiseLineConn2 // Tolik 05/11/2018 nil -- нельзя!!!! else if RaiseLineConn1.FConnRaiseType = crt_None then RaiseLine.FObjectFromRaisedLine := RaiseLineConn1; end; //05/11/2018-- //RaiseLineConn2.FObjectFromRaise := aObject; //RaiseLineConn2.FConnRaiseType := RaiseLineConn1.FConnRaiseType; //RaiseLineConn1.FConnRaiseType := crt_None; //if RaiseLineConn2.FConnRaiseType = crt_None then // RaiseLineConn2.FConnRaiseType := crt_OnFloor; // end; end // райза нет -- проверяем есть ли вертикали и будем ли мы их отрывать от коннектора else begin VLine1 := nil; VLine2 := nil; // смотрим количество вертикалей for i := 0 to AConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin if VLine1 = Nil then VLine1 := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]) else VLine2 := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); inc(VLineCount); end; end; end; CanDisJoinVLines := CheckCanDisJoinVLinesFromPointObj(VLine1, VLine2); // если оторвем коннектор от вертикалей - переконнектить вертикали if CanDisJoinVLines then begin RaiseLineConn1 := nil; RaiseLineConn2 := nil; if TConnectorObject(VLine1.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(VLine1.JoinConnector1) else if TConnectorObject(VLine1.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then RaiseLineConn1 := TConnectorObject(VLine1.JoinConnector2); if RaiseLineConn1 <> nil then begin // отсоединить от объекта RaiseLineConn1.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn1); // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn1.ID, RaiseLineConn1.Name); if VLine2 <> nil then begin if TConnectorObject(VLine2.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then begin RaiseLineConn2 := TConnectorObject(VLine2.JoinConnector1); VLine1.JoinConnector1 := TFigure(RaiseLineConn1); RaiseLineConn2.JoinedOrtholinesList.Remove(VLine2); end else if TConnectorObject(VLine2.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then begin RaiseLineConn2 := TConnectorObject(VLine2.JoinConnector2); VLine1.JoinConnector2 := TFigure(RaiseLineConn1); RaiseLineConn2.JoinedOrtholinesList.Remove(VLine2); end; if RaiseLineConn2 <> nil then begin // отсоединить от объекта RaiseLineConn2.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(RaiseLineConn2); // удалить нах if RaiseLineConn2.JoinedOrtholinesList.Count = 0 then RaiseLineConn2.Delete(False, False) else // выставить пустой коннектор в ПМ-ку SetNewObjectNameInPM(RaiseLineConn1.ID, RaiseLineConn1.Name); end; end; end; end; end; end; {if (ConnectedConn <> nil) then Result := ConnectedConn else Result := LineConn;} // if (RaiseLineConn1 <> nil) then Result := RaiseLineConn1 else Result := LineConn; // если нужно создавать вертикаль и есть путь прохождения -- нужно получить крайнюю точку, к которой построим вертикаль if ((Result <> nil) and NeedToCreateVLine) then begin for i := 0 to WayList.Count - 1 do begin if (CheckFigureByClassName(TFigure(WayList[i]), cTOrthoLine) and (TOrthoLine(WayList[i]).FIsRaiseUpDown or TOrthoLine(WayList[i]).FIsVertical)) then begin if DirectionUP then begin if CompareValue(TConnectorObject(TOrthoLine(WayList[i]).JoinConnector1).ActualZOrder[1], Result.ActualZOrder[1]) = 1 then Result := TConnectorObject(TOrthoLine(WayList[i]).JoinConnector1); if CompareValue(TConnectorObject(TOrthoLine(WayList[i]).JoinConnector2).ActualZOrder[1], Result.ActualZOrder[1]) = 1 then Result := TConnectorObject(TOrthoLine(WayList[i]).JoinConnector2); end; if DirectionDown then begin if CompareValue(TConnectorObject(TOrthoLine(WayList[i]).JoinConnector1).ActualZOrder[1], Result.ActualZOrder[1]) = -1 then Result := TConnectorObject(TOrthoLine(WayList[i]).JoinConnector1); if CompareValue(TConnectorObject(TOrthoLine(WayList[i]).JoinConnector2).ActualZOrder[1], Result.ActualZOrder[1]) = -1 then Result := TConnectorObject(TOrthoLine(WayList[i]).JoinConnector2); end; end; end; // если крайняя точка - объект - прилепить к нему пустой коннектор для вертикали, которую потом создадим if Result.ConnectorType = ct_clear then if Result.JoinedConnectorsList.Count > 0 then Result := TConnectorObject(Result.JoinedConnectorsList[0]); // ct_NB if Result.ConnectorType = ct_NB then begin RaiseLineConn1 := Result; Result := TConnectorObject.Create(RaiseLineConn1.ActualPoints[1].x, RaiseLineConn1.ActualPoints[1].y, RaiseLineConn1.ActualZOrder[1], RaiseLineConn1.LayerHandle, mydsNormal, GCadForm.PCad); Result.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(RaiseLineConn1.LayerHandle), Result, False); Result.Name := cCadClasses_Mes12; //SetNewObjectNameInPM(Result.ID, Result.Name); ObjParams := GetFigureParams(Result.ID); Result.Name := ObjParams.Name; Result.FIndex := ObjParams.MarkID; RaiseLineConn1.JoinedConnectorsList.Add(Result); Result.JoinedConnectorsList.Add(RaiseLineConn1); end; end; end; // если найдет, вернет райз для преобразования в вертикаль + если в результате подъема/спуска трассы // попадем на коннектор спуска/подъема - выставит коннектор для снапа Function CheckConvertRaiseToVLine: TOrthoLine; var i, j: Integer; RaiseLine, TempLine: TOrthoLine; RaiseConn, JoinedConn: TConnectorObject; AllTracesMoved: boolean; {function GetRaiseConnByDirection(RLine: TOrthoLine): TConnectorObject; begin Result := Nil; // на всякий // если поднимаем трассу if DirectionUP then begin if CompareValue(TConnectorObject(RLine.JoinConnector1).ActualZOrder[1], TConnectorObject(RLine.JoinConnector2).ActualZOrder[1]) = 1 then Result := TConnectorObject(RLine.JoinConnector1) else if CompareValue(TConnectorObject(RLine.JoinConnector1).ActualZOrder[1], TConnectorObject(RLine.JoinConnector2).ActualZOrder[1]) = -1 then Result := TConnectorObject(RLine.JoinConnector2) end else // если опускаем трассу if DirectionDown then begin if CompareValue(TConnectorObject(RLine.JoinConnector1).ActualZOrder[1], TConnectorObject(RLine.JoinConnector2).ActualZOrder[1]) = 1 then Result := TConnectorObject(RLine.JoinConnector2) else if CompareValue(TConnectorObject(RLine.JoinConnector1).ActualZOrder[1], TConnectorObject(RLine.JoinConnector2).ActualZOrder[1]) = -1 then Result := TConnectorObject(RLine.JoinConnector1) end; end;} begin Result := Nil; RaiseLine := Nil; // если есть с/п и мы по нему проходим дальше if WayList.Count > 0 then begin for i := 0 to WayList.Count - 1 do begin if TOrthoLine(WayList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(WayList[i]); break; end; end; end; if RaiseLine = nil then begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); if Not Joinedconn.Deleted then begin for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); break; end; end; end; if RaiseLine <> nil then break; end; end; if RaiseLine <> nil then begin // если в результате подъема/спуска трассы попадем не вершину С/П - определить коннектор для снапа // и в таком случае преобразовывать райз в вертикаль не будем все равно // (если к объекту не подключены трассы - райз удалится) // если подключены - все равно удалится или останется в зависимости от свойства листа // "размещать трассы на высоте рабочих мест" if ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 0) or (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 0)) then begin RaiseConn := Nil; if (CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 0) then RaiseConn := TConnectorObject(RaiseLine.JoinConnector1) else if (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 0) then RaiseConn := TConnectorObject(RaiseLine.JoinConnector2); if Raiseconn <> nil then begin // на пустой коннектор if RaiseConn.JoinedConnectorsList.Count = 0 then ConnectorToSnap := RaiseConn else // на точечный объект ConnectorToSnap := TConnectorObject(RaiseConn.JoinedConnectorsList[0]); end; end else // если в результате снапа попадем на с/п (между коннекторами) -- преобразовать в вертикаль однозначно if (((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 1)) or ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = -1))) then begin Result := RaiseLine; end else // если есть райз и его нужно перепрыгнуть и добавить вертикаль - преобразовывать однозначно //if ((RaiseConn.JoinedConnectorsList.Count > 0) or (RaiseConn.JoinedOrtholinesList.Count > 1)) then begin {if ((DirectionUP and (CompareValue(RaiseConn.ActualZOrder[1], aHeight) = -1)) or (DirectionDown and (CompareValue(RaiseConn.ActualZOrder[1], aHeight) = 1))) then Result := RaiseLine;} //только в том случае, если не разрешены наклонные трассы if not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin if (((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = -1)) or ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 1))) then begin Result := RaiseLine; end; end; end; end else begin for i := 0 to WayList.Count - 1 do begin RaiseConn := nil; // смотрим коннектор для снапа (если вертикаль) //if (i = (WayList.Count - 1)) then begin RaiseLine := TOrthoLine(WayList[i]); if RaiseLine.FisVertical then begin if (CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aHeight) = 0) then RaiseConn := TConnectorObject(RaiseLine.JoinConnector1) else if (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aHeight) = 0) then RaiseConn := TConnectorObject(RaiseLine.JoinConnector2); // если снап на коннектор вертикали -- определяем коннектор для снапа if RaiseConn <> nil then begin if RaiseConn.JoinedConnectorsList.Count = 0 then ConnectorToSnap := RaiseConn else if Raiseconn.JoinedConnectorsList.Count > 0 then ConnectorToSnap := TConnectorObject(RaiseConn.JoinedConnectorsList[0]); end; end; end; end; end; if Result <> nil then begin Result.actualpoints[1] := aObject.ap1; Result.actualpoints[2] := aObject.ap1; TConnectorObject(Result.JoinConnector1).actualpoints[1] := aObject.ap1; TConnectorObject(Result.JoinConnector2).actualpoints[1] := aObject.ap1; ConvertRaiseToVertical(Result); exit; end; RaiseLine := nil; //просто пустой коннектор (не присоединен к точечному объекту) if aObject.JoinedConnectorsList.Count > 0 then begin for j := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for i := 0 to TConnectorObject(aObject.JoinedConnectorsList[j]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[j]).JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[j]).JoinedOrtholinesList[i]); //if Not AllTracesMoved then begin if DirectionUP then begin // если двинем в ообратную сторону от райза -- нужно конвертить и создавать новую вертикаль if ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], AObject.ActualZOrder[1]) = 0) or (CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], AObject.ActualZOrder[1]) = -1)) and ((CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], AObject.ActualZOrder[1]) = 0) or (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], AObject.ActualZOrder[1]) = -1)) then begin ConvertRaiseToVertical(RaiseLine); Result := RaiseLine; Exit; end; end else if DirectionDown then begin if ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], AObject.ActualZOrder[1]) = 0) or (CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], AObject.ActualZOrder[1]) = 1)) and ((CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], AObject.ActualZOrder[1]) = 0) or (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], AObject.ActualZOrder[1]) = 1)) then begin ConvertRaiseToVertical(RaiseLine); // выровнять вертикаль по точечному объекту { TConnectorObject(RaiseLine.JoinConnector1).Move(aObject.ActualPoints[1].x - TConnectorObject(RaiseLine.JoinConnector1).ActualPoints[1].x, aObject.ActualPoints[1].y - TConnectorObject(RaiseLine.JoinConnector1).ActualPoints[1].y); TConnectorObject(RaiseLine.JoinConnector2).Move(aObject.ActualPoints[1].x - TConnectorObject(RaiseLine.JoinConnector2).ActualPoints[1].x, aObject.ActualPoints[1].y - TConnectorObject(RaiseLine.JoinConnector2).ActualPoints[1].y);} Result := RaiseLine; Exit; end; end; // если попадем на райз и присоединенные к точечному трассы двигать нельзя if ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], AObject.ActualZOrder[1]) = 1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], AObject.ActualZOrder[1]) = -1)) or ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], AObject.ActualZOrder[1]) = -1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], AObject.ActualZOrder[1]) = 1)) then begin if (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) and (aObject.JoinedConnectorsList.Count > 1) then begin ConvertRaiseToVertical(RaiseLine); Result := RaiseLine; Exit; end; end; // end; {if RaiseLine <> nil then begin Result := RaiseLine; ConvertRaiseToVertical(Result); end;} end; end; end; end; end; // Function CheckDeleteVLine(aLine: TOrthoLine): Boolean; var canDelLine: Boolean; LineConn: TConnectorObject; OutCounter: Integer; begin Result := False; LineConn := nil; if not aLine.Deleted then begin if aLine.FisVertical then begin CanDelLine := False; if ((TConnectorObject(aLine.JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(aLine.JoinConnector1).JoinedOrtholinesList.Count = 1)) then CanDelLine := True else if ((TConnectorObject(aLine.JoinConnector2).JoinedConnectorsList.Count = 0) and (TConnectorObject(aLine.JoinConnector2).JoinedOrtholinesList.Count = 1)) then CanDelLine := True; if CanDelLine then begin // Сбросить подключение на коннекторах, если нужно LineConn := TConnectorObject(aLine.JoinConnector1); if LineConn.JoinedOrthoLinesList.Count > 1 then begin LineConn.JoinedOrtholinesList.Remove(aLine); aLine.JoinConnector1 := Nil; end; LineConn := TConnectorObject(aLine.JoinConnector2); if LineConn.JoinedOrthoLinesList.Count > 1 then begin LineConn.JoinedOrtholinesList.Remove(aLine); aLine.JoinConnector2 := Nil; end; // удалить трассу aLine.delete; Result := True; end; end // Райз else if aLine.FIsRaiseUpDown then begin if ConnectorToSnap <> nil then LineConn := nil; begin if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], ConnectorToSnap.ActualZOrder[1]) = 0 then LineConn := TConnectorObject(aLine.JoinConnector1) else if CompareValue(TConnectorObject(aLine.JoinConnector2).ActualZOrder[1], ConnectorToSnap.ActualZOrder[1]) = 0 then LineConn := TConnectorObject(aLine.JoinConnector2) end; if LineConn <> nil then begin {LineConn.FConnRaiseType := crt_None; LineConn.FObjectFromRaise := nil;} TConnectorObject(aLine.JoinConnector1).FConnRaiseType := crt_None; TConnectorObject(aLine.JoinConnector1).FObjectFromRaise := Nil; TConnectorObject(aLine.JoinConnector2).FConnRaiseType := crt_None; TConnectorObject(aLine.JoinConnector2).FObjectFromRaise := Nil; if (LineConn.JoinedConnectorsList.Count > 0) and (LineConn.JoinedConnectorsList.IndexOf(aObject) <> - 1) then begin LineConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(LineConn); end; if (LineConn.JoinedConnectorsList.Count = 0) and (LineConn.JoinedOrtholinesList.Count = 1) then begin aLine.FObjectFromRaisedLine := nil; aLine.Delete; end; end; end; end; end; Procedure CollectConnectors; var RaisedLine: TOrthoLine; i: Integer; RaisedLineConnector: TConnectorObject; procedure JoinTwoConnectors; var CanContinue: Boolean; i: Integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; CreatedConn: TConnectorObject; begin // отсоединить от точечного CanContinue := True; // тут отрывать по-любому (от коннектора) While CanContinue do begin CanContinue := False; for i := 0 to RaisedLineConnector.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(RaisedLineConnector.JoinedConnectorsList[i]); JoinedConn.JoinedConnectorsList.Remove(RaisedLineConnector); RaisedLineConnector.JoinedConnectorsList.Remove(JoinedConn); break; CanContinue := True; end; end; // переприсоединить ортолинии CanContinue := True; While CanContinue do begin CanContinue := False; for i := 0 to RaisedLineConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaisedLineConnector.JoinedOrtholinesList[i]); if (ATraceList.IndexOf(JoinedLine) <> -1) and (not JoinedLine.FisVertical) and (not JoinedLine.FIsRaiseUpDown) then begin CanContinue := True; RaisedLineConnector.JoinedOrthoLinesList.Remove(JoinedLine); if TConnectorObject(JoinedLine.JoinConnector1).Id = RaisedLineConnector.ID then JoinedLine.SetJConnector1(aObject) else if TConnectorObject(JoinedLine.JoinConnector2).Id = RaisedLineConnector.ID then JoinedLine.SetJConnector2(aObject); break; end; end; end; end; begin if ATraceList.Count > 1 then begin for i := 0 to ATraceList.count - 1 do begin RaisedLine := TOrthoLine(ATraceList[i]); if aObject.JoinedOrtholinesList.IndexOf(RaisedLine) = -1 then begin if ((not RaisedLine.FIsRaiseUpDown) and (not RaisedLine.FIsVertical)) then begin RaisedLineConnector := TConnectorObject(RaisedLine.JoinConnector1); if ((RaisedLineConnector.ID <> aObject.ID) and (CompareValue(RaisedLineConnector.ActualPoints[1].x, aObject.ActualPoints[1].x) = 0) and (CompareValue(RaisedLineConnector.ActualPoints[1].y, aObject.ActualPoints[1].y) = 0)) then JoinTwoConnectors else begin RaisedLineConnector := TConnectorObject(RaisedLine.JoinConnector2); if ((RaisedLineConnector.ID <> aObject.ID) and (CompareValue(RaisedLineConnector.ActualPoints[1].x, aObject.ActualPoints[1].x) = 0) and (CompareValue(RaisedLineConnector.ActualPoints[1].y, aObject.ActualPoints[1].y) = 0)) then JoinTwoConnectors; end; if RaisedLineConnector.JoinedOrthoLinesList.Count = 1 then begin RaisedLine := TOrthoLine(RaisedLineConnector.JoinedOrthoLinesList[0]); if (RaisedLine.FIsVertical and (TempLineList.IndexOf(RaisedLine) = -1)) then TempLineList.Add(RaisedLine); end; // удалить пустой коннектор if (((RaisedLineConnector.JoinedConnectorsList.Count = 0) and (RaisedLineConnector.JoinedOrtholinesList.Count = 0)) or ((RaisedLineConnector.JoinedConnectorsList.Count = 1) and (RaisedLineConnector.JoinedOrtholinesList.Count = 0))) then RaisedLineConnector.Delete; end; end; end; end; end; Procedure CheckDisJoinConnectorFromVLines(aConnector: TConnectorObject); var i : integer; HasVLines: Boolean; VLine: TOrthoLine; NewConn: TCOnnectorObject; CanContinue: Boolean; isMovingObject: Boolean; vLine1, vLine2: TOrthoLine; CanDisJoin: Boolean; // можно ли сбросить вертикальные трассы с точечного при сдвиге function CanDisJoinVLines(aConn: TConnectorObject): Boolean; var i, j: Integer; VLinesCount: integer; JoinedVLine: TOrthoLine; begin Result := False; VLinesCount := 0; for i := 0 to aConn.JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsVertical then begin inc(VLinesCount); JoinedVLine := TOrthoLine(aConn.JoinedOrthoLinesList[i]); end; end; aObjectVLinesCount := VLinesCount; // между двумя вертикалями отрываем однозначно (если это не тот коннектор, который двигаем) if VLinesCount = 2 then begin CanDisJoin := True; if isMovingObject then begin // определяем вертикали VLine1 := Nil; VLine2 := Nil; for i := 0 to aConn.JoinedOrtholinesList.count - 1 do begin if TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsVertical then begin if vLine1 = Nil then VLine1 := TOrthoLine(aConn.JoinedOrtholinesList[i]) else begin if VLine1.Id <> TOrthoLine(aConn.JoinedOrtholinesList[i]).Id then begin VLine2 := TOrthoLine(aConn.JoinedOrtholinesList[i]); break; end; end; end; end; // Попадание на вертикаль 1 if (((CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], aHeight) = 1)) or ((CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], aHeight) = 1))) then CanDisJoin := False; // Попадание на вертикаль 2 if CanDisJoin then begin if (((CompareValue(TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1], aHeight) = 1)) or ((CompareValue(TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1], aHeight) = 1))) then CanDisJoin := False; end; if CanDisJoin then Result := True else aObjectVLinesCount := 2; // сыграет при снапе на вертикаль (не будем делать, а просто двинем коннектор на высоту) exit; end else begin Result := True; exit; end; end; if VLinesCount = 1 then begin // если перескакиваем вертикаль - тоже отрываем if WayList.Count > 1 then begin Result := True; exit; end; // в обратную сторону от вертикали и поднимаем не все трассы if (WayList.Count = 0) and (not CanRaiseAllTracesAtOnce) then begin Result := True; exit; end; end; end; begin HasVLines := False; isMovingObject := False; if aConnector.Id = aObject.Id then isMovingObject := True; if aConnector.ConnectorType = ct_Clear then begin if aConnector <> nil then begin for i := 0 to aConnector.JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(aConnector.JoinedOrtholinesList[i]).FIsVertical then begin HasVLines := True; breaK; end; end; end; if HasVLines then begin if ((not isMovingObject) or (isMovingObject and CanDisJoinVLines(aObject))) then begin // оставить пустой коннектор на вертикалях, чтобы не потащить их за собой при снапе на вертикаль // или на точечный NewConn := TConnectorObject.Create(aConnector.ActualPoints[1].x, aConnector.ActualPoints[1].y, aConnector.ActualZOrder[1], aConnector.LayerHandle, mydsNormal, GCadForm.PCad); NewConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(aConnector.LayerHandle), NewConn, False); NewConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(NewConn.ID, NewConn.Name); ObjParams := GetFigureParams(NewConn.ID); NewConn.Name := ObjParams.Name; NewConn.FIndex := ObjParams.MarkID; // переконнектить трассы в точке рассоединения от вертикали на новый коннектор CanContinue := True; While CanContinue do begin CanContinue := False; for i := 0 to aConnector.JoinedOrthoLinesList.count - 1 do begin vLine := TOrthoLine(aConnector.JoinedOrtholinesList[i]); if ((VLine.FIsVertical) or (aTraceList.IndexOf(VLine) = -1)) then begin CanContinue := True; aConnector.JoinedOrtholinesList.Remove(VLine); if TConnectorObject(VLine.JoinConnector1).ID = aConnector.ID then begin VLine.SetJConnector1(NewConn); end else if TConnectorObject(VLine.JoinConnector2).ID = aConnector.ID then begin vLine.SetJConnector2(NewConn); end; break; end; end; end; end; end; end else if (aConnector.ConnectorType = ct_Nb) and (NeedToCreateVLine or CanSnapToVertical or (ConnectorToSnap <> nil)) then begin CanDisJoin := True; while CanDisJoin do begin CanDisJoin := False; for i := aConnector.JoinedConnectorsList.Count - 1 downto 0 do begin if ((TConnectorObject(aConnector.JoinedConnectorsList[i]).JoinedOrtholinesList.Count = 1) and TOrthoLine(TConnectorObject(aConnector.JoinedConnectorsList[i]).JoinedOrtholinesList[0]).FIsVertical) then begin CanDisJoin := True; TConnectorObject(aConnector.JoinedConnectorsList[i]).JoinedConnectorsList.Remove(aConnector); aConnector.JoinedConnectorsList.Delete(i); end; Break; //// BREAK ////; end; end; end; end; // удалить кабель на пути прохождения коннектора (если идем в обратную сторону от уже проложенных) Procedure DeleteCableFromWay(aConnector: TConnectorObject); Var i, j, k, l: Integer; ComponsToDelList: TList; LineCatalog, JoinedLineCatalog: TSCSCatalog; SCSCompon, JoinedCompon: TSCSComponent; currTrace, JoinedTrace: TOrthoLine; // трасса в ПМ (трасса коннектора и присоединенная, если по ней пошел кабель) CableListToDel: TSCSComponents; // путь следования до точки спуска/подъема Begin if WayList.Count > 0 then begin CableListToDel := TSCSComponents.Create(False); for i := 0 to aConnector.JoinedOrtholinesList.Count - 1 do begin currTrace := TOrthoLine(aConnector.JoinedOrtholinesList[i]); if ATraceList.IndexOf(currTrace) <> -1 then // только для тех трасс, которые будем двигать begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(currTrace.ID); if LineCatalog <> nil then begin for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]); if IsCableComponent(SCSCompon) then begin for k := 0 to WayList.Count - 1 do begin JoinedTrace := TOrthoLine(WayList[k]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedTrace.ID); if JoinedLineCatalog <> nil then begin // предполагаем кабельное соединение 1:1 for l := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin JoinedCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[l]); if IsCableComponent(JoinedCompon) and (JoinedCompon.Whole_ID = SCSCompon.Whole_ID) then begin CableListToDel.Add(JoinedCompon); break; end; end; end; end; end; end; end; end; end; if CableListToDel.Count > 0 then begin for i := 0 to CableListToDel.Count - 1 do begin SCSCompon := TSCSComponent(CableListToDel[i]); SCSCompon.DisJoinFromAll(true,true).Free; end; F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, CableListToDel, false); end; FreeAndNil(CableListToDel); end; End; // сбросить подключение кабелей на горизонтальных трассах, если в точках пересечения не все они будут сдвинуты Procedure CheckDisJoinCablesOnConnector; var i, j, k, l: integer; CurrTrace, JoinedTrace : TOrthoLine; LineCatalog, JoinedLineCatalog: TSCSCatalog; CableCompon, JoinedCableCompon: TSCSComponent; DisJoinLineList: TList; begin DisJoinLineList := TList.Create; for i := 0 to aObject.JoinedOrthoLinesList.Count - 1 do begin currTrace := TOrthoLine(aObject.JoinedOrtholinesList[i]); if ((ATraceList.IndexOf(currTrace) = -1) and (not CurrTrace.FIsVertical) and (not CurrTrace.FIsRaiseUpDown)) then DisJoinLineList.Add(currTrace); end; if DisJoinLineList.Count > 0 then begin for i := 0 to aObject.JoinedOrthoLinesList.Count - 1 do begin currTrace := TOrthoLine(aObject.JoinedOrthoLinesList[i]); if aTraceList.IndexOf(currTrace) <> -1 then begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(currTrace.ID); if LineCatalog <> nil then begin for j := 0 to DisJoinLineList.Count - 1 do begin JoinedTrace := TOrthoLine(DisJoinLineList[j]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedTrace.ID); if JoinedLineCatalog <> nil then begin for k := 0 to LineCatalog.ComponentReferences.count - 1 do begin CableCompon := TSCSComponent(LineCatalog.ComponentReferences[k]); if IsCableComponent(CableCompon) then begin for l := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin JoinedCableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[l]); if (IsCableComponent(JoinedCableCompon) and (CableCompon.JoinedComponents.IndexOf(JoinedCableCompon) <> -1)) then begin while CableCompon.JoinedComponents.IndexOf(JoinedCableCompon) <> -1 do CableCompon.DisJoinFrom(JoinedCableCompon); break; end; end; end; end; end; end; end; end; end; end; FreeAndNil(DisJoinLineList); end; Function CheckCanSnapToVertical: Boolean; var i, j: Integer; vLine : TOrthoLine; begin Result := False; if WayList.Count > 0 then begin for i := 0 to WayList.Count - 1 do begin VLine := TOrthoLine(WayList[i]); if VLine.FIsVertical then begin if (((CompareValue(TConnectorObject(VLine.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine.JoinConnector2).ActualZOrder[1], aHeight) = 1)) or ((CompareValue(TConnectorObject(VLine.JoinConnector2).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine.JoinConnector1).ActualZOrder[1], aHeight) = 1))) then begin Result := True; Exit; end; end; end; end else begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin VLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); if VLine.FIsVertical then begin if (((CompareValue(TConnectorObject(VLine.JoinConnector1).ActualZOrder[1], aHeight) = -1) and (CompareValue(TConnectorObject(VLine.JoinConnector2).ActualZOrder[1], aHeight) = 1)) or ((CompareValue(TConnectorObject(VLine.JoinConnector1).ActualZOrder[1], aHeight) = 1) and (CompareValue(TConnectorObject(VLine.JoinConnector2).ActualZOrder[1], aHeight) = -1))) then begin Result := True; if WayList.IndexOf(VLine) = -1 then WayList.Add(VLine); exit; end; end; end; end; end; end; // Tolik -- 21/07/2016 -- // украдено в U_Common, в таком виде, как там -- ни х не годится, поэтому // немножко переделано совсем // СОЗДАТЬ С-П НА ОБЪЕКТЕ procedure CreateRaiseOnPointObjectToConn(APointObject: TConnectorObject; AHeight: Double; aBaseConnector: TConnectorObject = nil); var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; JoinedConnBase: TConnectorObject; ObjParams: TObjectParams; TempRaisedConnectors: TList; CurIndex: Integer; //Tolik SetRaiseHeight: Double; RaiseHeight: Double; ObjFromRaise: TConnectorObject; begin BaseBeginUpdate; try x := APointObject.ActualPoints[1].x; y := APointObject.ActualPoints[1].y; z := APointObject.ActualZOrder[1]; // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, AHeight, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; // APointObject.ActualZOrder[1] := AHeight; { for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1]; SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]); } // создать подъем-спуск коннектор // RaiseConn := TConnectorObject.Create(x + 10, y - 10, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn := aBaseConnector; // RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, AHeight, x + 10, y - 10, z, 1,ord(psSolid), clBlack, 0, APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); // Tolik RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1] := APointObject.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1] := APointObject.ActualZOrder[1]; // RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; {if TConnectorObject(APointObject).Radius > 10000000 then begin if ((APointObject.Radius - 11000000) <> 999) and ( (APointObject.Radius - 11000000) <> 0) then RaiseLine.ActualZOrder[2] := APointObject.Radius - 11000000 else RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; end else} // SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // приконнектить подъем //SnapConnectorToPointObject(ConnectedConn, APointObject, true); APointObject.JoinedConnectorsList.Add(ConnectedConn); ConnectedConn.JoinedConnectorsList.Insert(0, APointObject); //Tolik -- 25/10/2017 -- // удалить присоединенный коннектор из ПМ DeleteObjectFromPM(ConnectedConn.ID, ConnectedConn.Name); // // Tolik // RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; { if TConnectorObject(APointObject).Radius > 10000000 then if (APointObject.Radius - 11000000) <> 999 then RaiseLine.ActualZOrder[2] := APointO;bject.Radius - 11000000 else RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];} //else // RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];} // //RaiseConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== // GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes24; // ??? RaiseConn.FConnRaiseType := crt_OnFloor; RaiseConn.FObjectFromRaise := APointObject; CheckAddObjInPM(RaiseConn); // если нет в ПМ - добавить коннектор в ПМ SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes25; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := APointObject; RaiseLine.FLineRaiseType := GetRaiseType(APointObject, RaiseConn); RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; // переподсоединить трассы к подъему // TempRaisedConnectors := TList.Create; // небыло прямой привязки коннектора к ТО // Tolik --13/04/2016 -- // тут немножко переделаем совсем, чтобы все трассы коннектора, брошенного на точечный объект // могли приконнектиться к вершине С/П на нужной высоте { if aBaseConnector = nil then begin for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); if JoinedConn <> ConnectedConn then TempRaisedConnectors.Add(JoinedConn); end; end else // непосредственно привязка коннектора к ТО begin TempRaisedConnectors.Add(aBaseConnector); end; } //if aBaseConnector = nil then //begin { for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); if JoinedConn <> ConnectedConn then TempRaisedConnectors.Add(JoinedConn); end;} //end //else {if aBaseConnector <> nil then // непосредственно привязка коннектора к ТО begin TempRaisedConnectors.Add(aBaseConnector); end; } // { // отвязка for i := 0 to TempRaisedConnectors.Count - 1 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); UnsnapConnectorFromPointObject(JoinedConn, APointObject, true); end; // перепривязка к вершине CurIndex := TempRaisedConnectors.Count - 1; // вязать без сортировок if aBaseConnector = nil then begin for i := CurIndex downto 0 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); SnapConnectorToConnector(JoinedConn, RaiseConn, true); RaiseConn := JoinedConn; end; end else // с учтом того что должен остаться текущий коннектор, который сейчас Move begin for i := 0 to TempRaisedConnectors.Count - 1 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); if JoinedConn <> aBaseConnector then begin SnapConnectorToConnector(JoinedConn, RaiseConn, true); RaiseConn := JoinedConn; end; end; SnapConnectorToConnector(aBaseConnector, RaiseConn, true); RaiseConn := aBaseConnector; end; if TempRaisedConnectors <> nil then FreeAndNil(TempRaisedConnectors); // Tolik if (TConnectorObject(APointObject).Radius > 10000000) and ((APointObject.Radius - 11000000) <> 999) and ((APointObject.Radius - 11000000) <> 0) then begin RaiseHeight := (APointObject.Radius - 11000000); RaiseHeight := UOMToMetre(RaiseHeight); if RaiseConn.FConnRaiseType = crt_OnFloor then begin SetRaiseHeight := ObjFromRaise.ActualZOrder[1] + RaiseHeight; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = ObjFromRaise.ActualZOrder[1] then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin RaiseConn.ActualZOrder[1] := SetRaiseHeight; SetConFigureCoordZInPM(RaiseConn.ID, RaiseConn.ActualZOrder[1]); end; end else // BetweenFloor begin SetRaiseHeight := RaiseConn.ActualZOrder[1] - RaiseHeight; if SetRaiseHeight < 0 then SetRaiseHeight := 0; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = RaiseConn.ActualZOrder[1] then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin ObjFromRaise.ActualZOrder[1] := SetRaiseHeight; SetConFigureCoordZInPM(ObjFromRaise.ID, ObjFromRaise.ActualZOrder[1]); end; end; end; } RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); // *** for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if JoinedLine <> RaiseLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; SetConnBringToFront(APointObject); SetConnBringToFront(RaiseConn); RefreshCAD(GCadForm.PCad); //SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); {**************************************************************************} { RaiseConn := GetRaiseConn(APointObject); if RaiseConn <> nil then AutoConnectOverRaiseInCAD(APointObject, RaiseConn);} {**************************************************************************} except on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnPointObject', E.Message); end; BaseEndUpdate; end; begin try //WayList := TList.Create; if ATraceList <> nil then begin // если высота подъема совпадает с высотой коннектора - выход нах if CompareValue(aObject.ActualZOrder[1], aHeight) = 0 then exit; // TempLineList := TList.Create; CanSnapToVertical := False; DirectionUP := False; DirectionDown := False; HighVConn := nil; LowVConn := Nil; ConnectorToSnap := nil; CreatedConn := Nil; CanDelEmptyLines := True; CanRaiseAllTracesAtOnce := False; // можно ли двинуть все трассы - т.е. сразу передвинуть коннектор aObjectVLinesCount := 0; RaiseLine := nil; HasVLines := False; // направление сдвига от базового положения коннектора (вверх/вниз) if CompareValue(aObject.ActualZOrder[1], aHeight) = -1 then DirectionUP := true else if CompareValue(aObject.ActualZOrder[1], aHeight) = 1 then DirectionDown := True; // приконнекченный НБ, если есть NB_Connector := nil; if aObject.ConnectorType = ct_NB then NB_Connector := aObject; // райз на поинте и вертикали, если есть (потом понадобится) for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); Break; //// BREAK ////; end; if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin HasVLines := True; Break; //// BREAK ////; end; end; if ((RaiseLine <> nil) or HasVLines) then // 06/10/2021 -- break; end; // -- ищем подходящую вертикаль --- CanLook := True; // стартовый коннектор LastObject := AObject; { While CanLook do begin CanLook := False; LookUPDOWN; end;} ///**************************************************************************************** // удалить кабели на пути прохождения по вертикали DeleteCableFromWay(aObject); // отсоединить кабели от трасс, которые не двигаются // CheckDisJoinCablesOnConnector; CanRaiseAllTracesAtOnce := CanRaiseAllTraces(aObject); // нужно ли преобразовывать райз в вертикаль if RaiseLine <> nil then RaiseLineToVertical := CheckConvertRaiseToVLine; //здесь райз преобразуется в вертикаль // попадем ли на вертикаль CanSnapToVertical := CheckCanSnapToVertical; NeedToCreateVLine := False; if (ConnectorToSnap = nil) and not CanSnapToVertical then // только в этом случае !!! NeedToCreateVLine := CheckNeedToCreateVLine; // сбросить с коннектора те ортолинии, которые не поднимаются if Not CanRaiseAllTracesAtOnce then CreatedConn := ReconnectOnPointbyConn(aObject); // выровнять по точечному объекту if CreateDConn <> nil then CreateDConn.Move(aObject.ActualPoints[1].x - CreateDConn.ActualPoints[1].x, aObject.ActualPoints[1].y - CreateDConn.ActualPoints[1].y); // if ((ConnectorToSnap <> nil) and (RaiseLine <> nil)) then begin { if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then ChangeRaiseOnNextObject(TConnectorObject(RaiseLine.JoinConnector1), RaiseLine, aHeight, nil) else if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then ChangeRaiseOnNextObject(TConnectorObject(RaiseLine.JoinConnector2), RaiseLine, aHeight, nil); TempConn := nil; if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then TempConn := TConnectorObject(RaiseLine.JoinConnector1) else if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then TempConn := TConnectorObject(RaiseLine.JoinConnector2); if TempConn <> nil then begin // TempConn.JoinedConnectorsList.Remove(aObject); // aObject.JoinedConnectorsList.Remove(TempConn); end;} end; //else // AObject.ActualZOrder[1] := aHeight; //if aObject.ConnectorType = ct_Clear then begin j:=0; TempConn := nil; // проверка на необходимость создания вертикали, если нет коннектора для снапа // и не попадаем на вертикаль CanRaiseLine := False; // если объект на коннекторе, то следовало бы оторвать перед тем как двинуть коннектор //NB_Connector := nil; { for i := 0 to AObject.JoinedConnectorsList.Count - 1 do begin if TConnectorObject(AObject.JoinedConnectorsList[i]).ConnectorType = ct_NB then begin NB_Connector := TConnectorObject(AObject.JoinedConnectorsList[i]); break; end; end;} // если есть НБ -- отрываем коннектор if NB_Connector <> nil then begin // оторвать коннектор // UnsnapConnectorFromPointObject(AObject, NB_Connector); // присоединить все сдвигаемые трассы к коннектору (чтобы двинуть все сразу и не морочиться потом со снапами) if not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin CanDelConnectorsFromPointObject := True; while CanDelConnectorsFromPointObject do begin CanDelConnectorsFromPointObject := False; for i := 0 to NB_Connector.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(NB_Connector.JoinedConnectorsList[i]); if JoinedConn.ID <> aObject.ID then // на всякий, по идее, на анснапе объект должен отвалиться begin for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]); if (ATraceList.IndexOf(JoinedLine) <> - 1) and (not JoinedLine.FisRaiseUPDown) and (not JoinedLine.FisVertical) then begin CanDelConnectorsFromPointObject := True; JoinedConn.JoinedOrtholinesList.Remove(JoinedLine); if TConnectorObject(JoinedLine.JoinConnector1).ID = JoinedConn.ID then JoinedLine.SetJConnector1(aObject) else if TConnectorObject(JoinedLine.JoinConnector2).ID = JoinedConn.ID then JoinedLine.SetJConnector2(aObject); if aObject.JoinedOrtholinesList.IndexOf(JoinedLine) = -1 then aObject.JoinedOrtholinesList.Add(JoinedLine); break; end; end; // пустой коннектор с точечного - нах if (((CreateDConn = nil) and (JoinedConn.JoinedOrtholinesList.Count = 0)) or ((CreateDConn <> nil) and (JoinedConn.ID <> CreatedConn.ID) and (JoinedConn.JoinedOrtholinesList.Count = 0))) then begin NB_Connector.JoinedConnectorsList.Remove(JoinedConn); JoinedConn.JoinedConnectorsList.Remove(NB_Connector); JoinedConn.Delete; break; end; end; end; end; end; end; begin CheckDisJoinConnectorFromVLines(aObject); // Коннектор на высоту AObject.ActualZOrder[1] := aHeight; // Ортолинии поднять for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); JoinedConn.ActualZOrder[1] := aObject.ActualZOrder[1]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if TConnectorObject(JoinedLine.JoinConnector1).ID = JoinedConn.ID then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := aObject.ActualZOrder[1]; end; if TConnectorObject(JoinedLine.JoinConnector2).ID = JoinedConn.ID then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := aObject.ActualZOrder[1]; end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, true); JoinedLine.ReCreateNotesGroup(True); end; end; // если попали на коннектор вертикали if ConnectorToSnap <> nil then begin if ((ConnectorToSnap.ConnectorType = ct_Clear) and (ConnectorToSnap.JoinedConnectorsList.Count > 0)) then ConnectorTOSnap := TConnectorObject(ConnectorToSnap.JoinedConnectorsList[0]); if ConnectorToSnap.ConnectorType = ct_NB then // вязать коннекторы без снапа (на всякий, чтобы потом не отсоединять кабеля для выполнения проходящих соединений) begin // SnapConnectorToPointObject(aObject, ConnectorToSnap) if aObject.JoinedConnectorsList.IndexOf(ConnectorToSnap) = -1 then aObject.JoinedConnectorsList.Add(ConnectorToSnap); if ConnectorToSnap.JoinedConnectorsList.IndexOf(aObject) = -1 then ConnectorToSnap.JoinedConnectorsList.Add(aObject); DeleteObjectFromPm(ConnectorToSnap.ID, ConnectorToSnap.Name); end else if ConnectorToSnap.ConnectorType = ct_clear then begin if ConnectorToSnap.FConnRaiseType = crt_None then DeleteObjectFromPm(ConnectorToSnap.ID, ConnectorToSnap.Name); // слить коннектора всех поднимаемых трасс в один if ConnectorToSnap.JoinedConnectorsList.IndexOf(aObject) = -1 then ConnectorToSnap.JoinedConnectorsList.Insert(0,aObject); if aObject.JoinedConnectorsList.IndexOf(ConnectorToSnap) = -1 then aObject.JoinedConnectorsList.Add(ConnectorToSnap); // если есть приконнекченные линии -- сбросить пустой коннектор из ПМ {if ConnectorToSnap.JoinedOrtholinesList.Count > 0 then DeleteObjectFromPm(ConnectorToSnap.ID, ConnectorToSnap.Name);} // если к пустому коннектору присобачено белее одной линии - нужно пересоздать // пустые коннекторы для всех ортолиний и переконнектить ортолинии к точечному // (и не забыть про райзы -- важно!!!) if ConnectorToSnap.JoinedOrtholinesList.Count > 1 then begin // если есть райз - не сбить коннектор райза if RaiseLine <> nil then begin if ConnectorToSnap.JoinedOrtholinesList.IndexOf(RaiseLine) <> -1 then begin ConnectorToSnap.JoinedOrtholinesList.Remove(RaiseLine); ConnectorToSnap.JoinedOrtholinesList.Insert(0, RaiseLine); if RaiseLine.JoinConnector1.Id = ConnectorToSnap.ID then begin if TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise = ConnectorToSnap then TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise := aObject; end else if RaiseLine.JoinConnector2.Id = ConnectorToSnap.ID then begin if TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise = ConnectorToSnap then TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise := aObject; end; if ConnectorToSnap.FObjectFromRaise <> nil then begin if RaiseLine.JoinConnector1.Id = ConnectorToSnap.ID then ConnectorToSnap.FObjectFromRaise := TConnectorObject(RaiseLine.JoinConnector2) else if RaiseLine.JoinConnector2.Id = ConnectorToSnap.ID then ConnectorToSnap.FObjectFromRaise := TConnectorObject(RaiseLine.JoinConnector1); end; aObject.FObjectFromRaise := ConnectorToSnap.FObjectFromRaise; ConnectorToSnap.FObjectFromRaise := Nil; aObject.FConnRaisetype := ConnectorToSnap.FConnRaiseType; ConnectorToSnap.FConnRaiseType := crt_None; if RaiseLine.FObjectFromRaisedLine = ConnectorToSnap then RaiseLine.FObjectFromRaisedLine := aObject; if ConnectorToSnap.FConnRaiseType <> crt_None then begin if RaiseLine.JoinConnector1.Id = ConnectorToSnap.ID then begin // DeleteObjectFromPm(RaiseLine.JoinConnector2.ID, RaiseLine.JoinConnector2.Name); if aObject.FConnRaiseType = crt_None then RaiseLine.FLineRaiseType := GetRaiseType(TConnectorObject(RaiseLine.JoinConnector2), aObject) else RaiseLine.FLineRaiseType := GetRaiseType(aObject, TConnectorObject(RaiseLine.JoinConnector2)); end else if RaiseLine.JoinConnector2.Id = ConnectorToSnap.ID then begin //DeleteObjectFromPm(RaiseLine.JoinConnector1.ID, RaiseLine.JoinConnector1.Name); if aObject.FConnRaiseType = crt_None then RaiseLine.FLineRaiseType := GetRaiseType(TConnectorObject(RaiseLine.JoinConnector1), aObject) else RaiseLine.FLineRaiseType := GetRaiseType(aObject, TConnectorObject(RaiseLine.JoinConnector1)); end; end; end; // ReverseRaise(aObject); end; //for i := (ConnectorToSnap.JoinedOrtholinesList.Count - 1) downto 1 do for i := (ConnectorToSnap.JoinedOrtholinesList.Count - 1) downto 1 do begin JoinedLine := TOrthoLine(ConnectorToSnap.JoinedOrtholinesList[i]); if ((RaiseLine = nil) or ((RaiseLine <> nil) and (JoinedLine.ID <> RaiseLine.Id))) then begin // создаем новый CreateDConn := TConnectorObject.Create(ConnectorToSnap.ActualPoints[1].x, ConnectorToSnap.ActualPoints[1].y, ConnectorToSnap.ActualZOrder[1], ConnectorToSnap.LayerHandle, mydsNormal, GCadForm.PCad); CreateDConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(ConnectorToSnap.LayerHandle), CreateDConn, False); CreateDConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(CreateDConn.ID, CreateDConn.Name); ObjParams := GetFigureParams(CreateDConn.ID); CreateDConn.Name := ObjParams.Name; CreateDConn.FIndex := ObjParams.MarkID; // сбрасываем ортолинию с коннектора ConnectorToSnap.JoinedOrtholinesList.Remove(JoinedLine); // переопределяем конец ортолинии CreatedConn.JoinedOrthoLinesList.Add(JoinedLine); if TConnectorObject(JoinedLine.JoinConnector1).ID = ConnectorToSnap.ID then JoinedLine.JoinConnector1 := CreateDConn else if TConnectorObject(JoinedLine.JoinConnector2).id = ConnectorToSnap.ID then JoinedLine.JoinConnector2 := CreateDConn; // если райз - переопределить параметры (* if JoinedLine.FIsRaiseUpDown then begin if JoinedLine.FIsRaiseUpDown then begin if JoinedLine.FObjectFromRaisedLine = ConnectorToSnap then JoinedLine.FObjectFromRaisedLine := aObject; CreateDConn.FConnRaiseType := ConnectorToSnap.FConnRaiseType; ConnectorToSnap.FConnRaiseType := crt_None; CreateDConn.FObjectFromRaise := ConnectorToSnap.FObjectFromRaise; ConnectorToSnap.FObjectFromRaise := Nil; CreatedConn.Name := ConnectorToSnap.Name; SetNewObjectNameInPM(CreatedConn.ID, CreatedConn.Name); ConnectorToSnap.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectorToSnap.ID, ConnectorToSnap.Name); if ((TConnectorObject(JoinedLine.JoinConnector1).FObjectFromRaise <> nil) and (TConnectorObject(JoinedLine.JoinConnector1).FObjectFromRaise.Id = ConnectorToSnap.Id)) then TConnectorObject(JoinedLine.JoinConnector1).FObjectFromRaise := aObject else if ((TConnectorObject(JoinedLine.JoinConnector2).FObjectFromRaise <> nil) and (TConnectorObject(JoinedLine.JoinConnector2).FObjectFromRaise.Id = ConnectorToSnap.Id)) then TConnectorObject(JoinedLine.JoinConnector2).FObjectFromRaise := aObject; (*{ ConnectedConn.FObjectFromRaise := AObject.FObjectFromRaise; if ReconnLine.FObjectFromRaisedLine = aObject then ReconnLine.FObjectFromRaisedLine := ConnectedConn; ConnectedConn.FConnRaiseType := aObject.FConnRaiseType; ConnectedConn.Name := AObject.Name; // переименовать в ПМ SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); //RaiseConn.JoinedOrthoLinesList.Remove(ReconnLine); if (TConnectorObject(ReconnLine.JoinConnector1).FObjectFromRaise <> nil) and (TConnectorObject(ReconnLine.JoinConnector1).FObjectFromRaise.Id = AConn.ID) then TConnectorObject(ReconnLine.JoinConnector1).FObjectFromRaise := ConnectedConn else if (TConnectorObject(ReconnLine.JoinConnector2).FObjectFromRaise <> nil) and (TConnectorObject(ReconnLine.JoinConnector2).FObjectFromRaise.Id = AConn.ID) then TConnectorObject(ReconnLine.JoinConnector2).FObjectFromRaise := ConnectedConn; {if RaiseConn.JoinedOrthoLinesList.Count = 0 then RaiseConn.Delete;} // если переконнектили на райзе = сбросить признаки райза на том конекторе, который будем двигать AObject.FObjectFromRaise := Nil; AObject.FConnRaiseType := Crt_None; // просто коннектор aObject.Name := cCadClasses_Mes12; // переименовать в ПМ SetNewObjectNameInPM(AObject.ID, AObject.Name);*) (* if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], aObject.ActualZOrder[1]) = 0 then begin TConnectorObject(JoinedLine.JoinConnector1).FObjectFromRaise := nil; TConnectorObject(JoinedLine.JoinConnector2).FObjectFromRaise := aObject; end else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], aObject.ActualZOrder[1]) = 0 then begin TConnectorObject(JoinedLine.JoinConnector2).FObjectFromRaise := nil; TConnectorObject(JoinedLine.JoinConnector1).FObjectFromRaise := aObject; end; end; end; *) // Приконнектить к объекту aObject.JoinedConnectorsList.Add(CreatedConn); CreateDConn.JoinedConnectorsList.Add(aObject); // удалить коннектор из ПМ DeleteObjectFromPm(CreateDConn.ID, CreateDConn.Name); end; end; if not TOrthoLine(ConnectorToSnap.JoinedOrtholinesList[0]).FIsRaiseUpDown then begin ConnectorToSnap.FConnRaiseType := crt_None; ConnectorToSnap.FObjectFromRaise := nil; end; end; end; end else // Если попали на вертикаль if CanSnapToVertical then begin // слить коннектора всех поднимаемых трасс в один // CollectConnectors; {if CanRaiseAllTracesAtOnce then CheckDisJoinConnectorFromVLines(aObject);} if WayList.Count > 0 then begin VertLine := TOrthoLine(WayList[WayList.Count - 1]); // если прыгать с НБ или не все трассы двигать if (((aObject.JoinedOrtholinesList.IndexOf(vertLine) = -1) or (not CanRaiseAllTracesAtOnce)) and (aObjectVLinesCount <> 2)) then begin if aObject.ConnectorType = ct_Clear then SnapConnectorToVertical(aObject, VertLine) else if aObject.ConnectorType = ct_NB then begin CreateDConn := TConnectorObject.Create(aObject.ActualPoints[1].x, aObject.ActualPoints[1].y, aObject.ActualZOrder[1], aObject.LayerHandle, mydsNormal, GCadForm.PCad); CreateDConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(aObject.LayerHandle), CreateDConn, False); CreateDConn.Name := cCadClasses_Mes12; // SetNewObjectNameInPM(CreateDConn.ID, CreateDConn.Name); ObjParams := GetFigureParams(CreateDConn.ID); CreateDConn.Name := ObjParams.Name; CreateDConn.FIndex := ObjParams.MarkID; CreateDConn.JoinedConnectorsList.Add(aObject); aObject.JoinedConnectorsList.Add(CreateDConn); SnapConnectorToVertical(CreatedConn, VertLine, True, False); end; end; end; end else // Нужно создать вертикаль if NeedToCreateVLine then begin // если есть райз, или вертикали - создать вертикаль if (((RaiseLine <> nil) and (RaiseLineToVertical <> nil)) or HasVLines) then CreateVertLineOnHeight else // если нет ни райза ни вертикалей - создать райз begin if CreateDConn <> nil then begin // выровнять коннекторы ортолиний по точечному, // иначе получится райз наискось for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin TConnectorObject(aObject.JoinedConnectorsList[i]).Move(aObject.ActualPoints[1].x - TConnectorObject(aObject.JoinedConnectorsList[i]).ActualPoints[1].x, aObject.ActualPoints[1].y - TConnectorObject(aObject.JoinedConnectorsList[i]).ActualPoints[1].y); end; CreateRaiseOnPointObjectToConn(aObject, aHeight, CreateDConn); end; end; end; end; if not ((aObject.deleted) and (aObject.JoinedConnectorsList.Count = 0)) then SetConFigureCoordZInPM(aObject.ID, aHeight); end; // // удалить ненужные трассы (вертикали, подключенные с одного конца) { for i := 0 to WayList.count - 1 do begin if TempLineList.IndexOf(TOrthoLine(WayList[i])) = -1 then TempLineList.Add(TOrthoLine(WayList[i])); end; WayList.Clear; FreeAndNil(WayList); CanLook := True; While CanLook do begin CanLook := False; for i := (TempLineList.Count - 1) downto 0 do begin if CheckDeleteVLine(TOrthoLine(TempLineList[i])) then begin CanLook := True; break; end; end; end;} TempLineList.Clear; FreeAndNil(TempLineList); // CheckDeleteAllRaises(GCadForm.PCad); // 05/11/2018 Tolik end else // сюда придем, если просто поднимем коннектор (на райзе) begin // установить новые значения for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := aObject.JoinedConnectorsList[i]; JoinedConn.ActualZOrder[1] := aObject.ActualZOrder[1]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := JoinedConn.JoinedOrtholinesList[j]; if JoinedLine.JoinConnector1 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := aObject.ActualZOrder[1]; end; if JoinedLine.JoinConnector2 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := aObject.ActualZOrder[1]; end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, true); JoinedLine.ReCreateNotesGroup(True); end; SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]); end; SetConFigureCoordZInPM(aObject.ID, aHeight); CheckDeleteAllRaises(GCadForm.PCad); // 05/11/2018 Tolik end; except on E: Exception do AddExceptionToLogEx('U_SCSObjectsProp.PutNBObjectOnHeight', E.Message); end; end; // 03/07/2016 -- // отсоединить ОБЪЕКТ(!!!) от подключенных трасс и переконнектить кабели в точке соединения // РЕКОННЕКТ В ТОЧКЕ БЕЗ ПРОИЗВЕДЕНИЯ СНАПОВ Function ReconnectOnPointObject(aObject: TConnectorObject): TConnectorObject; var i, j: Integer; CableList, JoinedTraceList, JoinedConnList: TList; JoinedConn, LineConn: TConnectorObject; JoinedLine: TOrthoLine; PointCatalog: TSCSCatalog; LineCatalog: TSCSCatalog; SCSComponent: TSCSComponent; RaiseLine: TOrthoLine; begin Result := nil; if aObject.ConnectorType = ct_NB then begin JoinedConnList := nil; JoinedTraceList := Nil; RaiseLine := RaiseFromConnector(aObject); if aObject.JoinedConnectorsList.Count > 0 then begin JoinedTraceList := TList.Create; // присоединенные трассы for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedTraceList.IndexOf(JoinedLine) = -1 then JoinedTraceList.Add(JoinedLine); end; end; // // каталог поинта (отключаем линейные компоненты от поинта) // PointCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aObject.ID); if PointCatalog <> nil then begin for i := 0 to PointCatalog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(PointCatalog.ComponentReferences[i]); for j := (SCSComponent.JoinedComponents.Count - 1) downto 0 do begin if (TSCSComponent(SCSComponent.JoinedComponents[j]).IsLine = biTrue) then SCSComponent.DisJoinFrom(TSCSComponent(SCSComponent.JoinedComponents[j])); end; end; end; if aObject.JoinedConnectorsList.Count > 1 then begin JoinedConn := nil; if RaiseLine = nil then JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[0]) else begin if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then JoinedConn := TConnectorObject(RaiseLine.JoinConnector1) else if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then JoinedConn := TConnectorObject(RaiseLine.JoinConnector2) end; if JoinedConn = nil then JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[0]); // рассоединить JoinedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(JoinedConn); // воткнуть пустой коннетор в ПМ SetNewObjectNameInPM(JoinedConn.ID, JoinedConn.Name); // отключить от объекта {for j := (JoinedConn.JoinedConnectorsList.Count - 1) downto 0 do begin if TConnectorObject(JoinedConn.JoinedConnectorsList[j]).ID = aObject.ID then JoinedConn.JoinedConnectorsList.Delete(j); end; for j := (aObject.JoinedConnectorsList.Count - 1) Downto 0 do begin if TConnectorObject(aObject.JoinedConnectorsList[j]).ID = JoinedConn.ID then aObject.JoinedConnectorsList.Delete(j); end;} JoinedConnList := TList.Create; // можно и сразу, но, на всякий проверим уникальность коннекторов for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin if JoinedConnList.IndexOf(TConnectorObject(aObject.JoinedConnectorsList[i])) = -1 then JoinedConnList.Add(TConnectorObject(aObject.JoinedConnectorsList[i])); end; // переснапить пустые коннекторы в точке рассоединения с точечным for i := (JoinedConnList.Count - 1) downto 0 do begin // здесь без снапа, чтобы исключить переподключение кабелей // SnapConnectorToConnector(JoinedConn, TConnectorObject(JoinedConnList[i])); LineConn := TConnectorObject(JoinedConnList[i]); if not LineConn.Deleted then begin // отключить от объекта for j := (LineConn.JoinedConnectorsList.Count - 1) downto 0 do begin if TConnectorObject(LineConn.JoinedConnectorsList[j]).ID = aObject.ID then LineConn.JoinedConnectorsList.Delete(j); end; for j := aObject.JoinedConnectorsList.Count - 1 Downto 0 do begin if TConnectorObject(aObject.JoinedConnectorsList[j]).ID = LineConn.ID then aObject.JoinedConnectorsList.Delete(j); end; // переключить ортолинию for j := LineConn.JoinedOrtholinesList.Count - 1 downto 0 do begin JoinedLine := TOrthoLine(LineConn.JoinedOrtholinesList[j]); if not JoinedLine.Deleted then begin if TConnectorObject(JoinedLine.JoinConnector1).ID = LineConn.ID then begin JoinedLine.JoinConnector1 := JoinedConn; JoinedLine.ActualPoints[1] := JoinedConn.ActualPoints[1]; LineConn.JoinedOrtholinesList.Remove(JoinedLine); if JoinedConn.JoinedOrtholinesList.IndexOf(JoinedLine) = -1 then JoinedConn.JoinedOrtholinesList.Add(JoinedLine); end else if TConnectorObject(JoinedLine.JoinConnector2).ID = LineConn.ID then begin JoinedLine.JoinConnector2 := JoinedConn; JoinedLine.ActualPoints[2] := JoinedConn.ActualPoints[1]; LineConn.JoinedOrtholinesList.Remove(JoinedLine); if JoinedConn.JoinedOrtholinesList.IndexOf(JoinedLine) = -1 then JoinedConn.JoinedOrtholinesList.Add(JoinedLine) end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; JoinedLine.UpdateLengthTextBox(true, true); SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.ReCreateCaptionsGroup(True, True); JoinedLine.ReCreateNotesGroup(True); JoinedLine.ReCreateDrawFigureBlock; end; end; // удалить ненужный коннектор LineConn.Delete(False, false); end; end; if not JoinedConn.Deleted then Result := JoinedConn; end else if aObject.JoinedConnectorsList.Count > 0 then begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[0]); if not JoinedConn.deleted then begin // тут тоже без снапа (на всякий) //UnsnapConnectorFromPointObject(JoinedConn, aObject); // отключить коннектор от объекта JoinedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(JoinedConn); // выставить пустой коннектор в ПМ SetNewObjectNameInPM(JoinedConn.ID, JoinedConn.Name); Result := JoinedConn; end; end; end; if JoinedConnList <> nil then FreeAndNil(JoinedConnList); if JoinedTraceList <> nil then FreeAndNil(JoinedTraceList); end; end; procedure TF_SCSObjectsProp.ChangeConnZ(aObject: TConnectorObject; aZ: Double); var i, j, k: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ObjFromRaise: TConnectorObject; ZCoord: Double; mess: string; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; PrevCount: integer; JConnList: TList; //Tolik HasVLine, HasRaiseLine: Boolean; // наличие вертикали или райза на объекте DirectionUP, DirectionDown: Boolean; // направление (вверх/вниз) // ObjectToSnap: TConnectorObject; // если в результате сдвига попадем на объект WayList: TList; // путь коннектора до точки назначения, если есть вертикали AllJoinedLineList, JoinedLinesList: TList; // присоединенные трассы NeedConvertRaiseToVertLine: Boolean; TraceList, EmptyList: TList; SavedConnectionsList: TList; SavedComponList: TList; InterFaceAccordanceList, SavedLineComponList, SavedPointComponList: TList; SelfPointConnectInfo, JoinedLineConnectInfo: TLineComponConnectionInfo; SavedPointConnectionsList, PointComponents: TList; RaiseSide: Integer; ConnectorForRaise: TConnectorObject; RaiseCatalog: TSCSCatalog; CableCompon: TSCSComponent; ComponToDeleteList : TSCSComponents; HasHorizontalTraces: boolean; SelfLineConnectInfo : TLineComponConnectionInfo; JoinedLineCatalog: TSCSCatalog; CableComponent: TSCSComponent; ConnectionSide: Integer; // сторона подключения кабелей к точечному SrcCatalog, TargetCatalog: TSCSCatalog; SrcNode, TargetNode: TTreeNode; SCSComponent: TSCSComponent; TempConn: TFigure; TempConnector: TConnectorObject; CableToDelList: TSCSComponents; FirstPointConn, NextPointConn: TConnectorObject; SavedCableComponList: TList; // список кабелей для восстановления соединений CanSortList: Boolean; // можно ли просто двинуть коннектор вместе с приконнекченными трассами, не // сохраняя и не восстанавливая соединений function CheckSimpleMove: Boolean; var i, j: Integer; HasConnectedLines, HasRaiseOrVLines, HasConnectedTraces: Boolean; RaiseLine: TOrthoLine; // райз на поинте VLine1, vLine2: TOrthoLine; // вертикали(если есть) RConn, NextRConn: TConnectorObject; VLineConn1, VLineConn2: TConnectorObject; function CheckNextVLine: Boolean; var VLineConn, VLineObject: TConnectorObject; i, j: Integer; begin Result := True; VLineConn := nil; if VLine1 <> nil then begin if DirectionUP then begin if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then VLineConn := TConnectorObject(VLine1.JoinConnector1) else if CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1]) = 1 then VLineConn := TConnectorObject(VLine1.JoinConnector2); if VLineConn <> nil then begin // можно искать вертикаль дальше, если поднимаемся выше коннектора if CompareValue(VLineConn.ActualZOrder[1], aZ) = -1 then begin if VLineConn.JoinedConnectorsList.Count = 0 then begin for i := 0 to VLineConn.JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(VLineConn.JoinedOrtholinesList[i]).FIsVertical and (TOrthoLine(VLineConn.JoinedOrtholinesList[i]).ID <> VLine1.Id)) then begin Result := False; Exit; end; end; end else if VLineConn.JoinedConnectorsList.Count > 0 then begin VLineObject := TConnectorObject(VLineConn.JoinedConnectorsList[0]); for i := 0 to VLineObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(VLineObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(VLineObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(VLineObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).Id <> VLine1.ID)) then begin Result := False; Exit; end; end; end; end; end; end; end else if DirectionDown then begin if CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then VLineConn := TConnectorObject(VLine1.JoinConnector1) else if CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1]) = -1 then VLineConn := TConnectorObject(VLine1.JoinConnector2); if VLineConn <> nil then begin { if CompareValue(VLineConn.ActualZOrder[1], aZ) = 0 then begin Result := False; Exit; // если попали на коннектор - выход нах (передвижение НЕпростое) end;} end; // можно искать вертикаль дальше, если опустимся ниже уровня коннектора if CompareValue(VLineConn.ActualZOrder[1], aZ) = 1 then begin if VLineConn.JoinedConnectorsList.Count = 0 then begin for i := 0 to VLineConn.JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(VLineConn.JoinedOrtholinesList[i]).FIsVertical and (TOrthoLine(VLineConn.JoinedOrtholinesList[i]).ID <> VLine1.Id)) then begin Result := False; Exit; end; end; end else if VLineConn.JoinedConnectorsList.Count > 0 then begin VLineObject := TConnectorObject(VLineConn.JoinedConnectorsList[0]); for i := 0 to VLineObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(VLineObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(VLineObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(VLineObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).Id <> VLine1.ID)) then begin Result := False; Exit; end; end; end; end; end; end; end; end; begin Result := False; VLine1 := nil; vLine2 := nil; RaiseLine := nil; RConn := nil; HasConnectedLines := False; HasRaiseOrVLines := False; HasConnectedTraces := False; if TConnectorObject(aObject).ConnectorType = ct_NB then begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin if TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count > 0 then begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin HasConnectedLines := True; // вертикаль if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin if VLine1 = nil then VLine1 := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]) else vLine2 := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); HasRaiseOrVLines := True; end else if TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); HasRaiseOrVLines := True; RConn := TConnectorObject(aObject.JoinedConnectorsList[i]); Break; //// BREAK ////; райз может быть только один, вертикалей не будет end else HasConnectedTraces := True; end; end; end; end; // нет присоединенных ортолиний вообще if not HasConnectedLines then Result := True else begin //если подключенные ортолинии есть, но нет вертикалей и райзов + разрешено размещение трасс на высоте РМ if (not HasRaiseOrVLines) and (F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) then Result := True; end; if not Result then begin // если есть райз if RaiseLine <> nil then begin // второй коннектор райза(противоположный) if TConnectorObject(RaiseLine.JoinConnector1).id = RConn.Id then NextRConn := TConnectorObject(RaiseLine.JoinConnector2) else if TConnectorObject(RaiseLine.JoinConnector2).id = RConn.Id then NextRConn := TConnectorObject(RaiseLine.JoinConnector1); // если нет приконнекченных трасс - настройки и направление побоку, лишь бы не попасть на // противоположную вершину if not HasConnectedTraces then begin if CompareValue(NextRConn.ActualZOrder[1], aZ) <> 0 then begin Result := True; Exit; end else Exit; // попали на вершину райза -- нах (там все непросто) end // если есть приконнекченные трассы else begin // если нельзя размещать трассы на уровне РМ - выходим нах if not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then Exit; // переворот райза if CompareValue(NextRConn.ActualZOrder[1], aZ) <> 0 then begin // если есть приконекченные трассы и их можно двигать вместе с РМ if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin Result := True; Exit; end else Exit; // рельзя двигать приконнекченные трассы - нах end else Exit; // если попали на вершину райза -- нах (там все непросто) end; end else // если есть вертикаль/вертикали if VLine1 <> nil then begin // если вертикаль только одна - примерно то же самое, что и с райзом // кроме того, что нужно проверить, есть ли еще вертикали, // если есть хоть одна - передвижение НЕпростое if vLine2 = nil then begin VLineConn1 := nil; VLineConn2 := nil; // коннектор вертикали, которая на объекте (первый, второй - противоположный) if TConnectorObject(VLine1.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then begin VLineConn1 := TConnectorObject(VLine1.JoinConnector1); VLineConn2 := TConnectorObject(VLine1.JoinConnector2); end else if TConnectorObject(VLine1.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then begin VLineConn1 := TConnectorObject(VLine1.JoinConnector2); VLineConn2 := TConnectorObject(VLine1.JoinConnector1); end; // нет приконнекченных трасс if not HasConnectedTraces then begin if (CompareValue(VLineConn2.ActualZOrder[1], aZ) <> 0) then begin Result := CheckNextVLine; if not Result then Exit; end else Exit; // если попадем не вершину вертикали - нах (там все непросто) end // есть приконнекченные трассы else begin // если нельзя размещать трассы на уровне РМ - выходим нах if not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then Exit; if CompareValue(VLineConn2.ActualZOrder[1], aZ) <> 0 then begin Result := CheckNextVLine; if not Result then Exit; end else Exit;// если попадем не вершину вертикали - нах (там все непросто) end; end else // две вертикали (нужно проверять, не перескочим ли через них ) begin if HasConnectedTraces and (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) then Exit; VLineConn1 := TConnectorObject(VLine1.JoinConnector1); if DirectionUP then begin // ищем самый верхний коннектор if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine1.JoinConnector2); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector2); // проверяем, попадем ли под коннектор if CompareValue(VLineConn1.ActualZOrder[1], aZ) = 1 then begin Result := True; Exit; end else Exit; // попадем на коннектор или перескочим вертикаль - нах (там непросто) end else if DirectionDown then begin // ищем самый нижний коннектор if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine1.JoinConnector2); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector2); // проверяем, попадем ли над коннектором if CompareValue(VLineConn1.ActualZOrder[1], aZ) = -1 then begin Result := True; Exit; end else Exit; // попадем на коннектор или перескочим вертикаль - нах (там непросто) end; end; end; end; end; // вернет фигуру по айдишнику Каталога(если найдет) function GetFigureByCatalogId(CatalogId: Integer): TFigure; var i: Integer; begin Result := nil; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[i]).ID = CatalogId then begin Result := TFigure(GCadForm.FSCSFigures[i]); break; end; end; end; // нужно ли конвертить райз в вертикаль function CheckNeedToConvertRaise(aRaiseLine: TorthoLine): Boolean; begin Result := False; if (((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aZ) = -1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aZ) = 1)) or ((CompareValue(TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1], aZ) = 1) and (CompareValue(TConnectorObject(RaiseLine.JoinConnector2).ActualZOrder[1], aZ) = -1))) then Result := True; end; // 12/05/2016 -- блок записи/восстановления кабельных соединений после подъема/спуска трассы на высоту Procedure CheckSaveLineConnectionsBySide(aLine: TOrthoLine; aCableCompon: TSCSComponent; aSide: Integer); var i, j, k: Integer; InterfPos: TSCSInterfPosition; Interf, ConnectedInterf: TSCSInterface; DirectConnectedComponList, ConnectedComponList: TList; JoinedCompon, ConnectedLineComponent: TSCSComponent; PointToSave: TConnectorObject; PointCatalog, LineCatalog, JoinedLineCatalog: TSCSCatalog; POintFigure, LineFigure: TFigure; CanContinue: Boolean; //WayList: TList; // ComponToDeleteList: TSCSComponents; LastComponent: TSCSComponent; LastSide: Integer; isLineConnection, isPointConnection: Boolean; ComponJoinedByMultiInterface: TSCSComponent; JoinedInterface: TSCSInterface; FirstComponID: Integer; SavedPointConnection: Boolean; PointToPointConnection: Boolean; CanSaveDirectConnection: Boolean; CanSaveCableToPointConnection: Boolean; PassedList: TList; Procedure SaveConnectionOnPointObject(aPointObject: TConnectorObject; aPointCatalog: TSCSCatalog; aJoinedLineCompon: TSCSComponent; ConnectionSide: Integer); var i, j, k, l, m: Integer; PointJoinedLineCatalog : TSCSCatalog; PointComponent, LineComponent: TSCSComponent; LineJoinedComponList: TList; LineInterface: TSCSInterface; aCableComponInterface, ALineInterFace: TSCSInterface; APointInterfID: Integer; InterfPosition, JoinedPosition: TSCSInterfPosition; JoinedLineCatalog: TSCSCatalog; JoinedLineFigure: TFigure; begin // NBConnector := APointObject; // if NBConnector <> nil then begin //JoinedPointObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(NBConnector.Id); // DivLineObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ASnapLine.Id); //DivLineObject := aJoinedLineCompon.GetFirstParentCatalog; //if (aPointCatalog <> nil) and (DivLineObject <> nil) then // с вертикалей кабель -- нах JoinedLineCatalog := aJoinedLineCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then begin JoinedLineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); if JoinedLineFigure <> nil then begin if CheckFigureByClassName(JoinedLineFigure, cTOrthoLine) then begin //Tolik 11/10/2021 -- //if (TOrthoLine(JoinedLineFigure).FIsVertical and (ComponToDeleteList.IndexOf(aJoinedLineCompon) = -1)) then // ComponToDeleteList.Add(aJoinedLineCompon); if Assigned(WayList) then begin if WayList.IndexOf(JoinedLineFigure) <> -1 then if ComponToDeleteList.IndexOf(aJoinedLineCompon) = -1 then // Tolik 11/10/2021 - - ComponToDeleteList.Add(aJoinedLineCompon); end; // end; end; end; if (aPointCatalog <> nil) then begin //if ((aPointCatalog.ComponentReferences.Count > 0) and (DivLineObject.ComponentReferences.Count > 0)) then begin InterFaceAccordanceList := TList.Create; //LineInterfList := TList.Create; //for j := 0 to DivLineObject.ComponentReferences.Count - 1 do //begin //LineCompon := DivLineObject.ComponentReferences[j]; // 14/05/2016 // if LineCompon.ComponentType.SysName = ctsnCable then if IsCableComponent(aJoinedLineCompon) then // так правильнее -- для всех кабелей // begin if CheckJoinedComponToComponFromObject(aJoinedLineCompon, aPointCatalog) then begin for k := 0 to aJoinedLineCompon.Interfaces.count - 1 do begin if (aJoinedLineCompon.Interfaces[k].TypeI = itFunctional) and (aJoinedLineCompon.Interfaces[k].Side = ConnectionSide) and ((aJoinedLineCompon.Interfaces[k].IsBusy = biTrue) or (aJoinedLineCompon.Interfaces[k].BusyPositions.Count > 0)) then begin SavedLineComponList := TList.Create; SavedPointComponList := TList.Create; ALineInterFace := TSCSInterFace(aJoinedLineCompon.Interfaces.Items[k]); { if SavedLineComponList.IndexOf(LineCompon.Interfaces.Items[k]) = -1 then SavedLineComponList.Add(TSCSInterFace(LineCompon.Interfaces.Items[k]));} if aCableCompon.Id = aJoinedLineCompon.id then begin if SavedLineComponList.IndexOf(ALineInterFace) = -1 then SavedLineComponList.Add(TSCSInterface(ALineInterFace)); end else begin aCableComponInterFace := aCableCompon.Interfaces[k]; if SavedLineComponList.IndexOf(aCableComponInterFace) = -1 then SavedLineComponList.Add(TSCSInterface(aCableComponInterFace)); // aTempInterf := TSCSInterface(SavedLineComponList[l]); end; APointInterfID := -1; for l := 0 to ALineInterFace.BusyPositions.Count - 1 do begin InterfPosition := ALineInterFace.BusyPositions[l]; JoinedPosition := InterfPosition.GetConnectedPos; if JoinedPosition <> nil then begin if JoinedPosition.InterfOwner <> nil then begin if SavedPointComponList.IndexOf(JoinedPosition.InterfOwner) = -1 then SavedPointComponList.Add(TSCSInterFace(JoinedPosition.InterfOwner)); end; end; end; if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then begin InterFaceAccordanceList.Add(SavedLineComponList); InterFaceAccordanceList.Add(SavedPointComponList); end else begin SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); end; end; end; end; end; //end; end; if ((InterFaceAccordanceList.Count > 0) and CanSaveCableToPointConnection) then begin if SavedCableComponList.IndexOf(aCableCompon) = -1 then SavedCableComponList.Add(aCableCompon); // состояние соединения кабеля на точечном объекте SelfLineConnectInfo := TLineComponConnectionInfo.Create(True); SelfLineConnectInfo.ComponId := aCableCompon.ID;//AJoinedLineCompon.ID; // SelfLineConnectInfo.ComponSide := ConnectionSide; SelfLineConnectInfo.ComponSide := ASide; SelfLineConnectInfo.isLineConnection := False; JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); if ObjectToSnap = nil then JoinedLineConnectInfo.ComponCatalogID := APointCatalog.ID else begin // если попадаем на другой компонент, то каталог назначения для поинта поменяется // но тольков том случае, если кабель приконнекчен к тому поинту, который поднимаем, а не проходит через него if aPointObject.ID = aObject.ID then JoinedLineConnectInfo.ComponCatalogID := TSCSCatalog(F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ObjectToSnap.ID)).ID else JoinedLineConnectInfo.ComponCatalogID := APointCatalog.ID; end; JoinedLineConnectInfo.ComponSide := 0; JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); //SavedLineConnectionsList.Add(SelfLineConnectInfo); SavedConnectionsList.Add(SelfLineConnectInfo); end else FreeAndNil(InterFaceAccordanceList); end; end; // сбросить соединения линейного с точечными на заданной стороне LineJoinedComponList := TList.Create; for i := 0 to aJoinedLineCompon.Interfaces.Count - 1 do begin LineInterface := TSCSInterface(aJoinedLineCompon.Interfaces[i]); if (LineInterface.TypeI = itFunctional) and (LineInterface.Side = ConnectionSide) then begin for j := 0 to LineInterface.ConnectedInterfaces.Count - 1 do if LineJoinedComponList.IndexOf(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)) = -1 then LineJoinedComponList.Add(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)); end; end; for i := 0 to LineJoinedComponList.Count - 1 do begin aJoinedLineCompon.DisJoinFrom(TSCSComponent(LineJoinedComponList[i])); end; FreeAndNil(LineJoinedComponList); // end; function GetLastConnectedComponent(ALastCompon: TSCSComponent; SelfSide: integer): TSCSComponent; var i, j, k: Integer; //LineFigure: Tfigure; LineCatalog: TSCSCatalog; LastComponinterface: TSCSInterface; InterfPos: TSCSInterfPosition; LineFound, PointFound: Boolean; ConnectedCompon: TSCSComponent; LastLine: TOrthoLine; SavedPosSide: Integer; LastLineCompon: TSCSComponent; JoinedPointObject: TConnectorObject; JoinedPointCatalog: TSCSCatalog; begin Result := nil; LineFound := False; PointFound := False; CanContinue := False; LastLineCompon := ALastCompon; LineCatalog := ALastCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LastLine := TOrthoLine(GetFigureByCatalogId(LineCatalog.SCSID)); if LastLine <> nil then begin // кабель с вертикали - нах if LastLine.FIsVertical then begin if ComponToDeleteList.IndexOf(aLastCompon) = -1 then if ComponToDeleteList.IndexOf(aLastCompon) = -1 then ComponToDeleteList.Add(aLastCompon); end; if (not LastLine.FIsVertical) and (not LastLine.FIsRaiseUpDown) then begin if ConnectedComponList.IndexOf(ALastCompon) = -1 then ConnectedComponList.Add(ALastCompon) else exit; Exit; end; end; end; for i := 0 to ALastCompon.Interfaces.Count - 1 do begin LastComponinterface := TSCSInterface(ALastCompon.Interfaces[i]); if ((LastComponinterface.TypeI = itFunctional) and (LastComponinterface.Side <> SelfSide)) then begin if ((LastComponinterface.IsBusy = biTrue) or (LastComponinterface.BusyPositions.Count > 0)) then begin for j := 0 to LastComponinterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(LastComponinterface.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin ConnectedCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner); if ConnectedCompon.IsLine = biTrue then begin LastLineCompon := ConnectedCompon; //ALastCompon.DisJoinFrom(LastLineCompon); if ConnectedComponList.IndexOf(ConnectedCompon) = -1 then begin SavedPosSide := InterfPos.InterfOwner.Side; // сторона подключения LineCatalog := ConnectedCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(LineCatalog.SCSID); if LineFigure <> nil then begin if TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown then begin if ComponToDeleteList.IndexOf(ConnectedCompon) = -1 then ComponToDeleteList.Add(ConnectedCompon); {if ConnectedComponlist.IndexOf(Connectedcompon) = -1 then ConnectedComponList.Add(ConnectedCompon);} //ALastCompon.DisJoinFrom(ConnectedCompon); Result := GetLastConnectedComponent(ConnectedCompon, SavedPosSide); if Result = Nil then begin if SavedPosSide = 1 then LastSide := 2 else if SavedPosSide = 2 then LastSide := 1; end; end else // если сходим с вертикали -- приехали begin Result := ConnectedCompon; //Result := nil; // LineFigure := nil; // сброс для множественных подключений на том же уровне при наличии мультиинтерфейса if ConnectedComponList.IndexOf(ConnectedCompon) = -1 then ConnectedComponList.Add(ConnectedCompon); {if SavedPosSide = 1 then LastSide := 2 else if SavedPosSide = 2 then LastSide := 1;} LastSide := SavedPosSide; end; end; end; end; end else begin if ConnectedCompon.isLine = biFalse then begin SavedPosSide := LastComponInterface.Side; LastSide := SavedPosSide; JoinedPointCatalog := ConnectedCompon.GetFirstParentCatalog; if JoinedPointCatalog <> nil then begin JoinedPointObject := TConnectorObject(GetFigureByCatalogId(JoinedPointCatalog.SCSID)); if JoinedPointObject <> nil then begin // SaveConnectionOnPointObject(JoinedPointObject, JoinedPointCatalog, aLastCompon, aSide); SaveConnectionOnPointObject(JoinedPointObject, JoinedPointCatalog, aLastCompon, LastSide); SavedPointConnection := True; isPointConnection := True; end; Result := nil; Exit; end; end; end; end; end; end; end; end; end; //Tolik 07/10/2021 -- function CheckSaveConnection: Boolean; var i: integer; SCSCatalog: TSCSCatalog; Conn: TConnectorObject; begin Result := False; Result := (((not aLine.FIsVertical) and (not aLine.FIsRaiseUpDown)) or ((aLine.FIsVertical or aLine.FIsRaiseUpDown) and (WayList.IndexOf(aLine) = -1))); if not Result then Result := (CompareValue(aLine.ActualZOrder[1], aZ) = 0) or (CompareValue(aLine.ActualZOrder[1], aZ) = 0); if not Result then begin if ObjectToSnap <> nil then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ObjectToSnap.Id); if SCSCatalog <> nil then begin Result := True; for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin if SCSCatalog.ComponentReferences[i].JoinedComponents.IndexOf(aCableCompon) <> -1 then begin Result := False; break; end; end; end; end; end; if Result then begin if WayList.IndexOf(aLine) <> -1 then begin end; end; end; // begin CanContinue := False; SelfLineConnectInfo := nil; JoinedLineConnectInfo := Nil; ConnectedComponList := TList.Create; PointToSave := nil; isLineConnection := False; //isLineConnection := True; isPointConnection := False; LineFigure := Nil; SavedPointConnection := False; PointToPointConnection := False; CanSaveCableToPointConnection := True; // если сохраняем соединение на вертикали или на райзе, проверяем будет ли это соединение типа точка-точка //if aLine.FIsVertical or aLine.FIsRaiseUpDown // CheckPointTopointConnection; // //if not PointToPointConnection then // стандартно для ортолинии //Tolik 07/10/2021 -- //if (((not aLine.FIsVertical) and (not aLine.FIsRaiseUpDown)) or ((aLine.FIsVertical or aLine.FIsRaiseUpDown) and (WayList.IndexOf(aLine) = -1))) then if CheckSaveConnection then // begin //ComponToDeleteList := TSCSComponents.Create(False); {if ((aCableCompon.JoinedComponents.count > 0) and (SavedComponList.IndexOf(aCableCompon) = -1)) then SavedComponList.Add(ACablecompon); } for i := 0 to aCableCompon.Interfaces.Count - 1 do begin Interf := TSCSInterface(aCableCompon.Interfaces[i]); // ищем возможные подключения с указанной стороны if ((Interf.Side = aSide) and (Interf.TypeI = itFunctional) and ((Interf.IsBusy = biTrue) or (interf.BusyPositions.Count > 0))) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); // занятая позиция интерфейса InterfPos := InterfPos.GetConnectedPos; // подключенная к ней непосредственно позиция интерфейса // присоединенного компонента JoinedCompon := InterfPos.InterfOwner.ComponentOwner; // присоединенный компонент if JoinedCompon <> nil then begin // подключен точечный компонент if JoinedCompon.IsLine = biFalse then begin // точечное соединение -- сохранить по позициям для восстановления if ConnectedComponList.IndexOf(JoinedCompon) = -1 then ConnectedComponList.Add(JoinedCompon); if PointToSave = nil then begin PointCatalog := JoinedCompon.GetFirstParentCatalog; PointToSave := TConnectorObject(GetFigurebyCatalogID(PointCatalog.SCSID)); // нашли точечный, присоединенный к кабелю -- сохраняем соединение и вываливаемся if ((PointToSave <> nil) and (CheckFigureByClassName(PointToSave, cTConnectorObject))) then begin SaveConnectionOnPointObject(PointtoSave, PointCatalog, aCableCompon, aSide); //Tolik 11/10/2021 -- aCableCompon.DisJoinFrom(JoinedCompon); exit; //// BREAK ////; end; end; end // подключен линейный компонент // линейные поинтерфейсно соединять не нужно, просто соединить кабель else if JoinedCompon.isLine = biTrue then begin if ConnectedComponlist.IndexOf(JoinedCompon) = -1 then begin ConnectedComponList.Add(JoinedCompon); isLineConnection := True; LastSide := InterfPos.InterfOwner.Side; // сторона подлючения подключенного кабеля к текущему //если подключен линейный - ищем конечную точку восстановления JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); if LineFigure <> nil then begin if (TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown) then begin // список на удаление if (ComponToDeleteList.IndexOf(JoinedCompon) = -1) then ComponToDeleteList.Add(JoinedCompon); // получить последний кусок кабеля aCableCompon.DisJoinFrom(JoinedCompon); JoinedCompon := GetLastConnectedComponent(JoinedCompon, LastSide); end; // если последняя фигура -- вертикаль и дальше обрыв if (JoinedCompon = nil) and (not SavedPointConnection) then begin if ConnectedComponList.Count > 0 then begin JoinedCOmpon := TSCSComponent(ConnectedComponList[ConnectedComponList.Count - 1]); JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); end; end; end; end; // если соединение - линейное - сохранить его if (LineFigure <> nil) and (not SavedPointConnection) then begin if SavedCableComponList.IndexOf(aCableCompon) = -1 then SavedCableComponList.add(aCableCompon); // кабель поднимаемой трассы SelfLineConnectInfo := TLineComponConnectionInfo.Create(True); SelfLineConnectInfo.ComponId := aCableCompon.ID; SelfLineConnectInfo.ComponSide := aSide; // трасса и сторона соединения JoinedLineConnectInfo:= TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponId := JoinedCompon.ID; if TOrthoLine(LineFigure).FIsVertical then begin if LastSide = 1 then LastSide := 2 else if LastSide = 2 then LastSide := 1; end; JoinedLineConnectInfo.ComponSide := LastSide; JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then JoinedLineConnectInfo.ComponCatalogID := JoinedLineCatalog.ID; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); //SavedLineConnectionsList.Add(SelfLineConnectInfo); SavedConnectionsList.Add(SelfLineConnectInfo); //отключить найденный кабель нах if aCableCompon.JoinedComponents.IndexOF(JoinedCompon) <> -1 then aCableCompon.DisJoinFrom(JoinedCompon); end; end; end; end; if isLineConnection then Break; //// BREAK //// if isPointConnection then Break; //// BREAK ////; end; end; if isLineConnection then Break; //// BREAK //// if isPointConnection then Break; //// BREAK ////; end; end else // сохранение соединения для райза или вертикали // сюда попадем, если проходим по райзу или вертикали дальше, // поэтому будем смотреть, что там дальше есть, а сохраним (али нет) соединение последнего кабеля, который найдем begin // если проходим по райзу или вертикали и попадем не объект - кабель искать будем, // в список удаление засунем, но восстанавливать соединение не будем if WayList.IndexOf(aLine) <> -1 then if ComponToDeleteList.IndexOf(aCableCompon) = -1 then ComponToDeleteList.Add(ACableCompon); if ObjectToSnap <> nil then begin // смотрим дальше кабели по вертикали, если есть if aLine.FIsVertical then begin PassedList := TList.Create; JoinedCompon := aCableCompon; PassedList.Add(JoinedCompon); CanContinue := True; While CanContinue do begin CanContinue := False; for i := 0 to JoinedCompon.JoinedComponents.Count - 1 do begin if ((IsCableComponent(TSCSComponent(JoinedCompon.JoinedComponents[i])) and (TSCSComponent(JoinedCompon.JoinedComponents[i]).Whole_ID = JoinedCompon.Whole_ID)) and (PassedList.IndexOf(TSCSComponent(JoinedCompon.JoinedComponents[i])) = -1)) then begin JoinedCompon := TSCSComponent(JoinedCompon.JoinedComponents[i]); PassedList.Add(JoinedCompon); if ComponToDeleteList.IndexOf(JoinedCompon) = -1 then ComponToDeleteList.Add(JoinedCompon); CanContinue := True; Break; //// BREAK ////; end; end; end; end; end else begin // если не попадем на объект, то соединение нужно записать для того кабеля, который найдем for i := 0 to aCableCompon.Interfaces.Count - 1 do begin Interf := TSCSInterface(aCableCompon.Interfaces[i]); // ищем возможные подключения с указанной стороны if ((Interf.Side = aSide) and (Interf.TypeI = itFunctional) and ((Interf.IsBusy = biTrue) or (interf.BusyPositions.Count > 0))) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); // занятая позиция интерфейса InterfPos := InterfPos.GetConnectedPos; // подключенная к ней непосредственно позиция интерфейса // присоединенного компонента JoinedCompon := InterfPos.InterfOwner.ComponentOwner; // присоединенный компонент if JoinedCompon <> nil then begin // подключен точечный компонент if JoinedCompon.IsLine = biFalse then begin // точечное соединение -- сохранить по позициям для восстановления if ConnectedComponList.IndexOf(JoinedCompon) = -1 then ConnectedComponList.Add(JoinedCompon); if PointToSave = nil then begin PointCatalog := JoinedCompon.GetFirstParentCatalog; PointToSave := TConnectorObject(GetFigurebyCatalogID(PointCatalog.SCSID)); // нашли точечный, присоединенный к кабелю -- сохраняем соединение и вываливаемся if ((PointToSave <> nil) and (CheckFigureByClassName(PointToSave, cTConnectorObject))) then begin SaveConnectionOnPointObject(PointtoSave, PointCatalog, aCableCompon, aSide); aCableCompon.DisJoinFrom(JoinedCompon); // exit; //// BREAK ////; Break; //// BREAK ////; end; end; end // подключен линейный компонент // линейные поинтерфейсно соединять не нужно, просто соединить кабель else if JoinedCompon.isLine = biTrue then begin if ConnectedComponlist.IndexOf(JoinedCompon) = -1 then begin ConnectedComponList.Add(JoinedCompon); isLineConnection := True; LastSide := InterfPos.InterfOwner.Side; // сторона подлючения подключенного кабеля к текущему //если подключен линейный - ищем конечную точку восстановления JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); if LineFigure <> nil then begin if (TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown) then begin // список на удаление if (ComponToDeleteList.IndexOf(JoinedCompon) = -1) then ComponToDeleteList.Add(JoinedCompon); // получить последний кусок кабеля aCableCompon.DisJoinFrom(JoinedCompon); JoinedCompon := GetLastConnectedComponent(JoinedCompon, LastSide); end; // если последняя фигура -- вертикаль и дальше обрыв if (JoinedCompon = nil) and (not SavedPointConnection) then begin if ConnectedComponList.Count > 0 then begin JoinedCOmpon := TSCSComponent(ConnectedComponList[ConnectedComponList.Count - 1]); JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); end; end; end; end; // если соединение - линейное - сохранить его if (LineFigure <> nil) and (not SavedPointConnection) then begin if SavedCableComponList.IndexOf(JoinedCompon) = -1 then SavedCableComponList.Add(JoinedCompon); // кабель поднимаемой трассы SelfLineConnectInfo := TLineComponConnectionInfo.Create(True); SelfLineConnectInfo.ComponId := JoinedCompon.ID; SelfLineConnectInfo.ComponSide := LastSide; // трасса и сторона соединения JoinedLineConnectInfo:= TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponId := JoinedCompon.ID; if ((TOrthoLine(LineFigure).FIsVertical) or (TOrthoLine(LineFigure).FIsRaiseUpDown)) then begin if LastSide = 1 then LastSide := 2 else if LastSide = 2 then LastSide := 1; end; JoinedLineConnectInfo.ComponSide := 0; JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then JoinedLineConnectInfo.ComponCatalogID := JoinedLineCatalog.ID; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); //SavedLineConnectionsList.Add(SelfLineConnectInfo); SavedConnectionsList.Add(SelfLineConnectInfo); //отключить найденный кабель нах if aCableCompon.JoinedComponents.IndexOF(JoinedCompon) <> -1 then aCableCompon.DisJoinFrom(JoinedCompon); end; end; end; end; if isLineConnection then Break; //// BREAK //// if isPointConnection then Break; //// BREAK ////; end; end; if isLineConnection then Break; //// BREAK //// if isPointConnection then Break; //// BREAK ////; end; JoinedCompon := nil; for i := 0 to aCableCompon.Interfaces.Count - 1 do begin Interf := TSCSInterface(aCableCompon.Interfaces[i]); // ищем возможные кабельные подключения с указанной стороны if ((Interf.Side <> aSide) and (Interf.TypeI = itFunctional) and ((Interf.IsBusy = biTrue) or (interf.BusyPositions.Count > 0))) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); // занятая позиция интерфейса InterfPos := InterfPos.GetConnectedPos; // подключенная к ней непосредственно позиция интерфейса // присоединенного компонента JoinedCompon := InterfPos.InterfOwner.ComponentOwner; // присоединенный компонент if JoinedCompon <> nil then begin // подключен линейный компонент // линейные поинтерфейсно соединять не нужно, просто соединить кабель if JoinedCompon.isLine = biTrue then begin if ConnectedComponlist.IndexOf(JoinedCompon) = -1 then begin ConnectedComponList.Add(JoinedCompon); isLineConnection := True; LastSide := InterfPos.InterfOwner.Side; // сторона подлючения подключенного кабеля к текущему aCableCompon.DisJoinFrom(JoinedCompon); //если подключен линейный - ищем конечную точку восстановления JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); if LineFigure <> nil then begin if (TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown) then begin // список на удаление if (ComponToDeleteList.IndexOf(JoinedCompon) = -1) then ComponToDeleteList.Add(JoinedCompon); // получить последний кусок кабеля aCableCompon.DisJoinFrom(JoinedCompon); JoinedCompon := GetLastConnectedComponent(JoinedCompon, LastSide); end else aCableCompon.DisJoinFrom(JoinedCompon); // если последняя фигура -- вертикаль и дальше обрыв if (JoinedCompon = nil) and (not SavedPointConnection) then begin if ConnectedComponList.Count > 0 then begin JoinedCOmpon := TSCSComponent(ConnectedComponList[ConnectedComponList.Count - 1]); JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); end; end; end; end; end; end; end; if JoinedCompon <> nil then Break; //// BREAK ////; end; end; end; if JoinedCompon <> nil then begin if SavedCableComponList.IndexOf(JoinedCompon) = -1 then SavedCableComponList.Add(JoinedCompon); SavedCableComponList.Remove(aCableCompon); for i := 0 to SavedConnectionsList.Count - 1 do begin if ((TLineComponConnectionInfo(SavedConnectionsList[i]).ComponId = aCableCompon.ID) and (TLineComponConnectionInfo(SavedConnectionsList[i]).ComponSide = aSide)) then begin TLineComponConnectionInfo(SavedConnectionsList[i]).ComponId := JoinedCompon.ID; TLineComponConnectionInfo(SavedConnectionsList[i]).ComponSide := LastSide; end; end; end; end; end; // если мультиинтерфейс - отключить все подключенные на нем( остальные кабели) // и загнать их в список подключенных компонент для восстановления, if aCableCompon.JoinedComponents.Count > 0 then begin for i := 0 to aCableCompon.Interfaces.count - 1 do begin Interf := TSCSInterface(aCableCompon.Interfaces[i]); if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide) and (Interf.Multiple = biTrue) and (Interf.ConnectedInterfaces.Count > 1)) then begin if aCableCompon.JoinedComponents.Count > 0 then begin While Interf.ConnectedInterfaces.Count > 0 do begin JoinedInterface := TSCSInterface(Interf.ConnectedInterfaces[0]); ComponJoinedByMultiInterface := JoinedInterface.ComponentOwner; if ComponJoinedByMultiInterface <> nil then begin if (ComponJoinedByMultiInterface.IsLine = biTrue) then begin ConnectedComponList.Add(ComponJoinedByMultiInterface); // если было сохранение линейного соединения -- добавить в список сохранения подключенный кабель if SelfLineConnectInfo <> nil then begin FirstComponID := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]).ComponId; // на всякий if ComponJoinedByMultiInterface.ID <> FirstComponID then begin JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponId := ComponJoinedByMultiInterface.ID; JoinedLineConnectInfo.ComponSide := JoinedInterface.Side; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); end; end; end; // отключить (если уже есть в списке или точечный компонент) aCableCompon.DisJoinFrom(ComponJoinedByMultiInterface); end; end; end; end; end; end; ConnectedComponList.Clear; FreeAndNil(ConnectedcomponList); GCadForm.PCad.Refresh; end; // сохранить соединения кабелей к точечному Procedure SaveConnectionOnPointObject; var i, j, k, l, m, n: Integer; PointCatalog: TSCSCatalog; PointComponent, CableComponent: TSCSComponent; LineComponentsList, LineToLineComponentsList: TList; function GetJoinedCableSide(CableCompon, JoinedCableCompon: TSCSComponent): Integer; var i, j : Integer; CableInterFace: TSCSInterface; CableInterfPos, JoinedCableInterfPos: TSCSInterfPosition; begin Result := 0; for i := 0 to CableCompon.Interfaces.Count - 1 do begin CableInterFace := TSCSInterface(CableCompon.Interfaces[i]); if (CableInterFace.TypeI = itFunctional) and ((CableInterFace.IsBusy = bitrue) or (CableInterFace.BusyPositions.Count > 0)) then begin for j := 0 to CableInterFace.BusyPositions.Count - 1 do begin CableInterfPos := TSCSInterfPosition(CableInterFace.BusyPositions[j]); JoinedCableInterfPos := CableInterfPos.GetConnectedPos; if JoinedCableInterfPos <> nil then begin if JoinedCableInterfPos.InterfOwner.ComponentOwner.ID = JoinedCableCompon.ID then begin Result := JoinedCableInterfPos.InterfOwner.Side; Break; //// BREAK ////; end; end; end; end; if Result <> 0 then Break; //// BREAK ////; end; end; function GetCableSide(CableComponent: TSCSComponent; aCatalog: TSCSCatalog): Integer; var i, j: Integer; interf: TSCSInterface; InterfPos: TSCSInterfPosition; begin Result := 0; for i := 0 to CableComponent.Interfaces.Count - 1 do begin if (TSCSInterface(CableComponent.Interfaces[i]).TypeI = itFunctional) then begin Interf := TSCSInterface(CableComponent.Interfaces[i]); for j := 0 to interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(interf.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if (InterfPos <> nil) and (InterfPos.InterfOwner <> nil) and (InterfPos.InterfOwner.ComponentOwner <> nil) then begin if aCatalog.ComponentReferences.IndexOf(InterfPos.InterfOwner.ComponentOwner) <> -1 then begin Result := interf.Side; break; end; end; end; if Result <> 0 then Break; //// BREAK ////; end; end; end; function GetConnectedInterFace(aInterf: TSCSInterFace; ACompon: TSCSComponent; aSide: integer): TSCSInterface; var i: Integer; begin Result := nil; end; function GetCableFromRaise(aCompon: TSCSComponent) : TSCSComponent; var i: Integer; begin Result := nil; for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if IsCableComponent(aCompon.JoinedComponents[i]) then begin Result := TSCSComponent(aCompon.JoinedComponents[i]); Break; //// BREAK ////; end; end; end; function GetInterfFromRaise(aCableComponent: TSCSComponent; aComponSide: Integer; aCableInterFace: TSCSInterface): TSCSInterface; var i: Integer; begin Result := Nil; for i := 0 to aCableComponent.Interfaces.Count - 1 do begin if (TSCSInterface(aCableComponent.Interfaces[i]).Npp = aCableInterFace.Npp) and (TSCSInterface(aCableComponent.Interfaces[i]).Side = aComponSide) then begin Result := TSCSInterface(aCableComponent.Interfaces[i]); Break; //// BREAK ////; end; end; end; procedure SaveLineConnection(aCableList: TList; aPointCatalog: TSCSCatalog); var i, j, k: Integer; CableComponent, JoinedFromRaiseCableComponent, JoinedPointComponent: TSCSComponent; LineCatalog: TSCSCatalog; LineFigure: TFigure; CableInterface, JoinedCableInterFace: TSCSInterface; InterfPos, JoinedInterfPos: TSCSInterfPosition; CableComponSide, JoinedCableComponSide: Integer; //ComponToDeleteList: TSCSComponents; CanDelCable: Boolean; ADInterface: TSCSInterface; begin if aCableList.Count > 0 then begin //SavedPointConnectionsList := TList.Create; SavedConnectionsList := TList.Create; //ComponToDeleteList := TSCSComponents.Create(False); for i := 0 to aCableList.Count - 1 do begin InterFaceAccordanceList := TList.Create; CableComponent := TSCSComponent(aCableList[i]); CableComponSide := GetCableSide(CableComponent, aPointCatalog); CanDelCable := False; JoinedFromRaiseCableComponent := nil; LineCatalog := CableComponent.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(LineCatalog.SCSID); if LineFigure <> nil then begin if TOrthoLine(LineFigure).FIsRaiseUpDown then begin CanDelCable := True; JoinedFromRaiseCableComponent := GetCableFromRaise(CableComponent); if JoinedFromRaiseCableComponent <> nil then JoinedCableComponSide := GetJoinedCableSide(CableComponent, JoinedFromRaiseCableComponent); end; end; // сохранять соединения только если это трасса или кабель с райза подключен на другую трассу, а не // к точечному или просто висит в воздухе if ((not CanDelCable) or (CanDelCable and (JoinedFromRaiseCableComponent <> nil))) then begin for j := 0 to CableComponent.Interfaces.Count - 1 do begin SavedLineComponList := TList.Create; SavedPointComponList := TList.Create; CableInterface := TSCSInterface(CableComponent.Interfaces[j]); if (CableInterface.TypeI = itFunctional) and (CableInterface.Side = CableComponSide) and ((CableInterface.BusyPositions.Count > 0) or (CableInterface.IsBusy = biTrue)) then begin if CanDelCable then ADInterface := GetInterfFromRaise(JoinedFromRaiseCableComponent, JoinedCableComponSide, CableInterFace) else ADInterface := CableInterface; if SavedLineComponList.IndexOf(AdInterface) = -1 then SavedLineComponList.Add(ADInterface); for k := 0 to CableInterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(CableInterface.BusyPositions[k]); JoinedInterfPos := InterfPos.GetConnectedPos; if (JoinedInterfPos <> nil) and (JoinedInterfPos.InterfOwner <> nil) and (JoinedInterfPos.InterfOwner.ComponentOwner <> nil) then begin if SavedPointComponList.IndexOf(JoinedInterfPos.InterfOwner) = -1 then SavedPointComponList.Add(JoinedInterfPos.InterfOwner); end; end; end; if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then begin InterFaceAccordanceList.Add(SavedLineComponList); InterFaceAccordanceList.Add(SavedPointComponList); SavedPointComponList := Nil; SavedPointComponList := Nil; end else begin FreeAndNil(SavedPointComponList); FreeAndNil(SavedLineComponList); end; end; end; end; // если кабель на райзе - занести в список на удаление if (CanDelCable and (ComponToDeleteList.IndexOf(CableComponent) = - 1)) then ComponToDeleteList.Add(CableComponent); if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin // состояние соединения кабеля на точечном объекте SelfPointConnectInfo := TLineComponConnectionInfo.Create(True); if (not CanDelCable) then begin SelfPointConnectInfo.ComponId := CableComponent.ID;//AJoinedLineCompon.ID; SelfPointConnectInfo.ComponSide := CableComponSide; SelfPointConnectInfo.isLineConnection := True; // подключить через новый кабель на райзе end else begin SelfPointConnectInfo.ComponId := JoinedFromRaiseCableComponent.ID;//AJoinedLineCompon.ID; SelfPointConnectInfo.ComponSide := JoinedCableComponSide; SelfPointConnectInfo.isLineConnection := False; // подключить прямо к тому, что есть (в точке подъема) end; JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponCatalogID := 0; JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList; SelfPointConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); //SavedPointConnectionsList.Add(SelfPointConnectInfo); SavedConnectionsList.Add(SelfPointConnectInfo); InterFaceAccordanceList := Nil; end else begin if InterFaceAccordanceList <> nil then FreeAndNil(InterFaceAccordanceList); end; end; // удалить кабели с райза { if ComponToDeleteList.Count > 0 then F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil);} end; end; begin if aObject <> nil then begin PointCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aObject.ID); // строим список кабелей, подключенных к поинту if PointCatalog <> nil then begin PointComponents := TList.Create; LineComponentsList := TList.Create; for i := 0 to PointCatalog.ComponentReferences.Count - 1 do begin PointComponent := TSCSComponent(PointCatalog.ComponentReferences[i]); if PointComponents.IndexOf(PointComponent) = -1 then PointComponents.Add(PointComponent); for j := 0 to PointComponent.JoinedComponents.Count - 1 do begin if IsCableComponent(TSCSComponent(PointComponent.JoinedComponents[j])) then begin if LineComponentsList.IndexOf(TSCSComponent(PointComponent.JoinedComponents[j])) = -1 then LineComponentsList.Add(TSCSComponent(PointComponent.JoinedComponents[j])); end; end; end; if LineComponentsList.Count > 0 then SaveLineConnection(LineComponentsList, PointCatalog) else FreeAndNil(LineComponentsList); end; end; end; // соединить два кабеля Procedure ConnectCableComponents(ACompon1, ACompon2: TSCSComponent); var LineCatalog1, LineCatalog2 : TSCSCatalog; SelfSide, JoinSide : integer; Line1, Line2: TOrthoLine; function CheckCanJoinOnConnectors(aConn1, aConn2: TConnectorObject): Boolean; begin Result := False; // если на одном точечном if (aConn1.JoinedConnectorsList.Count > 0) and (TConnectorObject(aConn1.JoinedConnectorsList[0]).JoinedConnectorsList.IndexOf(aConn2) <> -1) then Result := True else // или это один и тот же коннектор if aConn1.ID = aConn2.ID then Result := True; end; begin LineCatalog1 := ACompon1.GetFirstParentCatalog; LineCatalog2 := ACompon2.GetFirstParentCatalog; if ((LineCatalog1 <> nil) and (LineCatalog2 <> nil)) then begin Line1 := TOrthoLine(GetFigureByCatalogId(LineCatalog1.SCSId)); Line2 := TOrthoLine(GetFigureByCatalogId(LineCatalog2.SCSId)); if ((Line1 <> nil) and (Line2 <> nil)) then begin SelfSide := 0; JoinSide := 0; if (ACompon1 <> nil) and (ACompon2 <> nil) then begin if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector1), TConnectorObject(Line2.JoinConnector1)) then ACompon1.JoinTo(ACompon2, 1, 1) else if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector1), TConnectorObject(Line2.JoinConnector2)) then ACompon1.JoinTo(ACompon2, 1, 2) else if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector2), TConnectorObject(Line2.JoinConnector1)) then ACompon1.JoinTo(ACompon2, 2, 1) else if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector2), TConnectorObject(Line2.JoinConnector2)) then ACompon1.JoinTo(ACompon2, 2, 2); end; end; end; end; Procedure RestoreLineConnectionsBySide(aLine: TOrthoLine; ACableCompon: TSCSComponent; aSide: Integer); var i, j, k, l, m: Integer; TargetLine, TargetPointFigure: TFigure; WayList: TList; SelfConnector, TargetConn: TConnectorObject; TargetCatalog: TSCSCatalog; IdNewCompon: Integer; TargetCompon, NewCompon, FirstCompon, NextCompon: TSCSComponent; PassWayList: Boolean; // прокладывать кабель на вертикали/райзы ComponJoinedByMultiInterFace: TSCSComponent; CanRestoreConnection: Boolean; DisJoinSide: Integer; DisJoinComponList: TList; APointInterFace, aTempInterf, ALineInterFace: TSCSInterface; LineCompon, PointCompon: TSCSComponent; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; ConnectIDCompRel, InterfCount: Integer; TempInterfaces1, TempInterfaces2: TSCSInterfaces; ptrConnection: PComplect; Function GetInterfaceForConnection(AInterf: TSCSInterFace; WasConnectedCable, isConnectedCable: TSCSComponent; aPointObject: TConnectorObject): TSCSInterFace; var i, j, k: Integer; LineCompon: TSCSComponent; LineFigure: TOrthoLine; LineCatalog: TSCSCatalog; SourceLineCatalog, DestLineCatalog: TSCSCatalog; ConnectionSide : Integer; TmpInterfPos: TSCSInterfPosition; begin Result := nil; LineCatalog := Nil; ConnectionSide := 0; LineCompon := isConnectedCable;//AInterf.ComponentOwner; if LineCompon <> nil then begin LineCatalog := LineCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := TOrthoLine(GetFigurebyCatalogID(LineCatalog.SCSID)); if LineFigure <> nil then begin if (TConnectorObject(LineFigure.JoinConnector1).JoinedConnectorsList.IndexOf(aPointObject) <> -1) or (TConnectorObject(LineFigure.JoinConnector1).ID = aPointObject.ID) then ConnectionSide := 1 else if (TConnectorObject(LineFigure.JoinConnector2).JoinedConnectorsList.IndexOf(aPointObject) <> -1) or (TConnectorObject(LineFigure.JoinConnector2).ID = aPointObject.ID) then ConnectionSide := 2; for j := 0 to LineCompon.Interfaces.Count - 1 do begin if TSCSInterface(LineCompon.Interfaces[j]).TypeI = itFunctional then if TSCSInterface(LineCompon.Interfaces[j]).Npp = AInterf.Npp then // вторая сторона идин х занята уже ...(если не обрыв кабеля) if TSCSInterface(LineCompon.Interfaces[j]).Side = ConnectionSide then if ((TSCSInterface(LineCompon.Interfaces[j]).IsBusy = biFalse) or (TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count = 0)) then begin Result := TSCSInterface(LineCompon.Interfaces[j]); break; end; end; end; end; end; end; Function DefineIDComponRel(ALineCompon, APointCompon: TSCSComponent): Integer; var TopCatalog: TSCSCatalog; begin Result := -1; begin TopCatalog := aLineCompon.GetTopParentCatalog; if TopCatalog <> nil then if TopCatalog is TSCSProject then Result := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1); end; //if IDComponRel = -1 then //IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); end; function GetTargetPointFigure: TFigure; var TempInterf: TSCSinterface; SCSCompon: TSCSComponent; SCSCatalog: TSCSCatalog; begin Result := nil; InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then SavedPointComponList := TList(InterFaceAccordanceList[1]); TempInterf := TSCSInterface(SavedPointComponList[0]); SCSCompon := TempInterf.ComponentOwner; if SCSCompon <> nil then SCSCatalog := SCSCompon.GetFirstParentCatalog; if SCSCatalog <> nil then Result := GetFigureByCatalogId(SCSCatalog.SCSID); InterFaceAccordanceList := nil; SavedPointComponList := nil; end; begin if SavedCableComponList.Count > 0 then begin WayList := nil; SelfLineConnectInfo := Nil; SelfConnector := nil; TargetConn := Nil; PassWayList := True; DisJoinComponList := nil; CanRestoreConnection := True; While CanRestoreconnection do begin CanRestoreConnection := False; SelfLineConnectInfo := nil; for i := 0 to SavedConnectionsList.Count - 1 do begin if ((TLineComponConnectionInfo(SavedConnectionsList[i]).ComponId = ACableCompon.ID) and (TLineComponConnectionInfo(SavedConnectionsList[i]).ComponSide = aSide)) then begin SelfLineConnectInfo := TLineComponConnectionInfo(SavedConnectionsList[i]); CanRestoreConnection := True; Break; //// BREAK ////; end; end; if (SelfLineConnectInfo <> nil) then begin if not SelfLineConnectInfo.PointToPointConnection then begin if SelfLineConnectInfo.ComponSide = 1 then SelfConnector := TConnectorObject(aLine.JoinConnector1) else if SelfLineConnectInfo.ComponSide = 2 then SelfConnector := TConnectorObject(aLine.JoinConnector2); if SelfConnector <> nil then begin // for i := 0 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); JoinedLineConnectInfo := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]); TargetCompon := nil; if SelfLineConnectInfo.isLineConnection then TargetCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if FirstCompon <> nil then begin // произошло разделение вертикали if TargetCompon = nil then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(JoinedLineConnectInfo.ComponCatalogID); end else if TargetCompon <> nil then TargetCatalog := TargetCompon.GetFirstParentCatalog; // линейное соединение (кабель -- кабель) { if TargetCompon.IsLine = biTrue then begin TargetCatalog := TargetCompon.GetFirstParentCatalog;} if TargetCatalog <> nil then begin TargetLine := GetFigureByCatalogID(TargetCatalog.SCSID); if TargetLine <> nil then begin TargetConn := Nil; if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin // линейноне подключение if JoinedLineConnectInfo.ComponSide = 1 then TargetConn := TConnectorObject(TOrthoLine(TargetLine).JoinConnector1) else if JoinedLineConnectInfo.ComponSide = 2 then TargetConn := TConnectorObject(TOrthoLine(TargetLine).JoinConnector2); end else if CheckFigureByClassName(TargetLine, CTConnectorObject) then begin // точечное подключение TargetPointfigure := TargetLine; if JoinedLineConnectInfo.ComponSide = 0 then begin TargetConn := TConnectorObject(TargetLine); end; end; if TargetConn <> nil then begin // если произошло разделение вертикали - найти коннектор от высоты подъема WayList := GetAllTraceInCAD(TFigure(SelfConnector), TFigure(TargetConn)); if WayList <> nil then begin // прокладка кабеля (только на райз или на вертикали) for j := 0 to WayList.Count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, CTOrthoLine) then begin if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := Nil; // вкинуть кабель на трассу NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False); // рассоединить добавленный кабель от всего, к чему подключился автоматом if NewCompon <> nil then NewCompon.DisJoinFromAll(false).Free; end; end; end; end; end; end; end; // FirstCompon := TargetCompon; // соединить кабели if WayList <> nil then begin if WayList.Count > 0 then begin //FirstCompon := aCableCompon; for j := 0 to WayList.count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := TargetCatalog.LastAddedComponent; if NewCompon <> nil then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; FirstCompon := NewCompon; NewCompon := Nil; end; end; end else begin //NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if NewCompon <> nil then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if SelfLineConnectInfo.ConnectedComponList.Count > 1 then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; end; break; end; end; end; // конечное соединение //NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if SelfLineConnectInfo.isLineConnection then begin NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if ((NewCompon <> nil) and (FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1)) then ConnectCableComponents(FirstCompon, NewCompon); end else begin if not SelfLineConnectInfo.isLineConnection then begin // Restore Connection // восстановить состояние соединения кабеля с точечными компонентами NewCompon := FirstCompon; // если коннектор упал на точечный объект, то кабель мог автоматом соединиться с // компонентами точечного, поэтому нужно их расконнектить до восстановления соединения TargetCatalog := NewCompon.GetFirstParentCatalog; if TargetCatalog <> nil then begin TargetLine := GetFigureByCatalogId(TargetCatalog.SCSID); if TargetLine <> nil then begin DisJoinSide := 0; if TConnectorObject(TOrthoLine(TargetLine).JoinConnector1).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then DisJoinSide := 1 else if TConnectorObject(TOrthoLine(TargetLine).JoinConnector2).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then DisJoinSide := 2; if DisJoinSide <> 0 then begin DisJoinComponList := TList.Create; for i := 0 to NewCompon.Interfaces.Count - 1 do begin if (NewCompon.Interfaces[i].TypeI = itFunctional) and (NewCompon.Interfaces[i].Side = DisJoinSide) then begin for j := 0 to NewCompon.Interfaces[i].ConnectedInterfaces.Count - 1 do begin if (TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner <> nil) and (DisJoinComponList.IndexOf(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner) = -1) then DisJoinComponList.Add(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner); end; end; end; for i := 0 to DisJoinComponList.Count - 1 do begin NewCompon.DisJoinFrom(TSCSComponent(DisJoinComponList[i])); end; end; FreeAndNil(DisJoinComponList); end; end; FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin i := 0; While (i <= (InterFaceAccordanceList.Count - 1)) do begin SavedLineComponList := TList(InterFaceAccordanceList[i]); SavedPointComponList := TList(InterFaceAccordanceList[i + 1]); for j := 0 to SavedLineComponList.Count - 1 do begin aTempInterf := TSCSInterface(SavedLineComponList[j]); ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure)); LineCompon := ALineInterFace.ComponentOwner; if ALineInterFace <> nil then begin for k := 0 to SavedPointComponList.Count - 1 do begin APointInterFace := TSCSInterface(SavedPointComponList[k]); PointCompon := APointInterFace.ComponentOwner; AInterfPositions1 := ALineInterFace.GetEmptyPositions; AInterfPositions2 := APointInterFace.GetEmptyPositions; // уравнять количество позиций для соединения if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then begin While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do begin l := AInterfPositions1.Positions.Count - 1; AInterfPositions1.Positions.Delete(l); end; AInterfPositions1.DefineKolvo; end else if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then begin While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do begin l := AInterfPositions2.Positions.Count - 1; AInterfPositions2.Positions.Delete(l); end; AInterfPositions2.DefineKolvo; end; ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon); // До того как соединить интерфейсы, нужно соединить сами компоненты if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then; FreeAndNil(TempInterfaces1); FreeAndNil(TempInterfaces2); end; if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then begin ptrConnection := LineCompon.GetConnectionByConnected(PointCompon); if ptrConnection <> nil then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); TempInterfaces1.Add(ALineInterFace); TempInterfaces2.Add(APointInterFace); InterfCount := AInterfPositions1.Kolvo; if InterfCount > AInterfPositions2.Kolvo then InterfCount := AInterfPositions2.Kolvo; TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace, InterfCount, InterfCount, ptrConnection.ID, cntUnion, AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2); TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1); end; end; end; end; end; SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); Inc(i,2); end; end; if InterFaceAccordanceList <> nil then begin InterFaceAccordanceList.clear; FreeAndNil(InterFaceAccordanceList); end; end; end; end else begin //NewCompon := aCableCompon;// F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if NewCompon <> nil then if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if SelfLineConnectInfo.ConnectedComponList.Count > 1 then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; end; WayList.Clear; FreeAndNil(WayList); end else begin // если соединение линейное if SelfLineConnectInfo.isLineConnection then begin // NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if NewCompon <> nil then if FirstCompon.JoinedComponents.IndexOf(NewCompon) = - 1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if SelfLineConnectInfo.ConnectedComponList.Count > 1 then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; end // если кабель был присобачен к компонентам точечного объекта - соединить как было else begin end; // end; end else begin if not SelfLineConnectInfo.isLineConnection then begin TargetPointFigure := TConnectorObject(GetFigureByCatalogId(JoinedLineConnectInfo.ComponId)); if TargetPointFigure <> nil then begin // если чистый коннектор и на нем объект -- получить его if (TConnectorObject(TargetPointFigure).ConnectorType = ct_clear) and (TConnectorObject(TargetPointFigure).JoinedConnectorsList.Count > 0) then TargetPointFigure := TFigure(TConnectorObject(TargetPointFigure).JoinedConnectorsList[0]); WayList := GetAllTraceInCAD(TFigure(SelfConnector), TFigure(TargetPointFigure)); if WayList <> nil then begin // прокладка кабеля (только на райз или на вертикали) for j := 0 to WayList.Count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, CTOrthoLine) then begin if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := Nil; // вкинуть кабель на трассу NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False); // рассоединить добавленный кабель от всего, к чему подключился автоматом if NewCompon <> nil then NewCompon.DisJoinFromAll(false).Free; end; end; end; end; // выполнить кабельное соединение по пути следования for j := 0 to WayList.count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := TargetCatalog.LastAddedComponent; if NewCompon <> nil then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; FirstCompon := NewCompon; NewCompon := Nil; end; end; end; end; end; end; // Restore Connection // восстановить состояние соединения кабеля с точечными компонентами NewCompon := FirstCompon; FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin i := 0; While (i <= (InterFaceAccordanceList.Count - 1)) do begin SavedLineComponList := TList(InterFaceAccordanceList[i]); SavedPointComponList := TList(InterFaceAccordanceList[i + 1]); for j := 0 to SavedLineComponList.Count - 1 do begin aTempInterf := TSCSInterface(SavedLineComponList[j]); ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure)); LineCompon := ALineInterFace.ComponentOwner; if ALineInterFace <> nil then begin for k := 0 to SavedPointComponList.Count - 1 do begin APointInterFace := TSCSInterface(SavedPointComponList[k]); PointCompon := APointInterFace.ComponentOwner; AInterfPositions1 := ALineInterFace.GetEmptyPositions; AInterfPositions2 := APointInterFace.GetEmptyPositions; // уравнять количество позиций для соединения if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then begin While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do begin l := AInterfPositions1.Positions.Count - 1; AInterfPositions1.Positions.Delete(l); end; AInterfPositions1.DefineKolvo; end else if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then begin While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do begin l := AInterfPositions2.Positions.Count - 1; AInterfPositions2.Positions.Delete(l); end; AInterfPositions2.DefineKolvo; end; ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon); // До того как соединить интерфейсы, нужно соединить сами компоненты if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then; FreeAndNil(TempInterfaces1); FreeAndNil(TempInterfaces2); end; if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then begin ptrConnection := LineCompon.GetConnectionByConnected(PointCompon); if ptrConnection <> nil then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); TempInterfaces1.Add(ALineInterFace); TempInterfaces2.Add(APointInterFace); InterfCount := AInterfPositions1.Kolvo; if InterfCount > AInterfPositions2.Kolvo then InterfCount := AInterfPositions2.Kolvo; TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace, InterfCount, InterfCount, ptrConnection.ID, cntUnion, AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2); TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1); end; end; end; end; end; SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); Inc(i,2); end; end; if InterFaceAccordanceList <> nil then begin InterFaceAccordanceList.clear; FreeAndNil(InterFaceAccordanceList); end; end; end; end; end; end; end; SavedConnectionsList.Remove(SelfLineConnectInfo); FreeAndNil(SelfLineConnectInfo); end // соединение типа точка - точка else begin if SelfLineConnectInfo.ComponSide = 1 then SelfConnector := TConnectorObject(aLine.JoinConnector1) else if SelfLineConnectInfo.ComponSide = 2 then SelfConnector := TConnectorObject(aLine.JoinConnector2); if SelfConnector <> nil then begin WayList := GetAllTraceInCAD(TFigure(SelfLineConnectInfo.FirstPointObject), TFigure(SelfLineConnectInfo.LastPointObject)); //FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); JoinedLineConnectInfo := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]); TargetCompon := nil; // произошло разделение вертикали if TargetCompon = nil then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(SelfLineConnectInfo.LastPointObject.ID); end else if TargetCompon <> nil then TargetCatalog := TargetCompon.GetFirstParentCatalog; if TargetCatalog <> nil then begin TargetConn := SelfLineConnectInfo.LastPointObject; if TargetConn <> nil then begin if WayList <> nil then begin // прокладка кабеля (только на райз или на вертикали) // только первый раз if aSide = 1 then begin for j := 0 to WayList.Count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, CTOrthoLine) then begin if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := Nil; // вкинуть кабель на трассу NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False); // рассоединить добавленный кабель от всего, к чему подключился автоматом if NewCompon <> nil then NewCompon.DisJoinFromAll(false).Free; end; end; end; end; end; // первый кабель на пути FirstCompon := nil; for j := 0 to WayList.Count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, CTOrthoLine) then begin if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin FirstCompon := TargetCatalog.LastAddedComponent; Break; //// BREAK //// -- нашли end; end; end; end; end; if FirstCompon <> nil then // первый кабель на пути begin // соединить кабели if WayList <> nil then begin if aSide = 1 then begin for j := 0 to WayList.count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := TargetCatalog.LastAddedComponent; if NewCompon <> nil then begin if (NewCompon.ID <> FirstCompon.ID) then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; FirstCompon := NewCompon; end; NewCompon := Nil; end; end; end end; end; end; // берем последний кабель for j := 0 to WayList.count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then NewCompon := TargetCatalog.LastAddedComponent; end; end; end; // восстановить состояние соединения кабеля с точечными компонентами // если коннектор упал на точечный объект, то кабель мог автоматом соединиться с // компонентами точечного, поэтому нужно их расконнектить до восстановления соединения TargetCatalog := NewCompon.GetFirstParentCatalog; if TargetCatalog <> nil then begin TargetLine := GetFigureByCatalogId(TargetCatalog.SCSID); if TargetLine <> nil then begin DisJoinSide := 0; if TConnectorObject(TOrthoLine(TargetLine).JoinConnector1).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then DisJoinSide := 1 else if TConnectorObject(TOrthoLine(TargetLine).JoinConnector2).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then DisJoinSide := 2; if DisJoinSide <> 0 then begin DisJoinComponList := TList.Create; for i := 0 to NewCompon.Interfaces.Count - 1 do begin if (NewCompon.Interfaces[i].TypeI = itFunctional) and (NewCompon.Interfaces[i].Side = DisJoinSide) then begin for j := 0 to NewCompon.Interfaces[i].ConnectedInterfaces.Count - 1 do begin if (TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner <> nil) and (DisJoinComponList.IndexOf(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner) = -1) then DisJoinComponList.Add(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner); end; end; end; for i := 0 to DisJoinComponList.Count - 1 do begin NewCompon.DisJoinFrom(TSCSComponent(DisJoinComponList[i])); end; end; FreeAndNil(DisJoinComponList); end; end; FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin i := 0; While (i <= (InterFaceAccordanceList.Count - 1)) do begin SavedLineComponList := TList(InterFaceAccordanceList[i]); SavedPointComponList := TList(InterFaceAccordanceList[i + 1]); for j := 0 to SavedLineComponList.Count - 1 do begin aTempInterf := TSCSInterface(SavedLineComponList[j]); // ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure)); ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(SelfLineConnectInfo.LastPointObject)); if ALineInterFace <> nil then begin LineCompon := ALineInterFace.ComponentOwner; for k := 0 to SavedPointComponList.Count - 1 do begin APointInterFace := TSCSInterface(SavedPointComponList[k]); PointCompon := APointInterFace.ComponentOwner; AInterfPositions1 := ALineInterFace.GetEmptyPositions; AInterfPositions2 := APointInterFace.GetEmptyPositions; // уравнять количество позиций для соединения if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then begin While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do begin l := AInterfPositions1.Positions.Count - 1; AInterfPositions1.Positions.Delete(l); end; AInterfPositions1.DefineKolvo; end else if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then begin While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do begin l := AInterfPositions2.Positions.Count - 1; AInterfPositions2.Positions.Delete(l); end; AInterfPositions2.DefineKolvo; end; ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon); // До того как соединить интерфейсы, нужно соединить сами компоненты if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then; FreeAndNil(TempInterfaces1); FreeAndNil(TempInterfaces2); end; if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then begin ptrConnection := LineCompon.GetConnectionByConnected(PointCompon); if ptrConnection <> nil then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); TempInterfaces1.Add(ALineInterFace); TempInterfaces2.Add(APointInterFace); InterfCount := AInterfPositions1.Kolvo; if InterfCount > AInterfPositions2.Kolvo then InterfCount := AInterfPositions2.Kolvo; TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace, InterfCount, InterfCount, ptrConnection.ID, cntUnion, AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2); TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1); end; end; end; end; end; SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); Inc(i,2); end; end; if InterFaceAccordanceList <> nil then begin InterFaceAccordanceList.clear; FreeAndNil(InterFaceAccordanceList); end; WayList.Clear; FreeAndNil(WayList); end; end; end; end; end; SavedConnectionsList.Remove(SelfLineConnectInfo); if SelfLineConnectInfo <> nil then FreeAndNil(SelfLineConnectInfo); end; end; end; end; end; Procedure CheckRaiseVLines; var i, j: Integer; begin for i := 0 to TConnectorObject(aObject).JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject((aObject).JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin // если есть райз - вертикалей, по определению, НЕТ if TOrthoLine(TConnectorObject((aObject).JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then begin HasRaiseLine := True; RaiseLine := TOrthoLine(TConnectorObject((aObject).JoinedConnectorsList[i]).JoinedOrtholinesList[j]); // Break; //// BREAK ////; end else // если есть вертикали - райза не будет if TOrthoLine(TConnectorObject((aObject).JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin HasVLine := True; // Break; //// BREAK //// end // просто трасса else HasHorizontalTraces := True; end; end; end; function GetConnectedLines : TList; var i, j: Integer; begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if ((not TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown) and (not TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical)) then if TraceList.IndexOf(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then TraceList.Add(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); end; end; end; // если попадем на объект - вернуть этот самый объект // (только в том случае, если объект связан с тем, который поднимаем трассами или трассой, // просто отдельно "висящий объект" не воспринимаем) function GetObjectToSnap: TConnectorObject; var i, j, k: Integer; JoinedLine: TOrthoLine; JoinedConn, LineConn, NextConn: TConnectorObject; CanLook: Boolean; PassedList: TList; begin Result := nil; if (HasVLine or HasRaiseLine) and (WayList.Count > 0) then begin JoinedLine := TOrthoLine(WayList[WayList.Count - 1]); JoinedConn := nil; if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], aZ) = 0 then JoinedConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], aZ) = 0 then JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); if JoinedConn <> nil then begin if JoinedConn.JoinedConnectorsList.Count > 0 then // точечный объект на соединителе Result := TConnectorObject(JoinedConn.JoinedConnectorsList[0]); end; end; end; // строим путь объекта (трассы, которые пройдем в результате спуска/подъема) Procedure LookUPDOWN; var i: Integer; VLineConn, TempConn: TConnectorObject; VLine: TOrthoLine; VLineFound: boolean; JoinedConn: TConnectorObject; RaiseLineFound: Boolean; CanLook: Boolean; function LookForVLine(aConn: TConnectorObject): TConnectorObject; var i, j: Integer; TempConnector: TConnectorObject; JoinedLine: TOrthoLine; HighLineConn, LowLineConn: TConnectorObject; begin Result := nil; if DirectionUP then begin for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin // если вертикаль JoinedLine := TOrthoLine(aConn.JoinedOrtholinesList[i]); if JoinedLine.FIsVertical then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор вертикали if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector2); if ((CompareValue(HighLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = 1) and ((CompareValue(HighLineConn.ActualZOrder[1], aZ) = -1) or (CompareValue(HighLineConn.ActualZOrder[1], aZ) = 0))) then begin if HighLineConn.JoinedConnectorsList.Count > 0 then Result := TConnectorObject(HighLineConn.JoinedConnectorsList[0]) else Result := HighLineConn; if WayList.IndexOf(JoinedLine) = -1 then WayList.Add(JoinedLine); Exit; end // если попадем на вертикаль else if ((CompareValue(HighLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = 1) and ((CompareValue(HighLineConn.ActualZOrder[1], aZ) = -1) or (CompareValue(HighLineConn.ActualZOrder[1], aZ) = 1))) then begin if WayList.IndexOf(JoinedLine) = -1 then WayList.Add(JoinedLine); Exit; end; end; end else // если райз if JoinedLine.FIsRaiseUpDown then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор райза if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = 1 then HighLineConn := TConnectorObject(JoinedLine.JoinConnector2); if CompareValue(HighLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = 1 then WayList.Add(JoinedLine); Exit; // по-любому, т.к. вертикалей в таком случае не будет end; end; end; end else if DirectionDown then begin for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin // если вертикаль JoinedLine := TOrthoLine(aConn.JoinedOrtholinesList[i]); if JoinedLine.FIsVertical then begin if WayList.IndexOf(JoinedLine) = -1 then begin // нижний коннектор вертикали if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector2); if ((CompareValue(LowLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = -1) and ((CompareValue(LowLineConn.ActualZOrder[1], aZ) = 1) or (CompareValue(LowLineConn.ActualZOrder[1], aZ) = 0))) then begin if LowLineConn.JoinedConnectorsList.Count > 0 then Result := TConnectorObject(LowLineConn.JoinedConnectorsList[0]) else Result := LowLineConn; if WayList.IndexOf(JoinedLine) = -1 then WayList.Add(JoinedLine); Exit; end else // попали на вертикаль if ((CompareValue(LowLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = -1) and ((CompareValue(LowLineConn.ActualZOrder[1], aZ) = 1) or (CompareValue(LowLineConn.ActualZOrder[1], aZ) = -1))) then begin if WayList.IndexOf(JoinedLine) = -1 then WayList.Add(JoinedLine); Exit; end; end; end else // если райз if JoinedLine.FIsRaiseUpDown then begin if WayList.IndexOf(JoinedLine) = -1 then begin // верхний коннектор райза if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector1) else if CompareValue(TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1]) = -1 then LowLineConn := TConnectorObject(JoinedLine.JoinConnector2); if CompareValue(LowLineConn.ActualZOrder[1], aObject.ActualZOrder[1]) = -1 then WayList.Add(JoinedLine); Exit; // по-любому, т.к. вертикалей в таком случае не будет end; end; end; end; end; begin WayList.Clear; JoinedConn := aObject; CanLook := True; While CanLook do begin CanLook := False; if JoinedConn.ConnectorType = ct_NB then begin for i := 0 to JoinedConn.JoinedConnectorsList.Count - 1 do begin TempConn := TConnectorObject(JoinedConn.JoinedConnectorsList[i]); TempConn := LookForVLine(TempConn); if TempConn <> nil then begin JoinedConn := TempConn; TempConn := nil; CanLook := True; Break; //// BREAK ////; end; if RaiseLineFound then Exit; end; end else if JoinedConn.ConnectorType = ct_Clear then begin JoinedConn := LookForVLine(JoinedConn); if JoinedConn <> nil then CanLook := True; end; end; end; Function CheckDeleteVLine(aLine: TOrthoLine): Boolean; var canDelLine: Boolean; LineConn: TConnectorObject; begin Result := False; if not aLine.Deleted then begin if aLine.FisVertical then begin CanDelLine := False; if ((TConnectorObject(aLine.JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(aLine.JoinConnector1).JoinedOrtholinesList.Count = 1)) then CanDelLine := True else if ((TConnectorObject(aLine.JoinConnector2).JoinedConnectorsList.Count = 0) and (TConnectorObject(aLine.JoinConnector2).JoinedOrtholinesList.Count = 1)) then CanDelLine := True; if CanDelLine then begin // Сбросить подключение на коннекторах, если нужно LineConn := TConnectorObject(aLine.JoinConnector1); if LineConn.JoinedOrthoLinesList.Count > 1 then begin LineConn.JoinedOrtholinesList.Remove(aLine); aLine.JoinConnector1 := Nil; end; LineConn := TConnectorObject(aLine.JoinConnector2); if LineConn.JoinedOrthoLinesList.Count > 1 then begin LineConn.JoinedOrtholinesList.Remove(aLine); aLine.JoinConnector2 := Nil; end; // удалить трассу aLine.delete; Result := True; end; end; end; end; // будет ли соединение типа точка-точка Function CheckPointToPointConnection(aCableCompon: TSCSComponent): Boolean; var i, j : Integer; JoinedCompon: TSCSComponent; CableCatalog, JoinedCatalog: TSCSCatalog; JoinedFigure: TFigure; CableFigure: TOrthoLine; ConnectedCompon : TSCSComponent; CableInterface: TSCSInterface; CableInterfPos: TSCSInterfPosition; ObjectSide : Integer; // сторона подключения кабеля к поднимаеиому объекту NextSidePointconenction: Boolean; // есть ли подключение кабеля на другой стороне isPointConnectionbySide1, isPointConnectionBySide2: Boolean; PassedCableList: TList; // путь кабеля, чтобы не вернуться обратно CanSeekCableConnection: Boolean; NextPointComponFound: Boolean; currCableCatalog: TSCSCatalog; currCableFigure: TFigure; begin Result := False; ConnectedCompon := nil; ObjectSide := 0; isPointConnectionbySide1 := False; isPointConnectionBySide2 := False; NextPointComponFound:= False; CableFigure := nil; currCableCatalog := nil; CableCatalog := nil; currCableFigure := nil; if aCableCompon <> nil then begin currCableCatalog := aCableCompon.GetFirstParentCatalog; if currCableCatalog <> nil then begin currCableFigure := GetFigureByCatalogId(currCableCatalog.SCSID); end; end; // условие - для предотвращения записи соединения типа поинт-ту-поинт на невертикалях и нерайзах if ((currCableFigure <> nil) and (CheckFigureByClassName(currCableFigure, cTOrthoLine)) and (TOrthoLine(currCableFigure).FIsRaiseUpDown or TOrthoLine(currCableFigure).FIsVertical)) then begin for i := 0 to aCableCompon.Interfaces.Count - 1 do begin CableInterface := TSCSInterface(aCableCompon.Interfaces[i]); // интерф. кабеля с заданной стороны if (CableInterface.TypeI = itFunctional) and (CableInterface.Side = 1) and ((CableInterface.IsBusy = biTrue) or (CableInterface.BusyPositions.Count > 0)) then begin // будет ли точечное подключение на кабеле со стороны 1 for j := 0 to CableInterface.BusyPositions.Count - 1 do begin CableInterfPos := TSCSInterfPosition(CableInterface.BusyPositions[j]); // занятая позиция интерфейса CableInterfPos := CableInterfPos.GetConnectedPos; // подключенная к ней похиция интерфейса if CableInterfPos <> nil then begin ConnectedCompon := CableInterfPos.InterfOwner.ComponentOwner; // если есть точечное соединение со тороны 1 if ConnectedCompon.IsLine = biFalse then begin isPointConnectionbySide1 := True; JoinedCatalog := ConnectedCompon.GetFirstParentCatalog; if JoinedCatalog <> nil then begin JoinedFigure := GetFigureByCatalogId(JoinedCatalog.SCSID); if (JoinedFigure <> nil) and (JoinedFigure.ID = aObject.ID) then ObjectSide := 1;// сторона подключения кабеля к поднимаеиоиу объекту Break; //// BREAK ////; end; end; end; end; if isPointConnectionbySide1 then Break; //// BREAK ////; end; end; for i := 0 to aCableCompon.Interfaces.Count - 1 do begin CableInterface := TSCSInterface(aCableCompon.Interfaces[i]); // интерф. кабеля с заданной стороны if (CableInterface.TypeI = itFunctional) and (CableInterface.Side = 2) and ((CableInterface.IsBusy = biTrue) or (CableInterface.BusyPositions.Count > 0)) then begin // будет ли точечное подключение на кабеле со стороны 2 for j := 0 to CableInterface.BusyPositions.Count - 1 do begin CableInterfPos := TSCSInterfPosition(CableInterface.BusyPositions[j]); // занятая позиция интерфейса CableInterfPos := CableInterfPos.GetConnectedPos; // подключенная к ней похиция интерфейса if CableInterfPos <> nil then begin ConnectedCompon := CableInterfPos.InterfOwner.ComponentOwner; // если есть точечное соединение со тороны 1 if ConnectedCompon.IsLine = biFalse then begin isPointConnectionbySide2 := True; JoinedCatalog := ConnectedCompon.GetFirstParentCatalog; if JoinedCatalog <> nil then begin JoinedFigure := GetFigureByCatalogId(JoinedCatalog.SCSID); if (JoinedFigure <> nil) and (JoinedFigure.ID = aObject.ID) then ObjectSide := 2;// сторона подключения кабеля к поднимаеиоиу объекту Break; //// BREAK ////; end; end; end; end; if isPointConnectionBySide2 then Break; //// BREAK //// end; end; if isPointConnectionbySide1 and isPointConnectionBySide2 then begin Result := True; Exit; end; // если кабель подключен к точечному только с одной стороны, // возможно, он подключен другим концом где-то выше или ниже (будем искать) // если к точечному не подключен вообще -- выходим нах if ObjectSide = 0 then // кабель, скорее всего, проходит мимо или просто "висит" Exit; // выставить для противоположной стороны кабеля { if ObjectSide = 1 then isPointConnectionbySide1 := 2 else if ObjectSide = 2 then isPointConnectionbySide1 := 1;} // сюда попадут только проверки кабелей на вертикалях, т.к. райз все равно один (т.е райзов здесь не будет) PassedCableList := TList.Create; PassedCableList.Add(aCableCompon); ConnectedCompon := aCableCompon; NextPointComponFound := False; CanSeekCableConnection := True; While CanSeekCableConnection do begin CanSeekCableConnection := False; for i := 0 to ConnectedCompon.JoinedComponents.Count - 1 do begin if (IsCableComponent(TSCSComponent(ConnectedCompon.JoinedComponents[i]))) then begin JoinedCompon := TSCSComponent(ConnectedCompon.JoinedComponents[i]); if PassedCableList.IndexOf(JoinedCompon) = -1 then begin JoinedCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedCatalog <> nil then begin JoinedFigure := GetFigureByCatalogId(JoinedCatalog.SCSID); if JoinedFigure <> nil then begin if CheckFigureByClassName(JoinedFigure, cTOrthoLine) then begin if TOrthoLine(JoinedFigure).FisVertical then begin for j := 0 to JoinedCompon.JoinedComponents.Count - 1 do begin // есть точечное подключение по вертикали if TSCSComponent(JoinedCompon.JoinedComponents[j]).IsLine = biFalse then begin Result := True; FreeAndNil(PassedCableList); Exit; end; if TSCSComponent(JoinedCompon.JoinedComponents[j]).IsLine = biTrue then begin JoinedCatalog := TSCSComponent(JoinedCompon.JoinedComponents[j]).GetFirstParentCatalog; if JoinedCatalog <> nil then begin JoinedFigure := GetFigureByCatalogId(JoinedCatalog.SCSID); if JoinedFigure <> nil then begin if CheckFigureByClassName(JoinedFigure, cTOrthoLine) then if TOrthoLine(JoinedFigure).FIsVertical then begin CanSeekCableConnection := True; PassedCableList.Add(JoinedCompon); ConnectedCompon := JoinedCompon; Break; //// BREAK ////; end; end; end; end; end; end // если не вертикаль - нах else begin FreeAndNil(PassedCableList); Exit; end; end; end; end; end; end; if CanSeekCableConnection then Break; //// BREAK ////; end; end; end; end; Procedure SavePointToPointConnection(aCableCompon: TSCSComponent); var i, j ,k: Integer; Interf: TSCSInterFace; WayList, PointToPointList: TList; CableComponCatalog, LastCableComponCatalog: TSCSCatalog; LastCableCompon: TSCSComponent; PointCatalog, ObjectCatalog: TSCSCatalog; PointFigure, NextPointFigure: TFigure; CableLine, LastCableLine, TempLine: TOrthoLine; CableConnSide, LastCableConnSide, TempConnSide: Integer; InterfPos: TSCSInterfPosition; PointCompon: TSCSComponent; CanLook: Boolean; Procedure SaveConnectionOnPointObject(aPointObject: TConnectorObject; aPointCatalog: TSCSCatalog; aJoinedLineCompon: TSCSComponent; ConnectionSide: Integer); var i, j, k, l, m: Integer; PointJoinedLineCatalog : TSCSCatalog; PointComponent, LineComponent: TSCSComponent; LineJoinedComponList: TList; LineInterface: TSCSInterface; aCableComponInterface, ALineInterFace: TSCSInterface; APointInterfID: Integer; InterfPosition, JoinedPosition: TSCSInterfPosition; begin if (aPointCatalog <> nil) then begin InterFaceAccordanceList := TList.Create; if IsCableComponent(aJoinedLineCompon) then // так правильнее -- для всех кабелей // begin if CheckJoinedComponToComponFromObject(aJoinedLineCompon, aPointCatalog) then begin for k := 0 to aJoinedLineCompon.Interfaces.count - 1 do begin if (aJoinedLineCompon.Interfaces[k].TypeI = itFunctional) and (aJoinedLineCompon.Interfaces[k].Side = ConnectionSide) and ((aJoinedLineCompon.Interfaces[k].IsBusy = biTrue) or (aJoinedLineCompon.Interfaces[k].BusyPositions.Count > 0)) then begin SavedLineComponList := TList.Create; SavedPointComponList := TList.Create; ALineInterFace := TSCSInterFace(aJoinedLineCompon.Interfaces.Items[k]); { if SavedLineComponList.IndexOf(LineCompon.Interfaces.Items[k]) = -1 then SavedLineComponList.Add(TSCSInterFace(LineCompon.Interfaces.Items[k]));} if aCableCompon.Id = aJoinedLineCompon.id then begin if SavedLineComponList.IndexOf(ALineInterFace) = -1 then SavedLineComponList.Add(TSCSInterface(ALineInterFace)); end else begin aCableComponInterFace := aCableCompon.Interfaces[k]; if SavedLineComponList.IndexOf(aCableComponInterFace) = -1 then SavedLineComponList.Add(TSCSInterface(aCableComponInterFace)); // aTempInterf := TSCSInterface(SavedLineComponList[l]); end; APointInterfID := -1; for l := 0 to ALineInterFace.BusyPositions.Count - 1 do begin InterfPosition := ALineInterFace.BusyPositions[l]; JoinedPosition := InterfPosition.GetConnectedPos; if JoinedPosition <> nil then begin if JoinedPosition.InterfOwner <> nil then begin if SavedPointComponList.IndexOf(JoinedPosition.InterfOwner) = -1 then SavedPointComponList.Add(TSCSInterFace(JoinedPosition.InterfOwner)); end; end; end; if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then begin InterFaceAccordanceList.Add(SavedLineComponList); InterFaceAccordanceList.Add(SavedPointComponList); end else begin SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); end; end; end; end; end; if InterFaceAccordanceList.Count > 0 then begin if SavedCableComponList.IndexOf(aCableCompon) = -1 then SavedCableComponList.Add(aCableCompon); // состояние соединения кабеля на точечном объекте SelfLineConnectInfo := TLineComponConnectionInfo.Create(True); SelfLineConnectInfo.ComponId := aCableCompon.ID;//AJoinedLineCompon.ID; SelfLineConnectInfo.ComponSide := ConnectionSide; SelfLineConnectInfo.isLineConnection := False; SelfLineConnectInfo.PointToPointConnection := True; if aPointObject.ID = aObject.Id then begin SelfLineConnectInfo.FirstPointObject := TConnectorObject(PointFigure); if ObjectToSnap = nil then SelfLineConnectInfo.LastPointObject := aObject else // если попадаем на другой объект SelfLineConnectInfo.LastPointObject := ObjectToSnap; end else begin if ObjectToSnap = nil then SelfLineConnectInfo.FirstPointObject := aObject else // если попадаем на другой объект SelfLineConnectInfo.FirstPointObject := ObjectToSnap; SelfLineConnectInfo.LastPointObject := TConnectorObject(PointFigure); end; JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); if ObjectToSnap = nil then JoinedLineConnectInfo.ComponCatalogID := APointCatalog.ID else // если попадаем на другой компонент, то каталог назначения для поинта поменяется JoinedLineConnectInfo.ComponCatalogID := TSCSCatalog(F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ObjectToSnap.ID)).ID; JoinedLineConnectInfo.ComponSide := 0; JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); //SavedLineConnectionsList.Add(SelfLineConnectInfo); SavedConnectionsList.Add(SelfLineConnectInfo); end else FreeAndNil(InterFaceAccordanceList); end; // сбросить соединения линейного с точечными на заданной стороне LineJoinedComponList := TList.Create; for i := 0 to aJoinedLineCompon.Interfaces.Count - 1 do begin LineInterface := TSCSInterface(aJoinedLineCompon.Interfaces[i]); if (LineInterface.TypeI = itFunctional) and (LineInterface.Side = ConnectionSide) then begin for j := 0 to LineInterface.ConnectedInterfaces.Count - 1 do if LineJoinedComponList.IndexOf(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)) = -1 then LineJoinedComponList.Add(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)); end; end; for i := 0 to LineJoinedComponList.Count - 1 do begin aJoinedLineCompon.DisJoinFrom(TSCSComponent(LineJoinedComponList[i])); end; FreeAndNil(LineJoinedComponList); // end; begin WayList := nil; PointToPointList := nil; if ObjectToSnap <> nil then PointToPointList := GetAllTraceInCAD(TFigure(ObjectToSnap), TFigure(aObject)); CableComponCatalog := aCableCompon.GetFirstParentCatalog; if CableComponCatalog <> nil then begin CableLine := TOrthoLine(GetFigureByCatalogId(CableComponCatalog.SCSID)); if (CableLine.FIsVertical or CableLine.FIsRaiseUpDown) then begin // если поинт ту поинт - кабель нах if ComponToDeleteList.IndexOf(aCableCompon) = -1 then ComponToDeleteList.Add(aCableCompon); end; // если кабель лежит на пути попадания объекта в объект - нечего записывать, просто потом кабель удалить if PointToPointList <> nil then begin if PointToPointList.IndexOf(CableLine) <> - 1 then begin // кабель -- в список на удаление for i := 0 to PointToPointList.Count - 1 do begin if CheckFigureByClassName(TFigure(PointToPointList[i]), cTOrthoLine) then begin LastCableComponCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(PointToPointList[i]).ID); if LastCableComponCatalog <> nil then begin for j := 0 to LastCableComponCatalog.ComponentReferences.Count - 1 do begin if IsCableComponent(TSCSComponent(LastCableComponCatalog.ComponentReferences[j])) then if TSCSComponent(LastCableComponCatalog.ComponentReferences[j]).Whole_ID = aCableCompon.Whole_ID then if ComponToDeleteList.IndexOf(LastCableComponCatalog.ComponentReferences[j]) = -1 then begin ComponToDeleteList.Add(LastCableComponCatalog.ComponentReferences[j]); Break; //// BREAK //// end; end; end; end; end; FreeAndNil(PointToPointList); Exit; end; end; if CableLine <> nil then begin CableConnSide := 0; // сторона подключения кабеля к точечному if TConnectorObject(CableLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then CableConnSide := 1 else if TConnectorObject(CableLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then CableConnSide := 2; if CableConnSide <> 0 then begin PointCompon := nil; LastCableConnSide := 0; // смотрим, есть ли точечный с другой стороны for i := 0 to aCableCompon.Interfaces.Count - 1 do begin if ((TSCSInterface(aCableCompon.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(aCableCompon.Interfaces[i]).Side <> CableConnSide) and ((TSCSInterface(aCableCompon.Interfaces[i]).IsBusy = biTrue) or (TSCSInterface(aCableCompon.Interfaces[i]).BusyPositions.Count > 0))) then begin PointCompon := nil; for j := 0 to TSCSInterface(aCableCompon.Interfaces[i]).BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(TSCSInterface(aCableCompon.Interfaces[i]).BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin PointCompon := InterfPos.InterfOwner.ComponentOwner; if (PointCompon <> nil) and (PointCompon.IsLine = biFalse) then Break; //// BREAK ////; end; end; end; if PointCompon <> nil then Break; //// BREAK //// end; // есди с другой стороны кабеля -- сразу точечный объект LastCableCompon := aCableCompon; if PointCompon <> nil then begin if CableConnSide = 1 then LastCableConnSide := 2 else if CableConnSide = 2 then LastCableConnSide := 1; end else begin // если с другой стороны точечного нет - поищем // здесь смотрим исключительно вертикальные трассы, т.к. для райза уже бы нашлось CanLook := True; WayList := TList.Create; TempLine := nil; PointCompon := nil; while CanLook do begin CanLook := False; WayList.Add(LastCableCompon); for i := 0 to LastCableCompon.JoinedComponents.Count - 1 do begin if (IsCableComponent(TSCSComponent(LastCableCompon.JoinedComponents[i])) and (WayList.IndexOf(TSCSComponent(LastCableCompon.JoinedComponents[i])) = -1)) then begin LastCableComponCatalog := TSCSComponent(LastCableCompon.JoinedComponents[i]).GetFirstParentCatalog; if LastCableComponCatalog <> nil then begin LastCableLine := nil; LastCableLine := TOrthoLine(GetFigureByCatalogId(LastCableComponCatalog.SCSID)); // только по вертикали if ((LastCableLine <> nil) and (LastCableLine.FIsVertical)) then begin LastCableCompon := TSCSComponent(LastCableCompon.JoinedComponents[i]); if ComponToDeleteList.IndexOf(LastCableCompon) = -1 then ComponToDeleteList.Add(LastCableCompon); CanLook := True; Break; //// BREAK ////; end; end; end; end; end; // если дошли до конца -- смотрим точечный и сторону подключения, чтобы записать образец подключения if LastCableCompon.ID <> aCableCompon.ID then begin for i := 0 to LastCableCompon.Interfaces.Count - 1 do begin if ((TSCSInterface(LastCableCompon.Interfaces[i]).TypeI = itFunctional) and ((TSCSInterface(LastCableCompon.Interfaces[i]).IsBusy = biTrue) or (TSCSInterface(LastCableCompon.Interfaces[i]).BusyPositions.Count > 0))) then begin for j := 0 to TSCSInterface(LastCableCompon.Interfaces[i]).BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(TSCSInterface(LastCableCompon.Interfaces[i]).BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin if InterfPos.InterfOwner.ComponentOwner.IsLine = biFalse then begin LastCableConnSide := TSCSInterface(LastCableCompon.Interfaces[i]).Side; PointCompon := InterfPos.InterfOwner.ComponentOwner; Break; //// BREAK ////; end; end; end; end; if LastCableConnSide <> 0 then Break; //// BREAK //// end; end; end; // сохранить соединения с обеих сторон if ((CableConnSide <> 0) and (LastCableConnSide <> 0)) then begin ObjectCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aObject.Id); PointCatalog := PointCompon.GetFirstParentCatalog; PointFigure := Nil; if (PointCatalog <> nil) then PointFigure := GetFigureByCatalogId(PointCatalog.SCSID); if ((PointFigure <> nil) and (ObjectCatalog <> nil)) then begin SaveConnectionOnPointObject(aObject, ObjectCatalog, aCableCompon, CableConnSide); SaveConnectionOnPointObject(TConnectorObject(PointFigure), PointCatalog, LastCableCompon, LastCableConnSide); end; end; end; end; end; if WayList <> nil then FreeAndNil(WayList); end; Procedure CheckDeleteVLines; var i, j: Integer; LinesList: TList; CurrObject: TConnectorObject; CurrConn: TConnectorObject; currVLine, currVLine1, currVLine2: TOrthoLine; CanLook: Boolean; CanDelVLine: Boolean; OutCounter: Integer; begin LinesList := Nil; //определяем конечный объект после перемещения точечного if ((ObjectToSnap = nil) or ((ObjectToSnap <> nil) and (TConnectorObject(ObjectToSnap).ConnectorType = ct_Clear))) then CurrObject := aObject else if (ObjectToSnap <> nil) then CurrObject := ObjectToSnap; // ищем вертикали (все по вертикали в связи с данным объектом) currVLine1 := Nil; CurrVLine2 := nil; for i := 0 to CurrObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(CurrObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(CurrObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FisVertical then begin if currVLine1 = nil then begin currVLine1 := TOrthoLine(TConnectorObject(CurrObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); // just checking if (currVLine1.JoinConnector1 = nil) or TConnectorObject(currVLine1.JoinConnector1).Deleted or (currVLine1.JoinConnector2 = nil) or TConnectorObject(currVLine1.JoinConnector2).Deleted then currVLine1 := nil; end else begin currVLine2 := TOrthoLine(TConnectorObject(CurrObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); // just checking if (currVLine2.JoinConnector1 = nil) or TConnectorObject(currVLine2.JoinConnector1).Deleted or (currVLine2.JoinConnector2 = nil) or TConnectorObject(currVLine2.JoinConnector2).Deleted then currVLine2 := nil; if currVLine2 <> nil then begin if ((currVLine1.JoinConnector1.ID = currVLine2.JoinConnector1.ID) and (currVLine1.JoinConnector2.ID = currVLine2.JoinConnector2.ID)) or ((currVLine1.JoinConnector1.ID = currVLine2.JoinConnector2.ID) and (currVLine1.JoinConnector2.ID = currVLine2.JoinConnector1.ID)) then begin // LOG AddExceptionToLog('OrthoLines with indexes '+ Inttostr(currVLine1.FIndex) + ' and ' + Inttostr(currVLine2.FIndex)+ 'have the same JoinConnectors !!!'); CurrVLine2 := nil; end; end end; end; end; if currVLine2 <> nil then Break; //// BREAK //// end; // если есть вертикали -- ищем все, которые найдем if currVLine1 <> nil then begin LinesList := TList.Create; LinesList.Add(currVLine1); CurrConn := nil; // второй конец вертикали, чтобы посмотреть оттуда { if TConnectorObject(currVLine1.JoinConnector1).JoinedConnectorsList.IndexOf(CurrObject) <> -1 then CurrConn := TConnectorObject(currVLine1.JoinConnector2) else if TConnectorObject(currVLine1.JoinConnector2).JoinedConnectorsList.IndexOf(CurrObject) <> -1 then CurrConn := TConnectorObject(currVLine1.JoinConnector1); } if TConnectorObject(currVLine1.JoinConnector1).JoinedConnectorsList.IndexOf(CurrObject) = -1 then CurrConn := TConnectorObject(currVLine1.JoinConnector1) else if TConnectorObject(currVLine1.JoinConnector2).JoinedConnectorsList.IndexOf(CurrObject) = -1 then CurrConn := TConnectorObject(currVLine1.JoinConnector2); if ((CurrConn <> nil) and (not CurrConn.deleted)) then begin // если на объекте if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); currVLine := currVLine1; CanLook := True; OutCounter := 0; While (Canlook and (OutCounter < 50)) do begin Inc(OutCounter); if OutCounter = 50 then AddExceptionToLog('SCSObjectProp.CheckDeleteVLines LOOP EXIT ON COUNTER !!! ' ); canLook := False; if CurrConn.ConnectorType = ct_clear then begin for i := 0 to CurrConn.JoinedOrtholinesList.Count - 1 do begin // нашли вертикаль if (TOrthoLine(CurrConn.JoinedOrtholinesList[i]).FIsVertical and (TOrthoLine(CurrConn.JoinedOrtholinesList[i]).ID <> currVLine.ID)) then begin currVLine := TOrthoLine(CurrConn.JoinedOrtholinesList[i]); // just checking if (currVLine.JoinConnector1 = nil) or TConnectorObject(currVLine.JoinConnector1).Deleted or (currVLine.JoinConnector2 = nil) or TConnectorObject(currVLine.JoinConnector2).Deleted then currVLine := nil; if currVLine <> nil then begin if ((currVLine1.JoinConnector1.ID = currVLine.JoinConnector1.ID) and (currVLine1.JoinConnector2.ID = currVLine.JoinConnector2.ID)) or ((currVLine1.JoinConnector1.ID = currVLine.JoinConnector2.ID) and (currVLine1.JoinConnector2.ID = currVLine.JoinConnector1.ID)) then begin // LOG AddExceptionToLog('OrthoLines with indexes '+ Inttostr(currVLine1.FIndex) + ' and ' + Inttostr(currVLine.FIndex)+ 'have the same JoinConnectors !!!'); CurrVLine := nil; end; end; if currVLine <> nil then begin if TConnectorObject(currVLine.JoinConnector1).ID = CurrConn.ID then begin currConn := TConnectorObject(currVLine.JoinConnector2); CanLook := True; Break; //// BREAK //// end else if TConnectorObject(currVLine.JoinConnector2).ID = CurrConn.ID then begin currConn := TConnectorObject(currVLine.JoinConnector1); CanLook := True; Break; //// BREAK //// end; end; end; end; if CanLook then begin if CurrConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); if LinesList.IndexOf(currVLine) = -1 then LinesList.Add(currVLine); end; end else if CurrConn.ConnectorType = ct_NB then begin for i := 0 to CurrConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> currVLine.ID)) then begin currVLine := TOrthoLine(TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); // just checking if (currVLine.JoinConnector1 = nil) or TConnectorObject(currVLine.JoinConnector1).Deleted or (currVLine.JoinConnector2 = nil) or TConnectorObject(currVLine.JoinConnector2).Deleted then currVLine := nil; if currVLine <> nil then begin if ((currVLine1.JoinConnector1.ID = currVLine.JoinConnector1.ID) and (currVLine1.JoinConnector2.ID = currVLine.JoinConnector2.ID)) or ((currVLine1.JoinConnector1.ID = currVLine.JoinConnector2.ID) and (currVLine1.JoinConnector2.ID = currVLine.JoinConnector1.ID)) then begin // LOG AddExceptionToLog('OrthoLines with indexes '+ Inttostr(currVLine1.FIndex) + ' and ' + Inttostr(currVLine.FIndex)+ 'have the same JoinConnectors !!!'); CurrVLine := nil; end; end; if currVLine <> nil then begin if TConnectorObject(currVLine.JoinConnector1).JoinedConnectorsList.IndexOf(CurrConn) <> -1 then begin currConn := TConnectorObject(currVLine.JoinConnector2); CanLook := True; Break; //// BREAK //// end else if TConnectorObject(currVLine.JoinConnector2).JoinedConnectorsList.IndexOf(CurrConn) <> -1 then begin currConn := TConnectorObject(currVLine.JoinConnector1); CanLook := True; Break; //// BREAK //// end; end; end; end; if CanLook then begin if CurrConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); if LinesList.IndexOf(currVLine) = -1 then LinesList.Add(currVLine); Break; //// BREAK ////; end; end; end; end; end; end; // если есть вторая вертикаль - идем в другую сторону if currVLine2 <> nil then begin LinesList.Add(currVLine2); CurrConn := nil; // второй конец вертикали, чтобы посмотреть оттуда {if TConnectorObject(currVLine2.JoinConnector1).JoinedConnectorsList.IndexOf(CurrObject) <> -1 then CurrConn := TConnectorObject(currVLine2.JoinConnector2) else if TConnectorObject(currVLine2.JoinConnector2).JoinedConnectorsList.IndexOf(CurrObject) <> -1 then CurrConn := TConnectorObject(currVLine2.JoinConnector1); } if TConnectorObject(currVLine2.JoinConnector1).JoinedConnectorsList.IndexOf(CurrObject) = -1 then CurrConn := TConnectorObject(currVLine2.JoinConnector1) else if TConnectorObject(currVLine2.JoinConnector2).JoinedConnectorsList.IndexOf(CurrObject) = -1 then CurrConn := TConnectorObject(currVLine2.JoinConnector2); if CurrConn <> nil then begin // если на объекте if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); currVLine := currVLine2; CanLook := True; OutCounter := 0; While (Canlook and (OutCounter < 50)) do begin Inc(OutCounter); if OutCounter = 50 then AddExceptionToLog('SCSObjectProp.CheckDeleteVLines LOOP EXIT ON COUNTER !!! ' ); canLook := False; if CurrConn.ConnectorType = ct_clear then begin for i := 0 to CurrConn.JoinedOrtholinesList.Count - 1 do begin // нашли вертикаль if (TOrthoLine(CurrConn.JoinedOrtholinesList[i]).FIsVertical and (TOrthoLine(CurrConn.JoinedOrtholinesList[i]).ID <> currVLine.ID)) then begin currVLine := TOrthoLine(CurrConn.JoinedOrtholinesList[i]); // just checking if (currVLine.JoinConnector1 = nil) or TConnectorObject(currVLine.JoinConnector1).Deleted or (currVLine.JoinConnector2 = nil) or TConnectorObject(currVLine.JoinConnector2).Deleted then currVLine := nil; if currVLine <> nil then begin if ((currVLine2.JoinConnector1.ID = currVLine.JoinConnector1.ID) and (currVLine2.JoinConnector2.ID = currVLine.JoinConnector2.ID)) or ((currVLine2.JoinConnector1.ID = currVLine.JoinConnector2.ID) and (currVLine2.JoinConnector2.ID = currVLine.JoinConnector1.ID)) then begin // LOG AddExceptionToLog('OrthoLines with indexes '+ Inttostr(currVLine2.FIndex) + ' and ' + Inttostr(currVLine.FIndex)+ 'have the same JoinConnectors !!!'); CurrVLine := nil; end; end; if currVLine <> nil then begin if TConnectorObject(currVLine.JoinConnector1).ID = CurrConn.ID then begin currConn := TConnectorObject(currVLine.JoinConnector2); CanLook := True; Break; //// BREAK //// end else if TConnectorObject(currVLine.JoinConnector2).ID = CurrConn.ID then begin currConn := TConnectorObject(currVLine.JoinConnector1); CanLook := True; Break; //// BREAK //// end; end; end; end; if CanLook then begin if CurrConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); if LinesList.IndexOf(currVLine) = -1 then LinesList.Add(currVLine); end; end else if CurrConn.ConnectorType = ct_NB then begin for i := 0 to CurrConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> currVLine.ID)) then begin currVLine := TOrthoLine(TConnectorObject(CurrConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); // just checking if (currVLine.JoinConnector1 = nil) or TConnectorObject(currVLine.JoinConnector1).Deleted or (currVLine.JoinConnector2 = nil) or TConnectorObject(currVLine.JoinConnector2).Deleted then currVLine := nil; if currVLine <> nil then begin if ((currVLine2.JoinConnector1.ID = currVLine.JoinConnector1.ID) and (currVLine2.JoinConnector2.ID = currVLine.JoinConnector2.ID)) or ((currVLine2.JoinConnector1.ID = currVLine.JoinConnector2.ID) and (currVLine2.JoinConnector2.ID = currVLine.JoinConnector1.ID)) then begin // LOG AddExceptionToLog('OrthoLines with indexes '+ Inttostr(currVLine2.FIndex) + ' and ' + Inttostr(currVLine.FIndex)+ 'have the same JoinConnectors !!!'); CurrVLine := nil; end; end; if currVLine <> nil then begin if TConnectorObject(currVLine.JoinConnector1).ID = CurrConn.ID then begin currConn := TConnectorObject(currVLine.JoinConnector2); CanLook := True; Break; //// BREAK //// end else if TConnectorObject(currVLine.JoinConnector2).ID = CurrConn.ID then begin currConn := TConnectorObject(currVLine.JoinConnector1); CanLook := True; Break; //// BREAK //// end; end; end; end; if CanLook then begin if CurrConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); if LinesList.IndexOf(currVLine) = -1 then LinesList.Add(currVLine); Break; //// BREAK ////; end; end; end; end; end; end; if (LinesList <> nil) then begin CanLook := True; while CanLook do begin CanLook := False; for i := 0 to LinesList.Count - 1 do begin currVLine := TOrthoLine(LinesList[i]); // если подключена только с одной стороны if (((TConnectorObject(currVLine.JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(currVLine.JoinConnector1).JoinedOrtholinesList.Count = 1)) or ((TConnectorObject(currVLine.JoinConnector2).JoinedConnectorsList.Count = 0) and (TConnectorObject(currVLine.JoinConnector2).JoinedOrtholinesList.Count = 1))) then begin if not currVLine.deleted then begin CanLook := True; currVLine.Delete; LinesList.Remove(currVLine); Break; //// BREAK ////; end; end; end; end; FreeAndNil(LinesList); end; if ((RaiseLine <> nil) and (not RaiseLine.Deleted)) then begin if (((TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(RaiseLine.JoinConnector1).JoinedOrtholinesList.Count = 1)) or ((TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(RaiseLine.JoinConnector1).JoinedOrtholinesList.Count = 1))) then begin { TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise := nil; TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise := nil; TConnectorObject(RaiseLine.JoinConnector1).FConnRaiseType := crt_None; TConnectorObject(RaiseLine.JoinConnector2).FConnRaiseType := crt_None; RaiseLine.FObjectFromRaisedLine := nil; TConnectorObject(RaiseLine.JoinConnector1).Name := cCadClasses_Mes12; SetNewObjectNameInPM(TConnectorObject(RaiseLine.JoinConnector1).ID, TConnectorObject(RaiseLine.JoinConnector1).Name); TConnectorObject(RaiseLine.JoinConnector2).Name := cCadClasses_Mes12; SetNewObjectNameInPM(TConnectorObject(RaiseLine.JoinConnector2).ID, TConnectorObject(RaiseLine.JoinConnector2).Name);} RaiseLine.Delete; end; end; end; procedure RestoreLineConnections; var i, j: Integer; JoinedFigure: TOrthoLine; JoinedCatalog: TSCSCatalog; begin // восстановить соединения for i := 0 to SavedCableComponList.Count - 1 do begin if IsCableComponent(TSCSComponent(SavedCableComponList[i])) then begin JoinedCatalog := TSCSComponent(SavedCableComponList[i]).GetFirstParentCatalog; if JoinedCatalog <> nil then begin Joinedfigure := TOrthoLine(GetFigureByCatalogId(JoinedCatalog.SCSID)); if (JoinedFigure <> nil) then begin JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin RestoreLineConnectionsBySide(JoinedFigure, TSCSComponent(SavedCableComponList[i]), 1); RestoreLineConnectionsBySide(JoinedFigure, TSCSComponent(SavedCableComponList[i]), 2); end; end; end; end; end; {for i := 0 to SavedCableComponList.Count - 1 do begin JoinedLine := TOrthoLine(SavedCableComponList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end;} end; // Tolik 18/11/2016 -- если на точечном есть магистральный или межэтажный С/П - двинуть его как есть // со всеми присоединенными трассами Function CheckCanMoveObjectWithBetweenFloorOrMagistralRaise : Boolean; var i, j: Integer; Nb_Conn: TConnectorObject; JoinedConn, JoinedLineConn: TConnectorObject; JoinedLine: TOrthoLine; isTrunk: Boolean; begin Result := False; Nb_Conn := Nil; isTrunk := False; if aObject.ConnectorType = ct_Nb then NB_Conn := aObject else if aObject.JoinedConnectorsList.Count > 0 then Nb_Conn := TConnectorObject(aObject.JoinedConnectorsList[0]); if Nb_Conn <> nil then begin for i := 0 to Nb_Conn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(Nb_Conn.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]); if JoinedLine.FIsRaiseUpDown then begin JoinedLineConn := TConnectorObject(JoinedLine.JoinConnector1); // если трасса прицеплене не к той стороне райза -- вывалиться нах и ничего не двигать if (JoinedLineConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinedLineConn.FConnRaiseType = crt_BetweenFloorDown) or (JoinedLineConn.FConnRaiseType = crt_TRunkUp) or (JoinedLineConn.FConnRaiseType = crt_TRunkDown) then begin isTrunk := True; Break; //// BREAK ////; end; JoinedLineConn := TConnectorObject(JoinedLine.JoinConnector2); // если трасса прицеплене не к той стороне райза -- вывалиться нах и ничего не двигать if (JoinedLineConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinedLineConn.FConnRaiseType = crt_BetweenFloorDown) or (JoinedLineConn.FConnRaiseType = crt_TRunkUp) or (JoinedLineConn.FConnRaiseType = crt_TRunkDown) then begin isTrunk := True; Break; //// BREAK ////; end; end; end; if isTrunk then Break; //// BREAK ////; end; if isTrunk then begin Result := True; Nb_Conn.ActualZOrder[1] := aZ; SetConFigureCoordZInPM(NB_Conn.ID, NB_Conn.ActualZOrder[1]); for i := 0 to Nb_Conn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(Nb_Conn.JoinedConnectorsList[i]); JoinedConn.ActualZOrder[1] := aZ; SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if TConnectorObject(JoinedLine.JoinConnector1).ID = JoinedConn.Id then begin JoinedLine.ActualZOrder[1] := aZ; end else if TConnectorObject(JoinedLine.JoinConnector2).ID = JoinedConn.ID then begin JoinedLine.ActualZOrder[2] := aZ; end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; JoinedLine.UpdateLengthTextBox(False, True); SetLineFigureCoordZInPM(JoinedLine.ID, 1, JoinedLine.ActualZOrder[1]); SetLineFigureCoordZInPM(JoinedLine.ID, 2, JoinedLine.ActualZOrder[2]); end; end; end; end; end; // begin // 18/11/2016-- if ((aObject = nil) or aObject.Deleted) then Exit; // BaseBeginUpdate; try if ((aObject.ConnectorType = ct_NB) and (CompareValue(aObject.ActualZOrder[1], aZ) <> 0)) then // нех пустые коннектора трогать begin //BaseBeginUpdate; if not CheckCanMoveObjectWithBetweenFloorOrMagistralRaise then begin //JConnList := TList.Create; JConnList := nil; ZCoord := aZ; JoinedLinesList := Nil; AllJoinedLineList := Nil; WayList := nil; TraceList := nil; EmptyList := nil; SavedComponList := TList.Create; // компоненты точечного SavedConnectionsList := TList.Create; WayList := TList.Create; ObjectToSnap := nil; DirectionUP := False; DirectionDown := False; ComponToDeleteList := TSCSComponents.Create(False); SavedCableComponList := TList.Create; // Сохраняем компоненты точечного (понадобится потом для сброса кабельных соединений) SrcCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aObject.Id); if SrcCatalog <> nil then begin for i := 0 to SrcCatalog.ComponentReferences.Count - 1 do begin if SavedComponList.IndexOf(SrcCatalog.ComponentReferences[i]) = -1 then SavedComponList.Add(SrcCatalog.ComponentReferences[i]); end; end; // направление сдвига if TConnectorObject(aObject).ActualZOrder[1] > aZ then DirectionDown := True else if TConnectorObject(aObject).ActualZOrder[1] < aZ then DirectionUP := True; //Tolik if CheckSimpleMove then //если коннектор ни к чему не подключен (или нет вертикальных трасс и райзов + // включена опция "высота расположения трасс на уровне рабочих мест" -- не нужно пересохранять // и восстанавливать соединения, т.к. ничего не разрывается) // здесь - простое перемещение коннектора begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]); CableToDelList := TSCSComponents.Create(False); // приконекченные линии for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if TConnectorObject(JoinedLine.JoinConnector1).ID = JoinedConn.ID then begin TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1] := aZ; JoinedLine.ActualZOrder[1] := aZ; SetConFigureCoordZInPM(TConnectorObject(JoinedLine.JoinConnector1).ID, aZ); SetLineFigureCoordZInPM(JoinedLine.ID, 1, JoinedLine.ActualZOrder[1]); end else if TConnectorObject(JoinedLine.JoinConnector2).ID = JoinedConn.ID then begin TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1] := aZ; JoinedLine.ActualZOrder[2] := aZ; SetConFigureCoordZInPM(TConnectorObject(JoinedLine.JoinConnector2).ID, aZ); SetLineFigureCoordZInPM(JoinedLine.ID, 2, JoinedLine.ActualZOrder[2]); end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; JoinedLine.UpdateLengthTextBox(true, true); SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.ReCreateCaptionsGroup(True, True); JoinedLine.ReCreateNotesGroup(True); JoinedLine.ReCreateDrawFigureBlock; // если перевернулась вертикаль (тады ой! -- по идее коннектор1 у вертикали - внизу, коннутор2 -- вверху, // поэтому нужно проверить и перевернуть -- на всякий) if JoinedLine.FIsVertical then begin if CompareValue(TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1], TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]) = 1 then begin { // сохранить соединения кабеля JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for k := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[k]); if IsCableComponent(CableCompon) then begin if not CheckPointToPointConnection(CableCompon) then begin CheckSaveLineConnectionsBySide(JoinedLine, CableCompon, 1); CheckSaveLineConnectionsBySide(JoinedLine, CableCompon, 2); end else begin if CableToDelList.IndexOf(CableCompon) = -1 then CableToDelList.Add(CableCompon); SavePointToPointConnection(CableCompon); end; end; end; end; TempConn := JoinedLine.JoinConnector1; JoinedLine.JoinConnector1 := JoinedLine.JoinConnector2; JoinedLine.ActualZOrder[1] := TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1]; SetLineFigureCoordZInPM(JoinedLine.ID, 1, JoinedLine.ActualZOrder[1]); JoinedLine.JoinConnector2 := TempConn; JoinedLine.ActualZOrder[2] := TConnectorObject(TempConn).ActualZOrder[1]; SetLineFigureCoordZInPM(JoinedLine.ID, 2, JoinedLine.ActualZOrder[2]); for k := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[k]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; } end; end else // переворот райза if JoinedLine.FIsRaiseUpDown then begin if aObject.JoinedConnectorsList.IndexOf(TConnectorObject(JoinedLine.JoinConnector1)) = -1 then begin if TConnectorObject(JoinedLine.JoinConnector1).FConnRaiseType = crt_None then JoinedLine.FLineRaiseType := GetRaiseType(aObject, TConnectorObject(JoinedLine.JoinConnector1)) else JoinedLine.FLineRaiseType := GetRaiseType(TConnectorObject(JoinedLine.JoinConnector1), aObject); end else begin if TConnectorObject(JoinedLine.JoinConnector2).FConnRaiseType = crt_None then JoinedLine.FLineRaiseType := GetRaiseType(aObject, TConnectorObject(JoinedLine.JoinConnector2)) else JoinedLine.FLineRaiseType := GetRaiseType(TConnectorObject(JoinedLine.JoinConnector2), aObject); end; end; end; end; if CableToDelList.Count > 0 then F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, CableToDelList, False, biNone, false, nil); FreeAndNil(CableToDelList); BaseEndUpdate; CheckDeleteAllRaises(GCadForm.PCad); Exit; // -- алес // // Соединитель ----------------------------------------------------- // соединитель - нах if aObject.ConnectorType = ct_Clear then begin // Он не с-п и на нем нет с-п if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then begin if not GCadForm.FListSettings.CADAutoPosTraceBetweenRM then CreateRaiseOnConnector(aObject, ZCoord) else begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do // отконнектить присоед. коннекторы begin if JConnList.IndexOf(aObject.JoinedConnectorsList[i]) = -1 then JConnList.Add(aObject.JoinedConnectorsList[i]); end; while aObject.JoinedConnectorsList.Count <> 0 do UnsnapConnectorFromPointObject(aObject.JoinedConnectorsList[0], aObject); end; end else // на нем есть с-п if GetRaiseConn(aObject) <> nil then begin ChangeRaiseOnConnector(aObject, ZCoord); // SP !!! // CheckDeleteAllRaises(GCadForm.PCad); end else // это с-п if (aObject.FConnRaiseType = crt_OnFloor) then begin ObjFromRaise := aObject.FObjectFromRaise; if ZCoord = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; //if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PWidechar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end; end else // Объект ---------------------------------------------------------- begin // Он не с-п и на нем нет с-п if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then begin //Tolik // if aObject.JoinedConnectorsList.Count = 0 then if aObject.JoinedConnectorsList.Count = 0 then // begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, ZCoord); end else begin if not GCadForm.FListSettings.CADAutoPosTraceBetweenRM then CreateRaiseOnPointObject(aObject, ZCoord) else begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do // отконнектить присоед. коннекторы begin if JConnList.IndexOf(aObject.JoinedConnectorsList[i]) = -1 then JConnList.Add(aObject.JoinedConnectorsList[i]); end; while aObject.JoinedConnectorsList.Count <> 0 do UnsnapConnectorFromPointObject(aObject.JoinedConnectorsList[0], aObject); end; aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, ZCoord); end; end else // на нем есть с-п if GetRaiseConn(aObject) <> nil then begin // только подъем-спуск begin if aObject.JoinedConnectorsList.Count = 0 then begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, ZCoord); end else begin ChangeRaiseOnPointObject(aObject, ZCoord); // SP !!! // CheckDeleteAllRaises(GCadForm.PCad); end; end; end else // это с-п if (aObject.FConnRaiseType = crt_OnFloor) then begin ObjFromRaise := aObject.FObjectFromRaise; if ZCoord = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; //if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PWidechar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end; end; aObject.MoveConnector(0, 0, false, false, false); // ДЛЯ ПЕРЕСЧЕТА ДЛИНЫ И ЗАПИСИ В РМ if JConnList.Count > 0 then begin for i := 0 to JConnList.Count - 1 do begin SnapConnectorToPointObject(TConnectorObject(aObject), TConnectorObject(JConnList[i])); end; end; JConnList.Clear; // RaiseConn := nil; RaiseConn := GetRaiseConn(aObject); if RaiseConn <> nil then begin if Not RaiseConn.Deleted then begin i := 0; while i < RaiseConn.JoinedOrtholinesList.Count do begin prevcount := RaiseConn.JoinedOrtholinesList.Count; if Not TOrthoLine(RaiseConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(RaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(RaiseConn) or RaiseConn.Deleted then break; end; end; if RaiseConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if RaiseConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; end; end else begin // если просто двинуть не получается - смотрим варианты if ((aObject.ConnectorType = ct_NB) and (aObject.ActualZOrder[1] <> aZ)) then begin HasVLine := False; // есть вертикаль HasHorizontalTraces := False; // есть горизонтали (точнее, НЕВЕРТИКАЛИ и НЕРАЙЗЫ) HasRaiseLine := False; // есть райз //DirectionUP := False; // двигаем объект вверх //DirectionDown := False; // двигаем объект вниз ObjectToSnap := nil; // попадем на точечный NeedConvertRaiseToVertLine := False; // необходимость преобразования райза в вертикаль JoinedLinesList := TList.Create; AllJoinedLineList := TList.Create; RaiseLine := nil; // райз TraceList := TList.Create; EmptyList := TList.Create; if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin // присоединенные трассы (не с/п и не райзы) for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if ((not TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown) and (not TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical)) then if JoinedLinesList.IndexOf(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then JoinedLinesList.Add(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); if AllJoinedLineList.IndexOf(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then AllJoinedLineList.Add(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); end; end; end else // если все равно отрывать все коннекторы, то записать все соединения на всех присоединенных трассах if not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if JoinedLinesList.IndexOf(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then JoinedLinesList.Add(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); if AllJoinedLineList.IndexOf(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then AllJoinedLineList.Add(TOrthoLine(TConnectorObject(aObject.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); end; end; end; CheckRaiseVLines; // есть ли вертикаль/райз (если есть райз - не будет вертикали и наоборот!!!) // если есть райз - проверить, нужно ли конвертить райз в вертикаль if RaiseLine <> nil then NeedConvertRaiseToVertLine := CheckNeedToConvertRaise(RaiseLine); LookUPDOWN; // проверка попадания на другой точечный объект КАДа ObjectToSnap := GetObjectToSnap; // запись (для каждого кабеля по трассам ) { for i := 0 to JoinedLinesList.Count - 1 do begin ConnectionSide := 0; JoinedLine := TOrthoLine(JoinedLinesList[i]); if TConnectorObject(JoinedLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then ConnectionSide := 1 else if TConnectorObject(JoinedLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then ConnectionSide := 2; JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin if not CheckPointToPointConnection(CableCompon) then begin CheckSaveLineConnectionsBySide(JoinedLine, CableCompon, ConnectionSide); end else SavePointToPointConnection(CableCompon); end; end; end; end;} // Tolik -- 19/12/2016 -- сортануть список присоединенных трасс, чтобы не потерять проходящие кабельные соединения if AllJoinedLineList.Count > 1 then begin CanSortList := True; While CanSortList do begin CanSortList := False; for i := 0 to AllJoinedLineList.Count - 2 do begin if ((TOrthoLine(AllJoinedLineList[i]).FIsVertical or TOrthoLine(AllJoinedLineList[i]).FIsRaiseUpDown) and (not ((TOrthoLine(AllJoinedLineList[i+1]).FIsVertical or TOrthoLine(AllJoinedLineList[i+1]).FIsRaiseUpDown)))) then begin CanSortList := True; JoinedLine := TOrthoLine(AllJoinedLineList[i]); AllJoinedLineList.Delete(i); AllJoinedLineList.Insert(i+1, JoinedLine); end; end; end; end; for i := 0 to AllJoinedLineList.Count - 1 do begin ConnectionSide := 0; JoinedLine := TOrthoLine(AllJoinedLineList[i]); if TConnectorObject(JoinedLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then ConnectionSide := 1 else if TConnectorObject(JoinedLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then ConnectionSide := 2; JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin if not CheckPointToPointConnection(CableCompon) then begin CheckSaveLineConnectionsBySide(JoinedLine, CableCompon, ConnectionSide); end else SavePointToPointConnection(CableCompon); {if ComponToDeleteList.IndexOf(CableCompon) = -1 then ComponToDeleteList.Add(Cablecompon);} end; end; end; end; // сброс if ComponToDeleteList.Count > 0 then begin for i := 0 to ComponToDeleteList.Count - 1 do begin TSCSComponent(ComponToDeleteList[i]).DisJoinFromAll(True).Free; end; end; // SaveConnectionOnPointObject; // сохранить кабельные соединения // Если установлено свойство листа "располагать трассы на высоте размещения рабочих мест", то // трассы(НЕВЕРТИКАЛИ и НЕРАЙЗЫ) от точечного отрывать не будем, поднимем вместе с трассами и просто пересчитаем длины. // Единственное, придется учесть райзы и/или вертикали (попадания, перевороты, сдвиги) if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then begin // MoveConnectorWithOutDisJoin; // сбросятся только, при необходимости, соединениея на вертикали, если она есть // соотв. края трасс двинутся вместе с объектом if ObjectToSnap <> nil then begin TempConnector := nil; for i := (aObject.JoinedConnectorsList.Count - 1) downto 0 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); // оторвать коннекторы ортолиний от объекта JoinedConn.JoinedConnectorsList.Remove(aObject); aObject.JoinedConnectorsList.Remove(JoinedConn); // перепривязка трасс if ((not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.FIsVertical)) then begin // переконнектить края ортолиний без снапа ObjectToSnap.JoinedConnectorsList.Add(JoinedConn); JoinedConn.JoinedConnectorsList.Insert(0, ObjectToSnap); if TConnectorObject(JoinedLine.JoinConnector1).ID = JoinedConn.ID then begin TConnectorObject(JoinedLine.JoinConnector1).ActualZOrder[1] := aZ; JoinedLine.ActualZOrder[1] := aZ; SetConFigureCoordZInPM(TConnectorObject(JoinedLine.JoinConnector1).ID, aZ); SetLineFigureCoordZInPM(JoinedLine.ID, 1, JoinedLine.ActualZOrder[1]); end else if TConnectorObject(JoinedLine.JoinConnector2).ID = JoinedConn.ID then begin TConnectorObject(JoinedLine.JoinConnector2).ActualZOrder[1] := aZ; JoinedLine.ActualZOrder[2] := aZ; SetConFigureCoordZInPM(TConnectorObject(JoinedLine.JoinConnector2).ID, aZ); SetLineFigureCoordZInPM(JoinedLine.ID, 2, JoinedLine.ActualZOrder[2]); end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; JoinedLine.UpdateLengthTextBox(true, true); SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.ReCreateCaptionsGroup(True, True); JoinedLine.ReCreateNotesGroup(True); JoinedLine.ReCreateDrawFigureBlock; end else begin // переконнектить вертикали в точке отрыва объекта, если их более чем одна if TempConnector = nil then TempConnector := JoinedConn else if TempConnector <> nil then begin for k := (JoinedConn.JoinedOrtholinesList.Count - 1) downto 0 do begin if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).JoinConnector1).ID = JoinedConn.ID then TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).JoinConnector1 := TFigure(TempConnector) else if TConnectorObject(TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).JoinConnector2).ID = JoinedConn.ID then TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).JoinConnector2 := TFigureGrpMod(TempConnector); TempConnector.JoinedOrtholinesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[k])); JoinedConn.JoinedOrtholinesList.Remove(TOrthoLine(JoinedConn.JoinedOrtholinesList[k])); end; JoinedConn.Delete(False, False); end; end; end; end; // здесь нужен не дубликат, а перенос компонетов из одного объекта в другой SrcCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aObject.ID); TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ObjectToSnap.ID); if ((SrcCatalog <> nil) and (TargetCatalog <> nil)) then begin TargetNode := F_ProjMan.GetNodeByObj(TargetCatalog); if TargetNode <> nil then begin for i := 0 to SrcCatalog.SCSComponents.Count - 1 do begin SCSComponent := TSCSComponent(SrcCatalog.SCSComponents[i]); SrcNode := F_ProjMan.GetNodeByObj(SCSComponent); if SrcNode <> nil then F_ProjMan.MoveDir(SrcNode, TargetNode); end; end; end; // сбросить кабельные подключения точечных компонент (на всякий) for i := 0 to SavedComponList.Count - 1 do begin SCSComponent := TSCSComponent(SavedComponList[i]); for j := (SCSComponent.JoinedComponents.Count - 1) downto 0 do begin if IsCableComponent(TSCSComponent(SCSComponent.JoinedComponents[j])) then SCSComponent.DisJoinFrom(TSCSComponent(SCSComponent.JoinedComponents[j])); end; end; // восстановить соединения {for i := 0 to AllJoinedLineList.Count - 1 do begin JoinedLine := TOrthoLine(AllJoinedLineList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end; } RestoreLineConnections; {for i := 0 to JoinedLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedLinesList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end;} // удалить ненужные вертикали if WayList.Count > 0 then begin for i := (WayList.Count - 1) downto 0 do begin if TOrthoLine(WayList[i]).FIsVertical then CheckDeleteVLine(TOrthoLine(WayList[i])); end; WayList.Clear; FreeAndNil(WayList); end; // удалить ненужные райзы CheckDeleteAllRaises(GCadForm.PCad); // сбросить форму свойств (объект же уже не тот, его практически и нету) ClearAllProperties; end else begin if ComponToDeleteList.Count > 0 then begin for i := 0 to ComponToDeleteList.Count - 1 do begin TSCSComponent(ComponToDeleteList[i]).DisJoinFromAll(true).Free; end; end; if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM then PutNBObjectOnHeight(aObject, aZ, JoinedLinesList, wayList) else PutNBObjectOnHeight(aObject, aZ, TraceList, wayList); // восстановить соединения {for i := 0 to JoinedLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedLinesList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end;} { for i := 0 to AllJoinedLineList.Count - 1 do begin JoinedLine := TOrthoLine(AllJoinedLineList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end; } RestoreLineConnections; end; GCadForm.PCad.Refresh; end // если нет, то придется разрывать соединения коннекторов, при необходимости, построить С/п или вертикали // + протянуть кабели к обрывам и восстановить состояние соединения кабелей так, как было до подъема/спуска точечного else begin // "скользнет" в нужную сторону по вертикали (и "потащит" за собой присоединенные кабели) // если попадаем в объект - перебрасываем компоненты (без снапа коннекторов!!!) if ObjectToSnap <> nil then begin // переконнектить трассы на месте точечного(сбросить соединение) FirstPointConn := nil; NextPointConn := nil; RaiseLine := RaiseFromConnector(aObject); if RaiseLine <> nil then begin if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(aObject) <> -1 then FirstPointConn := TConnectorObject(RaiseLine.JoinConnector1) else if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(aObject) <> -1 then FirstPointConn := TConnectorObject(RaiseLine.JoinConnector2) end; if aObject.JoinedConnectorsList.Count > 0 then begin if FirstPointConn = nil then FirstPointConn := TConnectorObject(aObject.JoinedConnectorsList[0]); FirstPointConn.JoinedConnectorsList.Remove(aObject); // вкинуть пустой коннектор в ПМ SetNewObjectNameInPM(FirstPointConn.ID, FirstPointConn.Name); aObject.JoinedConnectorsList.Remove(FirstPointConn); for i := (aObject.JoinedConnectorsList.Count - 1) Downto 0 do begin NextPointConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := (NextPointConn.JoinedOrtholinesList.Count - 1) downto 0 do begin if TConnectorObject(TOrthoLine(NextPointConn.JoinedOrtholinesList[j]).JoinConnector1).ID = NextPointConn.ID then begin TOrthoLine(NextPointConn.JoinedOrtholinesList[j]).JoinConnector1 := TFigure(FirstPointConn); end else if TConnectorObject(TOrthoLine(NextPointConn.JoinedOrtholinesList[j]).JoinConnector2).ID = NextPointConn.ID then begin TOrthoLine(NextPointConn.JoinedOrtholinesList[j]).JoinConnector2 := TFigure(FirstPointConn); end; FirstPointConn.JoinedOrtholinesList.Add(TOrthoLine(NextPointConn.JoinedOrtholinesList[j])); NextPointConn.JoinedOrtholinesList.Remove(TOrthoLine(NextPointConn.JoinedOrtholinesList[j])); end; NextPointConn.Delete(False,False); end; end; // // сбросить кабельные подключения точечных компонент (на всякий) for i := 0 to SavedComponList.Count - 1 do begin SCSComponent := TSCSComponent(SavedComponList[i]); for j := (SCSComponent.JoinedComponents.Count - 1) downto 0 do begin if IsCableComponent(TSCSComponent(SCSComponent.JoinedComponents[j])) then SCSComponent.DisJoinFrom(TSCSComponent(SCSComponent.JoinedComponents[j])); end; end; // здесь нужен не дубликат, а перенос компонетов из одного объекта в другой SrcCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aObject.ID); TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ObjectToSnap.ID); if ((SrcCatalog <> nil) and (TargetCatalog <> nil)) then begin TargetNode := F_ProjMan.GetNodeByObj(TargetCatalog); if TargetNode <> nil then begin for i := 0 to SrcCatalog.SCSComponents.Count - 1 do begin SCSComponent := TSCSComponent(SrcCatalog.SCSComponents[i]); SrcNode := F_ProjMan.GetNodeByObj(SCSComponent); if SrcNode <> nil then F_ProjMan.MoveDir(SrcNode, TargetNode); end; end; end; // восстановить соединения {for i := 0 to JoinedLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedLinesList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end;} { for i := 0 to AllJoinedLineList.Count - 1 do begin JoinedLine := TOrthoLine(AllJoinedLineList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end; } RestoreLineConnections; // удалить ненужные вертикали // поскольку объекта уже нет - сбросить форму свойств объекта ClearAllProperties; Close; end else begin // LookUPDOWN; // если не попадем не объект PutNBObjectOnHeight(aObject, aZ, EmptyList, wayList); // сбросить кабельные подключения точечных компонент (на всякий) for i := 0 to SavedComponList.Count - 1 do begin SCSComponent := TSCSComponent(SavedComponList[i]); for j := (SCSComponent.JoinedComponents.Count - 1) downto 0 do begin if IsCableComponent(TSCSComponent(SCSComponent.JoinedComponents[j])) then SCSComponent.DisJoinFrom(TSCSComponent(SCSComponent.JoinedComponents[j])); end; end; // восстановить соединения {for i := 0 to JoinedLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedLinesList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end;} { for i := 0 to AllJoinedLineList.Count - 1 do begin JoinedLine := TOrthoLine(AllJoinedLineList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin CableCompon := TSCSComponent(JoinedLineCatalog.ComponentReferences[j]); if IsCableComponent(CableCompon) then begin RestoreLineConnectionsBySide(JoinedLine, CableCompon, 1); RestoreLineConnectionsBySide(JoinedLine, CableCompon, 2); end; end; end; end; } RestoreLineConnections; end; GCadForm.PCad.Refresh; end; end; //BaseEndUpdate; // удалить кабели if ComponToDeleteList.Count > 0 then begin F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil); ComponToDeleteList.Clear; end; // удалить ненужные райзы //CheckDeleteAllRaises(GCadForm.PCad); end; FreeAndNil(ComponToDeleteList); // удалить "висяки" по вертикали (вертикали, подключенные только с одного конца) CheckDeleteVLines; CheckDeleteAllRaises(GCadForm.PCad); // FreeAndNil(SavedConnectionsList); FreeAndNil(SavedCableComponList); // список кабелей для восстановления соединений if JConnList <> nil then FreeAndNil(JConnList); {if WayList <> nil then FreeAndNil(WayList);} if JoinedLinesList <> nil then FreeAndNil(JoinedLinesList); if AllJoinedLineList <> nil then FreeAndNil(AllJoinedLineList); if TraceList <> nil then FreeAndNil(TraceList); if EmptyList <> nil then FreeAndNil(EmptyList); if SavedComponList <> nil then FreeAndNil(SavedComponList); // FreeAndNil(WayList); end; end; except on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeConnZ', E.Message); end; BaseEndUpdate; end; procedure TF_SCSObjectsProp.ChangeLineAngle(aObject: TOrthoLine; aAngle: Double); var i: integer; OldAngleRad: Double; NewAngleRad: Double; AngleRad: Double; JoinedConn: TConnectorObject; PointObject: TConnectorObject; deltax, deltay: double; begin try OldAngleRad := StrToFloat_My(FLineProp.fAngle) / 180 * pi; NewAngleRad := aAngle / 180 * pi; AngleRad := NewAngleRad - OldAngleRad; aObject.Rotate(AngleRad, aObject.ActualPoints[1]); JoinedConn := TConnectorObject(aObject.JoinConnector2); deltax := aObject.ActualPoints[2].x - JoinedConn.ActualPoints[1].x; deltay := aObject.ActualPoints[2].y - JoinedConn.ActualPoints[1].y; aObject.Rotate(0 - AngleRad, aObject.ActualPoints[1]); // if JoinedConn.JoinedConnectorsList.Count = 0 then begin // не вершина с-п if JoinedConn.FConnRaiseType = crt_None then begin JoinedConn.Move(deltax, deltay); end else // вершина с-п begin if JoinedConn.FObjectFromRaise <> nil then JoinedConn.FObjectFromRaise.Move(deltax, deltay); end; end else if JoinedConn.JoinedConnectorsList.Count > 0 then begin PointObject := TConnectorObject(JoinedConn.JoinedConnectorsList[0]); // не вершина с-п if PointObject.FConnRaiseType = crt_None then begin PointObject.Move(deltax, deltay); end else // вершина с-п begin if PointObject.FObjectFromRaise <> nil then PointObject.FObjectFromRaise.Move(deltax, deltay); end; end; except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeAngle', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineAutoLength(aObject: TOrthoLine; aLength: Double); begin try aObject.UserLength := -1; aObject.CalculLength := aObject.LengthCalc; aObject.LineLength := aObject.CalculLength; SetLineFigureLengthInPM(aObject.ID, aObject.LineLength); aObject.UpdateLengthTextBox(True, True); //02.04.2012 if Not FIsMultiSelection then begin aObject.SetNewLength(aLength); end; except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeUserLength', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineCaption(aObject: TOrthoLine; aCaption: string); begin try TTextMod(aObject.MultilineCaptionBox).Text := aCaption; except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeCaption', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineGapCount(aObject: TOrthoLine; aGap: Double; aCount: Integer); var ReplaceLine: TOrthoLine; Joined1, Joined2: TConnectorObject; i: integer; CPLine: TDoublePoint; Fig: TFigHandle; begin try GDefaultGap := aGap; GDefaultNum := aCount; // преобразование мультилинии в мультилинию if (aObject.FCount <> 1) AND (GDefaultNum <> 1) then begin if GDefaultGap > 1 then aObject.FGap := GDefaultGap else aObject.FGap := 2; aObject.FCount := GDefaultNum; end; // преобразование одиночной в мультилинию if (aObject.FCount = 1) AND (GDefaultNum <> 1) then begin CPLine.x := (aObject.ActualPoints[1].x + aObject.ActualPoints[2].x) / 2; CPLine.y := (aObject.ActualPoints[1].y + aObject.ActualPoints[2].y) / 2; aObject.FTextBox := TTextMod.Create(CPLine.x, CPLine.y, cCadTextModHeight, cCadTextModWidth, '', GCadForm.FFontName, RUSSIAN_CHARSET, clBlue, CaptionsLHandle, mydsNormal, GCadForm.PCad); Fig := GCadForm.PCad.AddCustomFigure (GLN(CaptionsLHandle), aObject.FTextBox, False); TTextMod(Fig).LockMove := true; TTextMod(Fig).LockModify := true; aObject.MultilineCaptionBox := TFigure(Fig); aObject.MultilineCaptionBox.SelOrder := ord(osBack); aObject.MultilineCaptionBox.Move(- TTextMod(aObject.MultilineCaptionBox).TextLength / 2, 0); aObject.MoveTextBox(aObject.MultilineCaptionBox, aObject.ActualPoints[1], aObject.ActualPoints[2], False); if aObject.SaveCaption <> '' then TText(aObject.MultilineCaptionBox).Text := aObject.SaveCaption else TText(aObject.MultilineCaptionBox).Text := ''; if GDefaultGap > 1 then aObject.FGap := GDefaultGap else aObject.FGap := 2; aObject.FCount := GDefaultNum; end; // преобразование мультилинии в одиночную if (GDefaultNum = 1) AND (aObject.FCount <> 1) then begin aObject.SaveCaption := TTextMod(aObject.MultilineCaptionBox).Text; TTextMod(aObject.MultilineCaptionBox).Delete; aObject.FCount := GDefaultNum; aObject.FGap := 1; end; aObject.FTextBox := nil; except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeGapCount', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineCaptionsGroup(aObject: TOrthoLine; aCaptions: TStringList); var i: integer; LengthStr: string; Marking: string; begin try if GCadForm.FShowLineCaptionsType = skExternalSCS then begin LengthStr := aObject.OutTextCaptions[1]; aObject.OutTextCaptions.Clear; if ACaptions.Count > 0 then Marking := ACaptions[0] else Marking := GetPairCountFromTrace(GCadForm.FCADListID, aObject.ID); aObject.OutTextCaptions.Add(Marking); aObject.OutTextCaptions.Add(LengthStr); for i := 1 to ACaptions.Count - 1 do begin aObject.OutTextCaptions.Add(ACaptions[i]); end; end else begin LengthStr := aObject.OutTextCaptions[0]; aObject.OutTextCaptions.Clear; aObject.OutTextCaptions.Add(LengthStr); for i := 0 to ACaptions.Count - 1 do begin aObject.OutTextCaptions.Add(ACaptions[i]); end; end; //Tolik -- 23/12/2015 //aObject.ReCreateCaptionsGroup(True, True); aObject.ReCreateCaptionsGroup(True, False); // aObject.FTraceCaptionsList.Clear; for i := 0 to ACaptions.Count - 1 do aObject.FTraceCaptionsList.Add(ACaptions[i]); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineCaptionsGroup', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineNotesGroup(aObject: TOrthoLine; aNotes: TStringList); var i: integer; begin try i := 0; while i < aObject.OutTextNotes.Count do aObject.OutTextNotes.Delete(i); // засыпать маркировки for i := 0 to ANotes.Count - 1 do begin aObject.OutTextNotes.Add(ANotes[i]); end; aObject.ReCreateNotesGroup(True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineNotesGroup', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineName(aObject: TOrthoLine; aName: string); begin try aObject.Name := aName; SetNewObjectNameInPM(aObject.ID, aObject.Name); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineName', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineShowLength(aObject: TOrthoLine; aShowLength: Boolean); begin try aObject.ShowLength := aShowLength; // Tolik -- 06/03/2017 -- // aObject.ReCreateCaptionsGroup(True, True); if cbLineShowLength.Checked then aObject.ReCreateCaptionsGroup(True, True) else aObject.ReCreateCaptionsGroup(True, False); // except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeShowLength', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineUserLength(aObject: TOrthoLine; aLength: Double); begin try aObject.UserLength := aLength; aObject.CalculLength := aObject.LengthCalc; aObject.LineLength := aObject.UserLength; SetLineFigureLengthInPM(aObject.ID, aObject.LineLength); aObject.UpdateLengthTextBox(True, true); except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeUserLength', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineX(aObject: TOrthoLine; aX: Double); var MapScale: Double; OldPointX: Double; NewPointX: Double; MovedConn: TConnectorObject; begin try MapScale := GCadForm.PCad.MapScale; OldPointX := aObject.ActualPoints[1].x; NewPointX := aX / MapScale * 1000; MovedConn := TConnectorObject(aObject.JoinConnector1); if MovedConn.JoinedConnectorsList.Count = 0 then begin if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end else begin MovedConn := TConnectorObject(MovedConn.JoinedConnectorsList[0]); if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end; MovedConn.Move(NewPointX - OldPointX, 0); MovedConn := TConnectorObject(aObject.JoinConnector2); if MovedConn.JoinedConnectorsList.Count = 0 then begin if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end else begin MovedConn := TConnectorObject(MovedConn.JoinedConnectorsList[0]); if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end; MovedConn.Move(NewPointX - OldPointX, 0); except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeX', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineY(aObject: TOrthoLine; aY: Double); var OldPointY: Double; NewPointY: Double; MapScale: Double; MovedConn: TConnectorObject; begin try MapScale := GCadForm.PCad.MapScale; OldPointY := aObject.ActualPoints[1].y; NewPointY := aY / MapScale * 1000; MovedConn := TConnectorObject(aObject.JoinConnector1); if MovedConn.JoinedConnectorsList.Count = 0 then begin if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end else begin MovedConn := TConnectorObject(MovedConn.JoinedConnectorsList[0]); if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end; MovedConn.Move(0, NewPointY - OldPointY); MovedConn := TConnectorObject(aObject.JoinConnector2); if MovedConn.JoinedConnectorsList.Count = 0 then begin if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end else begin MovedConn := TConnectorObject(MovedConn.JoinedConnectorsList[0]); if MovedConn.FConnRaiseType <> crt_None then MovedConn := MovedConn.FObjectFromRaise; end; MovedConn.Move(0, NewPointY - OldPointY); except on E: Exception do AddExceptionToLogEx('TF_OrthoLineProperties.ChangeY', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineZ(aObject: TOrthoLine; aZ: Double); var i: integer; CurrLine: TOrthoLine; TracesList: TList; begin try TracesList := TList.Create; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then begin CurrLine := TOrthoLine(GCadForm.PCad.Selection[i]); if not CurrLine.FIsRaiseUpDown then // Tolik -- 05/04/2016 -- // if CurrLine.ActualZOrder[1] = CurrLine.ActualZOrder[2] then TracesList.Add(CurrLine); end; end; // Tolik -- 01/08/2016 -- TFSCS_Main(F_ProjMan).RaiseSelectedLine(aZ); //RaiseLineOnHeight(aObject, aZ, TracesList); // RefreshCAD(GCadForm.PCad); // SP !!! CheckDeleteAllRaises(GCadForm.PCad); if TracesList <> nil then FreeAndNil(TracesList); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineZ', E.Message); end; end; procedure TF_SCSObjectsProp.FormShow(Sender: TObject); begin try AngleEdited := False; xEdited := False; yEdited := False; zEdited := False; GsEdited := False; edConnAngle.Style.TextColor := clWindowText; edConnX.Style.TextColor := clWindowText; edConny.Style.TextColor := clWindowText; edConnz.Style.TextColor := clWindowText; edConnDrawFigurePercent.Style.TextColor := clWindowText; SetUOM; SetMaskEdits; ClearAllProperties; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.FormShow', E.Message); end; end; procedure TF_SCSObjectsProp.ClearAllProperties; begin try AngleEdited := False; xEdited := False; yEdited := False; zEdited := False; GsEdited := False; edConnAngle.Style.TextColor := clWindowText; edConnX.Style.TextColor := clWindowText; edConny.Style.TextColor := clWindowText; edConnz.Style.TextColor := clWindowText; edConnDrawFigurePercent.Style.TextColor := clWindowText; // Connector edConnName.Text := ''; edConnName.Enabled := false; edConnWidth.Text := ''; edConnWidth.Enabled := false; edConnHeight.Text := ''; edConnHeight.Enabled := false; edConnAngle.Text := ''; edConnAngle.Enabled := false; edConnX.Text := ''; edConnX.Enabled := false; edConnY.Text := ''; edConnY.Enabled := false; edConnZ.Text := ''; edConnZ.Enabled := false; edConnDrawFigurePercent.Text := ''; edConnDrawFigurePercent.Enabled := false; cbConnForAllSameType.Enabled := false; mConnCaptionsGroup.Text := ''; mConnCaptionsGroup.Enabled := false; mConnNotesGroup.Text := ''; mConnNotesGroup.Enabled := false; imgConnBlock.Clear; imgConnBlock.Enabled := false; bConnBlockChange.Enabled := false; tbConn_UpLeftSide.Down := false; tbConn_UpLeftSide.Enabled := false; tbConn_UpRightSide.Down := false; tbConn_UpRightSide.Enabled := false; tbConn_DownLeftSide.Down := false; tbConn_DownLeftSide.Enabled := false; tbConn_DownRightSide.Down := false; tbConn_DownRightSide.Enabled := false; tbConn_CaptionUp.Down := false; tbConn_CaptionUp.Enabled := false; tbConn_CaptionDown.Down := false; tbConn_CaptionDown.Enabled := false; tbConn_CaptionLeft.Down := false; tbConn_CaptionLeft.Enabled := false; tbConn_CaptionRight.Down := false; tbConn_CaptionRight.Enabled := false; cbConnShowCaptions.Checked := false; cbConnShowCaptions.Enabled := false; cbConnShowNotes.Checked := false; cbConnShowNotes.Enabled := false; bConnBlockClear.Enabled := False; rbCornerNone.Checked := false; rbCornerNone.Enabled := false; rbCornerOut.Checked := false; rbCornerOut.Enabled := false; rbCornerIn.Checked := false; rbCornerIn.Enabled := false; rbCornerVertical.Checked := false; rbCornerVertical.Enabled := false; rbCornerAdapter.Checked := false; rbCornerAdapter.Enabled := false; cbConnCaptionsFontSize.Text := ''; cbConnCaptionsFontSize.Enabled := False; cbConnNotesFontSize.Text := ''; cbConnNotesFontSize.Enabled := False; cbConnCaptionsFontColor.ColorValue := clNone; cbConnCaptionsFontColor.Enabled := False; cbConnNotesFontColor.ColorValue := clNone; cbConnNotesFontColor.Enabled := False; bConnOK.Enabled := False; // Ortholine edLineName.Text := ''; edLineName.Enabled := false; edLineGap.Text := ''; edLineGap.Enabled := false; edLineCount.Text := ''; edLineCount.Enabled := false; edLineAutoLength.Text := ''; edLineAutoLength.Enabled := false; edLineUserLength.Text := ''; edLineUserLength.Enabled := false; edLineCaption.Text := ''; edLineCaption.Enabled := false; edLineName.Text := ''; edLineName.Enabled := false; edLineAngle.Text := ''; edLineAngle.Enabled := false; edLineX.Text := ''; edLineX.Enabled := false; edLineY.Text := ''; edLineY.Enabled := false; edLineZ.Text := ''; edLineZ.Enabled := false; edLineDrawFigurePercent.Text := ''; edLineDrawFigurePercent.Enabled := false; cbLineForAllSameType.Enabled := false; //02.04.2012 rbLineAutoLength.Enabled := false; //02.04.2012 rbLineUserLength.Enabled := false; cbUserLength.Enabled := False; //02.04.2012 cbLineShowLength.Checked := false; cbLineShowLength.Enabled := false; cbLineShowBlock.Checked := false; cbLineShowBlock.Enabled := false; edLineBlockStep.Text := ''; edLineBlockStep.Enabled := false; mLineCaptionsGroup.Clear; mLineCaptionsGroup.Enabled := false; mLineNotesGroup.Clear; mLineNotesGroup.Enabled := false; imgLineBlock.Clear; imgLineBlock.Enabled := false; bLineBlockChange.Enabled := false; tbLine_UpLeftSide.Down := false; tbLine_UpLeftSide.Enabled := false; tbLine_UpRightSide.Down := false; tbLine_UpRightSide.Enabled := false; tbLine_DownLeftSide.Down := false; tbLine_DownLeftSide.Enabled := false; tbLine_DownRightSide.Down := false; tbLine_DownRightSide.Enabled := false; tbLine_OverLine.Down := false; tbLine_OverLine.Enabled := false; tbLine_UnderLine.Down := false; tbLine_UnderLine.Enabled := false; //Tolik -- 02/12/2015 tbLine_Auto.Down := false; tbLine_Auto.Enabled := false; tbLine_Center.Down := false; tbLine_Center.Enabled := false; // cbLineShowCaptions.Checked := false; cbLineShowCaptions.Enabled := false; cbLineShowNotes.Checked := false; cbLineShowNotes.Enabled := false; cbTraceColor.ColorValue := clNone; cbTraceColor.Enabled := False; cbTraceStyle.Enabled := False; edTraceWidth.Text := '1'; edTraceWidth.Enabled := False; bLineBlockClear.Enabled := False; cbLineCaptionsFontSize.Text := ''; cbLineCaptionsFontSize.Enabled := False; cbLineCaptionsFontBold.Checked := False; cbLineCaptionsFontBold.Enabled := False; cbLineNotesFontSize.Text := ''; cbLineNotesFontSize.Enabled := False; bLineDrawPlus.Enabled := false; bLineDrawMinus.Enabled := false; cbLineCaptionsFontColor.ColorValue := clNone; cbLineCaptionsFontColor.Enabled := False; cbLineNotesFontColor.ColorValue := clNone; cbLineNotesFontColor.Enabled := False; bLineOK.Enabled := False; // From Oleg seConnIndex.Enabled := false; seConnIndex.Value := 0; seLineIndex.Enabled := false; seLineIndex.Value := 0; //10.08.2012 cbConnIndexWithName.Checked := true; cbLineIndexWithName.Checked := true; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ClearAllProperties', E.Message); end; end; procedure TF_SCSObjectsProp.LoadConnectorProperties(AObject: TConnectorObject); var ClickFigureX: Double; ClickFigureY: Double; ClickFigureZ: Double; ClickFigureAngle: Double; inFigure: TFigure; i: integer; MapScale: Double; Bitmap: TBitmap; ObjectParams: TObjectParams; begin try // очистить структуру if FConnProp <> nil then begin FreeMem(FConnProp); FConnProp := nil; end; MapScale := GCadForm.PCad.MapScale; CaptionsLHandle := GCadForm.PCad.GetLayerHandle(4); NotesLHandle := GCadForm.PCad.GetLayerHandle(6); // ДЛЯ ГРУППЫ ОБЪЕКТОВ if GCadForm.PCad.SelectedCount > 1 then begin LoadPropertiesForFewConnectors; end; // Подписи к точ. объекту mConnCaptionsGroup.Lines.Clear; if AObject.OutTextCaptions.Count > 0 then begin if GCadForm.FShowObjectCaptionsType = st_Short then begin mConnCaptionsGroup.Lines.Add(AObject.OutTextCaptions[0]); end else begin for i := 1 to AObject.OutTextCaptions.Count - 1 do begin mConnCaptionsGroup.Lines.Add(AObject.OutTextCaptions[i]); end; end; end; // if GCadForm.FSCSType = st_External then // mConnCaptionsGroup.Enabled := false // else begin if AObject.ConnectorType = Ct_Clear then mConnCaptionsGroup.Enabled := False else mConnCaptionsGroup.Enabled := True; end; // Выноски к точ. объекту mConnNotesGroup.Lines.Clear; for i := 0 to AObject.OutTextNotes.Count - 1 do begin mConnNotesGroup.Lines.Add(AObject.OutTextNotes[i]); end; // if GCadForm.FSCSType = st_External then // mConnNotesGroup.Enabled := False // else begin if AObject.ConnectorType = Ct_Clear then mConnNotesGroup.Enabled := False else mConnNotesGroup.Enabled := True; end; // Имя обьекта edConnName.Text := AObject.Name; // Ширина edConnWidth.Text := FormatFloat(ffMask, MetreToUOM(AObject.GrpSizeX * MapScale / 1000)); // Высота edConnHeight.Text := FormatFloat(ffMask, MetreToUOM(AObject.GrpSizeY * MapScale / 1000)); // Угол поворота edConnAngle.Text := FormatFloat(ffMask, AObject.FDrawFigureAngle / pi * 180); // Расположение по X if (AObject.ConnectorType = ct_Clear) and (AObject.JoinedConnectorsList.Count > 0) then edConnX.Enabled := False else edConnX.Enabled := True; ClickFigureX := AObject.ActualPoints[1].x * Mapscale / 1000; edConnX.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureX)); // Расположение по Y if (AObject.ConnectorType = ct_Clear) and (AObject.JoinedConnectorsList.Count > 0) then edConnY.Enabled := False else edConnY.Enabled := True; ClickFigureY := AObject.ActualPoints[1].y * Mapscale / 1000; edConnY.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureY)); // Расположение по Z if GCadForm.FShowLineCaptionsType = skExternalSCS then begin edConnZ.Enabled := GAllowExternalListCoordZ; //22.08.2012 False; ClickFigureZ := AObject.ActualZOrder[1]; edConnZ.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureZ)); end else begin if (AObject.ConnectorType = ct_Clear) and (AObject.JoinedConnectorsList.Count > 0) then begin edConnZ.Enabled := False; ClickFigureZ := AObject.ActualZOrder[1]; edConnZ.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureZ)); end else begin if AObject.FConnRaiseType <> crt_None then begin if AObject.FConnRaiseType = crt_OnFloor then edConnZ.Enabled := True else edConnZ.Enabled := False; end else edConnZ.Enabled := True; ClickFigureZ := AObject.ActualZOrder[1]; edConnZ.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureZ)); end; end; // загрузить BMP imgConnBlock.Clear; imgConnBlock.Picture.Bitmap.FreeImage; // Bitmap := GetObjIcon(AObject.FBlockID, AObject.FBlockGUID, AObject.FObjectType); Bitmap := GetObjIconForFigure(GCadForm.FCADListID, AObject.ID, AObject.FBlockID, AObject.FBlockGUID, AObject.FObjectType); imgConnBlock.Picture.Bitmap := Bitmap; // Вид отображения выноски if AObject.FNotesRowsType = nr_UpLeftSide then tbConn_UpLeftSide.Down := True; if AObject.FNotesRowsType = nr_DownLeftSide then tbConn_DownLeftSide.Down := True; if AObject.FNotesRowsType = nr_UpRightSide then tbConn_UpRightSide.Down := True; if AObject.FNotesRowsType = nr_DownRightSide then tbConn_DownRightSide.Down := True; // Вид отображения подписи if AObject.FCaptionsViewType = cv_Up then tbConn_CaptionUp.Down := True; if AObject.FCaptionsViewType = cv_Down then tbConn_CaptionDown.Down := True; if AObject.FCaptionsViewType = cv_Left then tbConn_CaptionLeft.Down := True; if AObject.FCaptionsViewType = cv_Right then tbConn_CaptionRight.Down := True; // флаг отображения подписей cbConnShowCaptions.AllowGrayed := True; if {(GCadForm.FSCSType <> st_External) and }(AObject.ConnectorType <> ct_Clear) and (AObject.ShowCaptions) and (AObject.FConnRaiseType = crt_None) then begin cbConnShowCaptions.Checked := True; mConnCaptionsGroup.Enabled := True; end else begin cbConnShowCaptions.Checked := False; mConnCaptionsGroup.Enabled := False; end; cbConnShowCaptions.State := cbGrayed; // флаг отображения выносок cbConnShowNotes.AllowGrayed := True; if {(GCadForm.FSCSType <> st_External) and }(AObject.ConnectorType <> ct_Clear) and (AObject.ShowNotes) and (AObject.FConnRaiseType = crt_None) then begin cbConnShowNotes.Checked := True; mConnNotesGroup.Enabled := True; end else begin cbConnShowNotes.Checked := False; mConnNotesGroup.Enabled := False; end; cbConnShowNotes.State := cbGrayed; // тип уголка if AObject.FCornerType = crn_None then rbCornerNone.Checked := True; if AObject.FCornerType = crn_Out then rbCornerOut.Checked := True; if AObject.FCornerType = crn_In then rbCornerIn.Checked := True; if AObject.FCornerType = crn_Vertical then rbCornerVertical.Checked := True; if AObject.FCornerType = crn_Adapter then rbCornerAdapter.Checked := True; // размер шрифта подписей/выносок cbConnCaptionsFontSize.Text := IntToStr(AObject.FCaptionsFontSize); cbConnCaptionsFontColor.ColorValue := AObject.FCaptionsFontColor; cbConnNotesFontSize.Text := IntToStr(AObject.FNotesFontSize); cbConnNotesFontColor.ColorValue := AObject.FNotesFontColor; edConnDrawFigurePercent.Text := FormatFloat(ffMask, AObject.FDrawFigurePercent); if edConnDrawFigurePercent.Enabled then begin if AObject.ConnectorType = ct_Clear then begin edConnDrawFigurePercent.Enabled := False; end else begin if CheckTrunkObject(AObject) then edConnDrawFigurePercent.Enabled := False else edConnDrawFigurePercent.Enabled := True; end; end; if cbConnForAllSameType.Enabled then cbConnForAllSameType.Checked := False; // Index seConnIndex.Value := 0; ObjectParams := GetFigureParams(AObject.ID); seConnIndex.Value := ObjectParams.MarkID; cbConnIndexWithName.Checked := IntToBool(ObjectParams.IndexWithName); // сохранить структуру New(FConnProp); SaveConnProp(FConnProp); FClickConn := AObject; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadConnectorProperties', E.Message); end; end; procedure TF_SCSObjectsProp.LoadOrtholineProperties(AObject: TOrtholine); var ClickFigureX: Double; ClickFigureY: Double; ClickFigureZ: Double; ClickFigureAngle: Double; i: integer; MapScale: Double; Bitmap: TBitmap; ObjectParams: TObjectParams; begin try // очистить структуру if FLineProp <> nil then begin FreeMem(FLineProp); FLineProp := nil; end; MapScale := GCadForm.PCad.MapScale; CaptionsLHandle := GCadForm.PCad.GetLayerHandle(3); NotesLHandle := GCadForm.PCad.GetLayerHandle(5); // ДЛЯ ГРУППЫ ОБЪЕКТОВ if GCadForm.PCad.SelectedCount > 1 then begin LoadPropertiesForFewOrtholines; end; // Gap edLineGap.Text := FormatFloat(ffMask, AObject.FGap); // Count edLineCount.Text := IntToStr(AObject.FCount); // Длинна линии if AObject.UserLength = -1 then // автоматическая begin //02.04.2012 rbLineAutoLength.Checked := True; edLineAutoLength.Enabled := Not FIsMultiSelection; edLineUserLength.Enabled := False; cbUserLength.Checked := false; //02.04.2012 edLineAutoLength.Text := FormatFloat(ffMask, MetreToUOM(AObject.LineLength)); edLineUserLength.Text := FormatFloat(ffMask, MetreToUOM(AObject.LineLength)); end else // пользовательская begin //02.04.2012 rbLineUserLength.Checked := True; //02.04.2012 edLineAutoLength.Enabled := False; edLineUserLength.Enabled := True; edLineAutoLength.Enabled := Not FIsMultiSelection; cbUserLength.Checked := True; //02.04.2012 edLineAutoLength.Text := FormatFloat(ffMask, MetreToUOM(AObject.CalculLength)); edLineUserLength.Text := FormatFloat(ffMask, MetreToUOM(AObject.LineLength)); end; // подписи к трассе // !!! mLineCaptionsGroup.Lines.Clear; if AObject.OutTextCaptions.Count > 0 then begin if GCadForm.FShowLineCaptionsType = skExternalSCS then begin for i := 0 to AObject.OutTextCaptions.Count - 1 do begin if i <> 1 then begin mLineCaptionsGroup.Lines.Add(AObject.OutTextCaptions[i]); end; end; end else begin // Tolik -- 11/04/2017 -- не добавлять пустые строки в подпись трассы, если установлена // опция "не отображать длину" или отображать длину, но выравнивание стоит не по центру if AObject.ShowLength then begin // for i := 0 to AObject.OutTextCaptions.Count - 1 do begin if i <> 0 then begin if (AObject.FCaptionsViewType <> cv_Center) then begin if AObject.OutTextCaptions[i] <> '' then mLineCaptionsGroup.Lines.Add(AObject.OutTextCaptions[i]); end else mLineCaptionsGroup.Lines.Add(AObject.OutTextCaptions[i]); end; end; end // / Tolik -- 11/04/2017 -- else begin for i := 0 to AObject.OutTextCaptions.Count - 1 do begin if ((i <> 0) and (AObject.OutTextCaptions[i] <> '')) then begin mLineCaptionsGroup.Lines.Add(AObject.OutTextCaptions[i]); end; end; end; end; end; // выноски к трассе mLineNotesGroup.Lines.Clear; for i := 0 to AObject.OutTextNotes.Count - 1 do begin mLineNotesGroup.Lines.Add(AObject.OutTextNotes[i]); end; // Подпись к мультилинии if AObject.FCount <> 1 then begin edLineCaption.Enabled := True; edLineCaption.Text := TTextMod(AObject.MultilineCaptionBox).Text; end else edLineCaption.Enabled := False; // Имя обьекта edLineName.Text := AObject.Name; // Угол поворота ClickFigureAngle := GetLineAngle(AObject.ActualPoints[1], AObject.ActualPoints[2]); edLineAngle.Text := FormatFloat(ffMask, ClickFigureAngle); // Расположение по X edLineX.Enabled := False; if FGroupObjectsList.Count = 0 then if IfTraceVertical(AObject) then edLineX.Enabled := True; ClickFigureX := AObject.ActualPoints[1].x * Mapscale / 1000; edLineX.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureX)); // Расположение по Y edLineY.Enabled := False; if FGroupObjectsList.Count = 0 then if IfTraceHorizontal(AObject) then edLineY.Enabled := True; ClickFigureY := AObject.ActualPoints[1].y * Mapscale / 1000; edLineY.Text := FormatFloat(ffMask, MetreToUOM(ClickFigureY)); // Расположение по Z if ((GCadForm.FShowLineCaptionsType = skExternalSCS) and Not GAllowExternalListCoordZ) or (AObject.FIsRaiseUpDown) or (AObject.FIsVertical) then edLineZ.Enabled := False else edLineZ.Enabled := True; if not AObject.FIsRaiseUpDown and (AObject.ActualZOrder[1] = AObject.ActualZOrder[2]) then edLineZ.Text := FormatFloat(ffMask, MetreToUOM(AObject.ActualZOrder[1])) else edLineZ.Text := ''; // флаг отображения усл.обозначения cbLineShowBlock.AllowGrayed := True; if AObject.IsShowBlock then cbLineShowBlock.Checked := True else cbLineShowBlock.Checked := False; cbLineShowBlock.State := cbGrayed; // шаг усл.обозначения edLineBlockStep.Text := FormatFloat(ffMask, AObject.BlockStep); // загрузить BMP imgLineBlock.Clear; imgLineBlock.Picture.Bitmap.FreeImage; // Bitmap := GetObjIcon(AObject.FBlockID, AObject.FBlockGUID, AObject.FObjectType); Bitmap := GetObjIconForFigure(GCadForm.FCADListID, AObject.ID, AObject.FBlockID, AObject.FBlockGUID, AObject.FObjectType); imgLineBlock.Picture.Bitmap := Bitmap; // Вид отображения выноски if AObject.FNotesRowsType = nr_UpLeftSide then tbLine_UpLeftSide.Down := True; if AObject.FNotesRowsType = nr_DownLeftSide then tbLine_DownLeftSide.Down := True; if AObject.FNotesRowsType = nr_UpRightSide then tbLine_UpRightSide.Down := True; if AObject.FNotesRowsType = nr_DownRightSide then tbLine_DownRightSide.Down := True; // Вид отображения подписи // Tolik -- 08/12/2015 // состояние кнопочек здесь нужно сначала сбросить, а то если форма уже видимая и просто // выбирать на Каде по очереди линии с разным состоянием отображения подписи, остаются состояния предидущих линий {tbLine_OverLine.Down := False; tbLine_UnderLine.Down := False; tbLine_Center.Down := False; tbLine_Auto.Down := False;} // if AObject.FCaptionsViewType = cv_OverLine then tbLine_OverLine.Click; if AObject.FCaptionsViewType = cv_UnderLine then tbLine_UnderLine.Click; // Tolik -- 02/12/2015 if AObject.FCaptionsViewType = cv_Center then tbLine_Center.Click; if AObject.FCaptionsViewType = cv_Auto then tbLine_Auto.Click; // цвет трассы cbTraceColor.ColorValue := AObject.FTraceColor; // стиль трассы cbTraceStyle.ItemIndex := ord(AObject.FTraceStyle); // ширина трассы edTraceWidth.Text := IntToStr(AObject.FTraceWidth); // флаг отображения подписей cbLineShowCaptions.AllowGrayed := True; if AObject.ShowCaptions then if AObject.ShowLength then begin cbLineShowCaptions.Checked := True; mLineCaptionsGroup.Enabled := True; end else begin cbLineShowCaptions.Checked := False; mLineCaptionsGroup.Enabled := False; end; cbLineShowCaptions.State := cbGrayed; // флаг отображать длинну линии cbLineShowLength.AllowGrayed := True; if AObject.ShowLength then // begin cbLineShowLength.Checked := True; // Tolik 08/04/2017 -- cbLineShowLength.State := cbGrayed; // end else cbLineShowLength.Checked := False; // Tolik 05/04/2017 -- cbLineShowLength.State := cbGrayed -- сразу выставит и checked поэтому ... // cbLineShowLength.State := cbGrayed; // флаг отображения выносок cbLineShowNotes.AllowGrayed := True; if AObject.ShowNotes then begin cbLineShowNotes.Checked := True; mLineNotesGroup.Enabled := True; end else begin cbLineShowNotes.Checked := False; mLineNotesGroup.Enabled := False; end; cbLineShowNotes.State := cbGrayed; // размер шрифта подписей/выносок cbLineCaptionsFontSize.Text := IntToStr(AObject.FCaptionsFontSize); cbLineCaptionsFontBold.AllowGrayed := True; cbLineCaptionsFontBold.Checked := AObject.FCaptionsFontBold; cbLineCaptionsFontBold.State := cbGrayed; cbLineCaptionsFontColor.ColorValue := AObject.FCaptionsFontColor; cbLineNotesFontSize.Text := IntToStr(AObject.FNotesFontSize); cbLineNotesFontColor.ColorValue := AObject.FNotesFontColor; // DrawFigure Percent edLineDrawFigurePercent.Text := FormatFloat(ffMask, AObject.FDrawFigurePercent); if edLineDrawFigurePercent.Enabled then begin if AObject.DrawFigure <> nil then begin if AObject.DrawFigure.InFigures.Count > 0 then edLineDrawFigurePercent.Enabled := True else edLineDrawFigurePercent.Enabled := False; end else edConnDrawFigurePercent.Enabled := False; end; if cbLineForAllSameType.Enabled then cbLineForAllSameType.Checked := False; // BLOCKING LENGTH FIELDS { if cbLineShowCaptions.Checked then begin gbLengthChange.Enabled := True; end else begin gbLengthChange.Enabled := False; end; } // Index seLineIndex.Value := 0; ObjectParams := GetFigureParams(AObject.ID); seLineIndex.Value := ObjectParams.MarkID; cbLineIndexWithName.Checked := IntToBool(ObjectParams.IndexWithName); // сохранить структуру New(FLineProp); SaveLineProp(FLineProp); FClickLine := AObject; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadOrtholineProperties', E.Message); end; end; procedure TF_SCSObjectsProp.bConnOKClick(Sender: TObject); begin try ConnOKExecute; AngleEdited := False; xEdited := False; yEdited := False; zEdited := False; GsEdited := False; edConnAngle.Style.TextColor := clBlack; edConnX.Style.TextColor := clBlack; edConny.Style.TextColor := clBlack; edConnz.Style.TextColor := clBlack; edConnDrawFigurePercent.Style.TextColor := clBlack; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bConnOKClick', E.Message); end; end; procedure TF_SCSObjectsProp.bLineOKClick(Sender: TObject); begin try LineOKExecute; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bLineOKClick', E.Message); end; end; procedure TF_SCSObjectsProp.FormClose(Sender: TObject; var Action: TCloseAction); begin try if FConnProp <> nil then begin FreeMem(FConnProp); FConnProp := nil; end; if FLineProp <> nil then begin FreeMem(FLineProp); FLineProp := nil; end; FSCS_Main.aViewSCSObjectsProp.Checked := False; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.FormClose', E.Message); end; end; procedure TF_SCSObjectsProp.edLineNameKeyPress(Sender: TObject; var Key: Char); var t: integer; begin try if Key = #13 then begin bLineOK.SetFocus; if Sender is TComponent then begin t := TComponent(sender).tag; LineOKExecute(t); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineNameKeyPress', E.Message); end; end; procedure TF_SCSObjectsProp.edConnNameKeyPress(Sender: TObject; var Key: Char); var t: Integer; begin try if Key = #13 then begin bConnOK.SetFocus; if Sender is TComponent then begin t := TComponent(sender).tag; ConnOKExecute(t); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnNameKeyPress', E.Message); end; end; procedure TF_SCSObjectsProp.OrtholinePropertiesForRaise; begin try edLineName.Enabled := True; cbTraceColor.ColorValue := clNone; if GCadForm.FKeepLineTypesRules then cbTraceColor.Enabled := False else cbTraceColor.Enabled := True; cbTraceStyle.Enabled := False; edTraceWidth.Enabled := False; // Длина //02.04.2012 rbLineAutoLength.Enabled := True; //02.04.2012 rbLineUserLength.Enabled := True; cbUserLength.Enabled := True; edLineAutoLength.Enabled := True; edLineUserLength.Enabled := True; // Подписи и выноски cbLineShowLength.Enabled := True; cbLineShowCaptions.Enabled := True; cbLineShowNotes.Enabled := True; mLineCaptionsGroup.Enabled := True; mLineNotesGroup.Enabled := True; // edLineGap.Enabled := False; edLineCount.Enabled := False; edLineAngle.Enabled := False; edLineX.Enabled := False; edLineY.Enabled := False; edLineZ.Enabled := False; edLineDrawFigurePercent.Enabled := True; //10.01.2013 False; cbLineForAllSameType.Enabled := True; //10.01.2013 False; edLineCaption.Enabled := False; cbLineShowBlock.Checked := False; tbLine_UpLeftSide.Down := False; tbLine_UpRightSide.Down := False; tbLine_DownLeftSide.Down := False; tbLine_DownRightSide.Down := False; tbLine_OverLine.Down := False; tbLine_UnderLine.Down := False; // Tolik -- 02/12/2015 tbLine_Center.Down := False; tbLine_Auto.Down := False; // bLineDrawPlus.Enabled := False; bLineDrawMinus.Enabled := False; edLineBlockStep.Enabled := False; bLineBlockClear.Enabled := False; imgLineBlock.Clear; imgLineBlock.Enabled := False; bLineBlockChange.Enabled := False; if Not GCadForm.FListSettings.CADShowRaiseDrawFigure then begin cbLineShowBlock.Enabled := False; end else begin cbLineShowBlock.Enabled := True; end; tbLine_UpLeftSide.Enabled := False; tbLine_UpRightSide.Enabled := False; tbLine_DownLeftSide.Enabled := False; tbLine_DownRightSide.Enabled := False; tbLine_OverLine.Enabled := False; tbLine_UnderLine.Enabled := False; // Tolik -- 02/12/2015 tbLine_Center.Enabled := False; tbLine_Auto.Enabled := False; // cbLineCaptionsFontSize.Enabled := True; cbLineCaptionsFontBold.Enabled := True; cbLineCaptionsFontColor.Enabled := True; cbLineNotesFontSize.Enabled := True; cbLineNotesFontColor.Enabled := True; bLineOK.Enabled := True; // From Oleg seLineIndex.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.OrtholinePropertiesForRaise', E.Message); end; end; procedure TF_SCSObjectsProp.OrtholinePropertiesForNormal; begin try edLineName.Enabled := True; //02.04.2012 rbLineAutoLength.Enabled := True; //02.04.2012 rbLineUserLength.Enabled := True; cbUserLength.Enabled := True; edLineAutoLength.Enabled := True; edLineUserLength.Enabled := True; edLineGap.Enabled := True; edLineCount.Enabled := True; edLineAngle.Enabled := True; edLineX.Enabled := True; edLineY.Enabled := True; if GCadForm.FShowLineCaptionsType = skExternalSCS then edLineZ.Enabled := GAllowExternalListCoordZ //22.08.2012 false else edLineZ.Enabled := True; edLineDrawFigurePercent.Enabled := True; cbLineForAllSameType.Enabled := True; cbLineShowLength.Enabled := True; cbLineShowBlock.Enabled := True; edLineBlockStep.Enabled := True; imgLineBlock.Enabled := True; bLineBlockChange.Enabled := True; tbLine_UpLeftSide.Enabled := True; tbLine_UpRightSide.Enabled := True; tbLine_DownLeftSide.Enabled := True; tbLine_DownRightSide.Enabled := True; tbLine_OverLine.Enabled := True; tbLine_UnderLine.Enabled := True; // Tolik tbLine_Center.Enabled := True; //tbLine_Auto.Enabled := True; // bLineBlockClear.Enabled := True; if GCadForm.FKeepLineTypesRules then begin cbTraceColor.Enabled := False; cbTraceStyle.Enabled := False; edTraceWidth.Enabled := False; end else begin cbTraceColor.Visible := True; cbTraceColor.Enabled := True; cbTraceStyle.Enabled := True; edTraceWidth.Enabled := True; end; cbLineShowCaptions.Enabled := True; cbLineShowNotes.Enabled := True; if cbLineShowCaptions.Checked then mLineCaptionsGroup.Enabled := True else mLineCaptionsGroup.Enabled := False; if cbLineShowNotes.Checked then mLineNotesGroup.Enabled := True else mLineNotesGroup.Enabled := False; cbLineCaptionsFontSize.Enabled := True; cbLineCaptionsFontBold.Enabled := True; cbLineCaptionsFontColor.Enabled := True; cbLineNotesFontSize.Enabled := True; cbLineNotesFontColor.Enabled := True; bLineDrawPlus.Enabled := True; bLineDrawMinus.Enabled := True; // From Oleg seLineIndex.Enabled := true; bLineOK.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.OrtholinePropertiesForNormal', E.Message); end; end; procedure TF_SCSObjectsProp.bConnCloseClick(Sender: TObject); begin Close; end; procedure TF_SCSObjectsProp.bLineCloseClick(Sender: TObject); begin Close; end; procedure TF_SCSObjectsProp.ChangeLineBlockStep(aObject: TOrthoLine; aBlockStep: Double); begin try aObject.BlockStep := aBlockStep; aObject.ReCreateDrawFigureBlock; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineBlockStep', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineShowBlock(aObject: TOrthoLine; aShowBlock: Boolean); begin try aObject.IsShowBlock := aShowBlock; if aObject.DrawFigure <> nil then aObject.DrawFigure.Visible := aObject.IsShowBlock; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineShowBlock', E.Message); end; end; procedure TF_SCSObjectsProp.bLineBlockChangeClick(Sender: TObject); begin try ChangeLineBlock(FClickLine); if FLineProp.fBlock <> imgLineBlock.Picture.Bitmap then FClickLine.FIsBlockChanged := True; FClickLine.Select; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bLineBlockChangeClick', E.Message); end; end; procedure TF_SCSObjectsProp.bConnBlockChangeClick(Sender: TObject); begin try ChangeConnBlock(FClickConn); if FConnProp.fBlock <> imgConnBlock.Picture.Bitmap then FClickConn.FIsBlockChanged := True; FClickConn.Select; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bConnBlockChangeClick', E.Message); end; end; // подгрузить другой блок для коннекторов procedure TF_SCSObjectsProp.ChangeConnBlock(aObject: TConnectorObject); var i: Integer; ObjIconParams: TObjectIconParams; IconID: Integer; IconGUID: string; IconBLK: TMemoryStream; IconBMP: TBitmap; IconList: TObjectList; ApplyConn: TConnectorObject; ApplyList: TList; SelFigure: TFigure; SelList: TList; begin try ObjIconParams := ChangeObjIconInCAD(aObject.ID, aObject.FBlockGUID, aObject.FObjectType); if ObjIconParams.Executed then begin IconID := ObjIconParams.IDIcon; IconGUID := ObjIconParams.GUIDIcon; IconBLK := ObjIconParams.IconBLK; IconBMP := ObjIconParams.IconBMP; aObject.FBlockID := IconID; aObject.FBlockGUID := IconGUID; imgConnBlock.Picture.Bitmap := IconBMP; IconList := TObjectList.Create; IconList.Add(IconBLK); GCanRefreshProperties := False; SelList := TList.Create; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; ApplyList := FGroupObjectsList; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; SetBlockForConnObject(aObject, IconList); for i := 0 to ApplyList.Count - 1 do begin ApplyConn := TConnectorObject(ApplyList[i]); if ApplyConn <> aObject then SetBlockForConnObject(ApplyConn, IconList); end; // *UNDO* GCadForm.FCanSaveForUndo := True; // перевыделить группу if (not aObject.Deleted) and CheckFigureByClassName(aObject, cTConnectorObject) then begin aObject.Select; end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTConnectorObject) or CheckFigureByClassName(SelFigure, cTOrthoLine) then begin if not SelFigure.Deleted then if SelFigure <> aObject then SelFigure.Select; end; end; RefreshCAD(GCadForm.Pcad); FreeAndNil(SelList); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnBlock', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnCornerType(aObject: TConnectorObject; aCornerType: TCornerType); begin try aObject.FCornerType := aCornerType; aObject.FCornerTypeChangedByUser := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnCornerType', E.Message); end; end; // подгрузить другой блок для линий procedure TF_SCSObjectsProp.ChangeLineBlock(aObject: TOrthoLine); var i: Integer; ObjIconParams: TObjectIconParams; IconID: Integer; IconGUID: string; IconBLK: TMemoryStream; IconBMP: TBitmap; IconList: TObjectList; ApplyLine: TOrthoLine; ApplyList: TList; SelFigure: TFigure; SelList: TList; begin try ObjIconParams := ChangeObjIconInCAD(aObject.ID, aObject.FBlockGUID, aObject.FObjectType); if ObjIconParams.Executed then begin IconID := ObjIconParams.IDIcon; IconGUID := ObjIconParams.GUIDIcon; IconBLK := ObjIconParams.IconBLK; IconBMP := ObjIconParams.IconBMP; aObject.FBlockID := IconID; aObject.FBlockGUID := IconGUID; imgLineBlock.Picture.Bitmap := IconBMP; IconList := TObjectList.Create; IconList.Add(IconBLK); GCanRefreshProperties := False; SelList := TList.Create; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; ApplyList := FGroupObjectsList; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; SetBlockForLineObject(aObject, IconList, nil); for i := 0 to ApplyList.Count - 1 do begin ApplyLine := TOrthoLine(ApplyList[i]); if ApplyLine <> aObject then SetBlockForLineObject(ApplyLine, IconList, nil); end; // *UNDO* GCadForm.FCanSaveForUndo := True; // перевыделить группу if (not aObject.Deleted) and CheckFigureByClassName(aObject, cTConnectorObject) then begin aObject.Select; end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTConnectorObject) or CheckFigureByClassName(SelFigure, cTOrthoLine) then if not SelFigure.Deleted then if SelFigure <> aObject then SelFigure.Select; end; RefreshCAD(GCadForm.Pcad); FreeAndNil(SelList); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineBlock', E.Message); end; end; procedure TF_SCSObjectsProp.ConnectorPropertiesForRaise; begin try edConnName.Enabled := True; edConnWidth.Enabled := False; edConnHeight.Enabled := False; edConnAngle.Enabled := False; edConnX.Enabled := False; edConnY.Enabled := False; if GCadForm.FShowLineCaptionsType = skExternalSCS then edConnZ.Enabled := GAllowExternalListCoordZ //22.08.2012 False else edConnZ.Enabled := True; edConnDrawFigurePercent.Enabled := False; cbConnForAllSameType.Enabled := False; mConnCaptionsGroup.Enabled := False; mConnNotesGroup.Enabled := False; imgConnBlock.Clear; imgConnBlock.Enabled := False; bConnBlockChange.Enabled := False; tbConn_UpLeftSide.Down := False; tbConn_UpRightSide.Down := False; tbConn_DownLeftSide.Down := False; tbConn_DownRightSide.Down := False; tbConn_UpLeftSide.Enabled := False; tbConn_UpRightSide.Enabled := False; tbConn_DownLeftSide.Enabled := False; tbConn_DownRightSide.Enabled := False; tbConn_CaptionUp.Down := false; tbConn_CaptionUp.Enabled := false; tbConn_CaptionDown.Down := false; tbConn_CaptionDown.Enabled := false; tbConn_CaptionLeft.Down := false; tbConn_CaptionLeft.Enabled := false; tbConn_CaptionRight.Down := false; tbConn_CaptionRight.Enabled := false; cbConnShowCaptions.Checked := False; cbConnShowCaptions.Enabled := False; cbConnShowNotes.Checked := False; cbConnShowNotes.Enabled := False; bConnBlockClear.Enabled := False; rbCornerNone.Checked := true; rbCornerNone.Enabled := true; rbCornerOut.Checked := true; rbCornerOut.Enabled := true; rbCornerIn.Checked := true; rbCornerIn.Enabled := true; rbCornerVertical.Checked := true; rbCornerVertical.Enabled := true; rbCornerAdapter.Checked := true; rbCornerAdapter.Enabled := true; cbConnCaptionsFontSize.Enabled := False; cbConnCaptionsFontColor.Enabled := False; cbConnNotesFontSize.Enabled := False; cbConnNotesFontColor.Enabled := False; bConnOK.Enabled := True; // From Oleg seConnIndex.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ConnectorPropertiesForRaise', E.Message); end; end; procedure TF_SCSObjectsProp.ConnectorPropertiesForNormal(AConnType: TConnectorType); begin try if AConnType = ct_Clear then begin edConnName.Enabled := true; edConnWidth.Enabled := false; edConnHeight.Enabled := false; edConnAngle.Enabled := false; edConnX.Enabled := true; edConnY.Enabled := true; edConnZ.Enabled := True; edConnDrawFigurePercent.Enabled := false; cbConnForAllSameType.Enabled := false; mConnCaptionsGroup.Enabled := false; mConnNotesGroup.Enabled := false; imgConnBlock.Clear; imgConnBlock.Enabled := false; bConnBlockChange.Enabled := false; tbConn_UpLeftSide.Down := false; tbConn_UpRightSide.Down := false; tbConn_DownLeftSide.Down := false; tbConn_DownRightSide.Down := false; tbConn_UpLeftSide.Enabled := false; tbConn_UpRightSide.Enabled := false; tbConn_DownLeftSide.Enabled := false; tbConn_DownRightSide.Enabled := false; tbConn_CaptionUp.Down := false; tbConn_CaptionUp.Enabled := false; tbConn_CaptionDown.Down := false; tbConn_CaptionDown.Enabled := false; tbConn_CaptionLeft.Down := false; tbConn_CaptionLeft.Enabled := false; tbConn_CaptionRight.Down := false; tbConn_CaptionRight.Enabled := false; cbConnShowCaptions.Checked := false; cbConnShowCaptions.Enabled := false; cbConnShowNotes.Checked := false; cbConnShowNotes.Enabled := false; bConnBlockClear.Enabled := false; rbCornerNone.Checked := true; rbCornerNone.Enabled := true; rbCornerOut.Checked := true; rbCornerOut.Enabled := true; rbCornerIn.Checked := true; rbCornerIn.Enabled := true; rbCornerVertical.Checked := true; rbCornerVertical.Enabled := true; rbCornerAdapter.Checked := true; rbCornerAdapter.Enabled := true; // From Oleg seConnIndex.Enabled := True; cbConnCaptionsFontSize.Enabled := False; cbConnCaptionsFontColor.Enabled := False; cbConnNotesFontSize.Enabled := False; cbConnNotesFontColor.Enabled := False; end else begin if GCadForm.FSCSType = st_External then begin edConnName.Enabled := true; edConnWidth.Enabled := False; edConnHeight.Enabled := False; edConnAngle.Enabled := False; edConnX.Enabled := true; edConnY.Enabled := true; edConnZ.Enabled := GAllowExternalListCoordZ; //22.08.2012 false; edConnDrawFigurePercent.Enabled := false; cbConnForAllSameType.Enabled := false; imgConnBlock.Enabled := false; bConnBlockChange.Enabled := false; tbConn_UpLeftSide.Enabled := false; tbConn_UpRightSide.Enabled := false; tbConn_DownLeftSide.Enabled := false; tbConn_DownRightSide.Enabled := false; tbConn_CaptionUp.Enabled := false; tbConn_CaptionDown.Enabled := false; tbConn_CaptionLeft.Enabled := false; tbConn_CaptionRight.Enabled := false; cbConnShowCaptions.Enabled := true; cbConnShowNotes.Enabled := true; bConnBlockClear.Enabled := false; // mConnCaptionsGroup.Enabled := false; // mConnNotesGroup.Enabled := false; if cbConnShowCaptions.Checked then mConnCaptionsGroup.Enabled := True else mConnCaptionsGroup.Enabled := False; if cbConnShowNotes.Checked then mConnNotesGroup.Enabled := True else mConnNotesGroup.Enabled := False; rbCornerNone.Checked := false; rbCornerNone.Enabled := false; rbCornerOut.Checked := false; rbCornerOut.Enabled := false; rbCornerIn.Checked := false; rbCornerIn.Enabled := false; rbCornerVertical.Checked := false; rbCornerVertical.Enabled := false; rbCornerAdapter.Checked := false; rbCornerAdapter.Enabled := false; // From Oleg seConnIndex.Enabled := true; cbConnCaptionsFontSize.Enabled := false; cbConnCaptionsFontColor.Enabled := false; cbConnNotesFontSize.Enabled := false; cbConnNotesFontColor.Enabled := false; end else begin edConnName.Enabled := true; edConnWidth.Enabled := true; edConnHeight.Enabled := true; edConnAngle.Enabled := true; edConnX.Enabled := true; edConnY.Enabled := true; edConnZ.Enabled := true; edConnDrawFigurePercent.Enabled := true; cbConnForAllSameType.Enabled := true; imgConnBlock.Enabled := true; bConnBlockChange.Enabled := true; tbConn_UpLeftSide.Enabled := true; tbConn_UpRightSide.Enabled := true; tbConn_DownLeftSide.Enabled := true; tbConn_DownRightSide.Enabled := true; tbConn_CaptionUp.Enabled := true; tbConn_CaptionDown.Enabled := true; tbConn_CaptionLeft.Enabled := true; tbConn_CaptionRight.Enabled := true; cbConnShowCaptions.Enabled := true; cbConnShowNotes.Enabled := true; bConnBlockClear.Enabled := true; if cbConnShowCaptions.Checked then mConnCaptionsGroup.Enabled := True else mConnCaptionsGroup.Enabled := False; if cbConnShowNotes.Checked then mConnNotesGroup.Enabled := True else mConnNotesGroup.Enabled := False; rbCornerNone.Checked := true; rbCornerNone.Enabled := true; rbCornerOut.Checked := true; rbCornerOut.Enabled := true; rbCornerIn.Checked := true; rbCornerIn.Enabled := true; rbCornerVertical.Checked := true; rbCornerVertical.Enabled := true; rbCornerAdapter.Checked := true; rbCornerAdapter.Enabled := true; // From Oleg seConnIndex.Enabled := True; cbConnCaptionsFontSize.Enabled := True; cbConnCaptionsFontColor.Enabled := True; cbConnNotesFontSize.Enabled := True; cbConnNotesFontColor.Enabled := True; end; end; bConnOK.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.EnableConnectorPropertiesForNormal', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineColor(aObject: TOrthoLine; aColor: Integer); begin try aObject.FTraceColor := aColor; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineColor', E.Message); end; end; procedure TF_SCSObjectsProp.cbConnShowCaptionsClick(Sender: TObject); begin try if cbConnShowCaptions.Checked then mConnCaptionsGroup.Enabled := True else mConnCaptionsGroup.Enabled := False; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnShowCaptionsClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbConnShowNotesClick(Sender: TObject); begin try if cbConnShowNotes.Checked then mConnNotesGroup.Enabled := True else mConnNotesGroup.Enabled := False; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnShowNotesClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbLineShowCaptionsClick(Sender: TObject); begin try if cbLineShowCaptions.State <> cbGrayed then begin if cbLineShowCaptions.Checked then begin mLineCaptionsGroup.Enabled := True; gbLengthChange.Enabled := True; cbLineShowLength.State := cbGrayed; end else begin mLineCaptionsGroup.Enabled := False; //gbLengthChange.Enabled := False; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbLineShowCaptionsClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbLineShowNotesClick(Sender: TObject); begin try if cbLineShowNotes.Checked then mLineNotesGroup.Enabled := True else mLineNotesGroup.Enabled := False; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbLineShowNotesClick', E.Message); end; end; procedure TF_SCSObjectsProp.edConnWidthExit(Sender: TObject); begin if isConnector then begin try if edConnWidth.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnWidth.Text := FConnProp.fWidth; if StrToFloat_My(edConnWidth.Text) = 0 then edConnWidth.Text := '0' + DecimalSeparator + '01'; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnWidthExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edConnHeightExit(Sender: TObject); begin if isConnector then begin try if edConnHeight.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnHeight.Text := FConnProp.fHeight; if StrToFloat_My(edConnHeight.Text) = 0 then edConnHeight.Text := '0' + DecimalSeparator + '01'; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnHeightExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.ChangeLineStyle(aObject: TOrthoLine; aStyle: Integer); begin try aObject.FTraceStyle := TPenStyle(aStyle); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineStyle', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineWidth(aObject: TOrthoLine; aWidth: Integer); begin try aObject.FTraceWidth := aWidth; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineWidth', E.Message); end; end; procedure TF_SCSObjectsProp.bConnBlockClearClick(Sender: TObject); begin try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; FClickConn.FBlockID := -1; FClickConn.FBlockGUID := ''; ClearConnBlock(FClickConn); if FConnProp.fBlock <> imgConnBlock.Picture.Bitmap then FClickConn.FIsBlockChanged := True; // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bConnBlockClearClick', E.Message); end; end; procedure TF_SCSObjectsProp.bLineBlockClearClick(Sender: TObject); begin try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; FClickLine.FBlockID := -1; FClickLine.FBlockGUID := ''; ClearLineBlock(FClickLine); if FLineProp.fBlock <> imgLineBlock.Picture.Bitmap then FClickLine.FIsBlockChanged := True; // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bLineBlockClearClick', E.Message); end; end; procedure TF_SCSObjectsProp.ClearConnBlock(aObject: TConnectorObject); var i: Integer; IconBLK: TMemoryStream; IconList: TObjectList; ApplyConn: TConnectorObject; ApplyList: TList; SelFigure: TFigure; SelList: TList; begin try IconBLK := TMemoryStream.Create; IconBLK := nil; IconList := nil; ClearcxImage(imgConnBlock); GCanRefreshProperties := False; SelList := TList.Create; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; ApplyList := FGroupObjectsList; SetBlockForConnObject(aObject, IconList); for i := 0 to ApplyList.Count - 1 do begin ApplyConn := TConnectorObject(ApplyList[i]); if ApplyConn <> aObject then SetBlockForConnObject(ApplyConn, IconList); end; // перевыделить группу if (not aObject.Deleted) and CheckFigureByClassName(aObject, cTConnectorObject) then begin aObject.Select; end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTConnectorObject) or CheckFigureByClassName(SelFigure, cTOrthoLine) then if not SelFigure.Deleted then if SelFigure <> aObject then SelFigure.Select; end; RefreshCAD(GCadForm.Pcad); FreeAndNil(SelList); FreeAndNil(IconBLK); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ClearConnBlock', E.Message); end; end; procedure TF_SCSObjectsProp.ClearLineBlock(aObject: TOrthoLine); var i: Integer; IconBLK: TMemoryStream; IconList: TObjectList; ApplyLine: TOrthoLine; ApplyList: TList; SelFigure: TFigure; SelList: TList; begin try IconBLK := TMemoryStream.Create; IconBLK := nil; IconList := nil; imgLineBlock.Clear; GCanRefreshProperties := False; SelList := TList.Create; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; ApplyList := FGroupObjectsList; SetBlockForLineObject(aObject, IconList, nil); for i := 0 to ApplyList.Count - 1 do begin ApplyLine := TOrthoLine(ApplyList[i]); if ApplyLine <> aObject then SetBlockForLineObject(ApplyLine, IconList, nil); end; // перевыделить группу if (not aObject.Deleted) and CheckFigureByClassName(aObject, cTConnectorObject) then begin aObject.Select; end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTConnectorObject) or CheckFigureByClassName(SelFigure, cTOrthoLine) then if not SelFigure.Deleted then if SelFigure <> aObject then SelFigure.Select; end; RefreshCAD(GCadForm.Pcad); FreeAndNil(SelList); FreeAndNil(IconBLK); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ClearLineBlock', E.Message); end; end; procedure TF_SCSObjectsProp.edConnNameExit(Sender: TObject); begin if isConnector then begin try if edConnName.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnName.Text := FConnProp.fName; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnNameExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edConnAngleEditing(Sender: TObject; var CanEdit: Boolean); begin AngleEdited := true; //edConnAngle.Style.BorderColor := $00E8731A; edConnAngle.Style.TextColor := $00E8731A; end; procedure TF_SCSObjectsProp.edConnAngleExit(Sender: TObject); begin if isConnector then begin try if edConnAngle.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnAngle.Text := FConnProp.fAngle; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnAngleExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edConnXEditing(Sender: TObject; var CanEdit: Boolean); begin xEdited := False; //edConnX.Style.BorderColor := $00E8731A; edConnX.Style.TextColor := $00E8731A; end; procedure TF_SCSObjectsProp.edConnXExit(Sender: TObject); begin if isConnector then begin try if edConnX.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnX.Text := FConnProp.fX; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnXExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edConnYEditing(Sender: TObject; var CanEdit: Boolean); begin yEdited := True; //edConny.Style.BorderColor := $00E8731A; edConny.Style.TextColor := $00E8731A; end; procedure TF_SCSObjectsProp.edConnYExit(Sender: TObject); begin if isConnector then begin try if edConnY.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnY.Text := FConnProp.fY; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnYExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edConnZEditing(Sender: TObject; var CanEdit: Boolean); begin zEdited := True; //edConnz.Style.BorderColor := $00E8731A; edConnz.Style.TextColor := $00E8731A; end; procedure TF_SCSObjectsProp.edConnZExit(Sender: TObject); var Val: Double; begin if isConnector then begin try if edConnZ.Text = '' then if FConnProp <> nil then // Tolik 25/08/2021 -- edConnZ.Text := FConnProp.fZ; if edConnZ.Text <> '' then begin Val := StrToFloat_My(edConnZ.Text); if Val > MetreToUOM(GCadForm.FRoomHeight) then Val := MetreToUOM(GCadForm.FRoomHeight); edConnZ.Text := FormatFloat(ffMask, Val); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnZExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineNameExit(Sender: TObject); begin if not isConnector then begin try if edLineName.Text = '' then edLineName.Text := FLineProp.fName; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineNameExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineGapExit(Sender: TObject); begin if not isConnector then begin try if edLineGap.Text = '' then edLineGap.Text := FLineProp.fGap; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineGapExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineCountExit(Sender: TObject); begin if not isConnector then begin try if edLineCount.Text = '' then edLineCount.Text := FLineProp.fCount; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineCountExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineAngleExit(Sender: TObject); begin if not isConnector then begin try if edLineAngle.Text = '' then edLineAngle.Text := FLineProp.fAngle; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineAngleExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineXExit(Sender: TObject); begin if not isConnector then begin try if edLineX.Text = '' then if FLineProp <> nil then // Tolik 26/08/2021 -- edLineX.Text := FLineProp.fX; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineXExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineYExit(Sender: TObject); begin if not isConnector then begin try if edLineY.Text = '' then if FLineProp <> nil then // Tolik 26/08/2021 -- edLineY.Text := FLineProp.fY; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineYExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineZExit(Sender: TObject); var Val: Double; begin if not isConnector then begin try if edLineZ.Text = '' then if FLineProp <> nil then // Tolik 26/08/2021 -- edLineZ.Text := FLineProp.fZ; if edLineZ.Text <> '' then begin Val := StrToFloat_My(edLineZ.Text); if Val > MetreToUOM(GCadForm.FRoomHeight) then Val := MetreToUOM(GCadForm.FRoomHeight); edLineZ.Text := FormatFloat(ffMask, Val); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineZExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edTraceWidthExit(Sender: TObject); begin if not isConnector then begin try if edTraceWidth.Text = '' then edTraceWidth.Text := FLineProp.fWidth; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edTraceWidthExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineBlockStepExit(Sender: TObject); begin if not isConnector then begin try if edLineBlockStep.Text = '' then edLineBlockStep.Text := FLineProp.fBlockStep; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineBlockStepExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.rbLineAutoLengthClick(Sender: TObject); begin try edLineAutoLength.Enabled := True; edLineUserLength.Enabled := False; // Select Edit if F_SCSObjectsProp.Visible and edLineAutoLength.Visible and edLineAutoLength.Enabled then begin try edLineAutoLength.SetFocus; except end; edLineAutoLength.SelStart := 0; edLineAutoLength.SelLength := length(edLineAutoLength.Text) + 1; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.rbLineAutoLengthClick', E.Message); end; end; procedure TF_SCSObjectsProp.rbLineUserLengthClick(Sender: TObject); begin try edLineAutoLength.Enabled := False; edLineUserLength.Enabled := True; edLineUserLength.Text := edLineAutoLength.Text; // Select Edit if F_SCSObjectsProp.Visible and edLineUserLength.Visible and edLineUserLength.Enabled then begin try edLineUserLength.SetFocus; except end; edLineUserLength.SelStart := 0; edLineUserLength.SelLength := length(edLineUserLength.Text) + 1; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.rbLineUserLengthClick', E.Message); end; end; procedure TF_SCSObjectsProp.edLineAutoLengthExit(Sender: TObject); begin if not isConnector then begin try if edLineAutoLength.Text = '' then edLineAutoLength.Text := FLineProp.fLength; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineAutoLengthExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.edLineUserLengthExit(Sender: TObject); begin if not isConnector then begin try if edLineUserLength.Text = '' then edLineUserLength.Text := FLineProp.fLength; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineUserLengthExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewConnectors; begin try if FObjectsTypeProp = otp_ConnObjects then LoadPropertiesForFewConnObjects; if FObjectsTypeProp = otp_ConnConnectors then LoadPropertiesForFewConnConnectors; if FObjectsTypeProp = otp_ConnRaises then LoadPropertiesForFewConnRaises; bConnOK.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewConnectors', E.Message); end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewOrtholines; begin try if FObjectsTypeProp = otp_LineTraces then LoadPropertiesForFewLineTraces; if FObjectsTypeProp = otp_LineRaises then LoadPropertiesForFewLineRaises; bLineOK.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewOrtholines', E.Message); end; end; procedure TF_SCSObjectsProp.FormKeyPress(Sender: TObject; var Key: Char); begin if Key = #27 then Close; end; procedure TF_SCSObjectsProp.ChangeConnIndex(aObject: TConnectorObject; aIndex: Double); begin try aObject.FIndex := Round(aIndex); SetConnNameInCaptionOnCAD(aObject); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnIndex', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineIndex(aObject: TOrthoLine; aIndex: Double); begin try aObject.FIndex := Round(aIndex); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineIndex', E.Message); end; end; procedure TF_SCSObjectsProp.cbLineCaptionsFontSizeKeyPress(Sender: TObject; var Key: Char); begin if (Key < '0') or (Key > '9') then Key := #0; end; procedure TF_SCSObjectsProp.cbLineNotesFontSizeKeyPress(Sender: TObject; var Key: Char); begin if (Key < '0') or (Key > '9') then Key := #0; end; procedure TF_SCSObjectsProp.cbLineCaptionsFontSizeExit(Sender: TObject); begin if not isConnector then begin try if cbLineCaptionsFontSize.Text = '' then cbLineCaptionsFontSize.Text := IntToStr(FClickLine.FCaptionsFontSize); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbLineCaptionsFontSizeExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.cbLineNotesFontSizeExit(Sender: TObject); begin if not isConnector then begin try if cbLineNotesFontSize.Text = '' then cbLineNotesFontSize.Text := IntToStr(FClickLine.FNotesFontSize); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbLineNotesFontSizeExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.cbConnCaptionsFontSizeKeyPress(Sender: TObject; var Key: Char); begin if (Key < '0') or (Key > '9') then Key := #0; end; procedure TF_SCSObjectsProp.cbConnNotesFontSizeKeyPress(Sender: TObject; var Key: Char); begin if (Key < '0') or (Key > '9') then Key := #0; end; procedure TF_SCSObjectsProp.cbConnCaptionsFontSizeExit(Sender: TObject); begin if isConnector then begin try if cbConnCaptionsFontSize.Text = '' then cbConnCaptionsFontSize.Text := IntToStr(FClickConn.FCaptionsFontSize); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnCaptionsFontSizeExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.cbConnNotesFontSizeExit(Sender: TObject); begin if isConnector then begin try if cbConnNotesFontSize.Text = '' then cbConnNotesFontSize.Text := IntToStr(FClickConn.FNotesFontSize); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnNotesFontSizeExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.ChangeConnCaptionsFontSize(aObject: TConnectorObject; aSize: Integer); begin try aObject.FCaptionsFontSize := aSize; aObject.ReCreateCaptionsGroup(True, false); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnCaptionsFontSize', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnNotesFontSize(aObject: TConnectorObject; aSize: Integer); begin try aObject.FNotesFontSize := aSize; aObject.ReCreateNotesGroup(True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnNotesFontSize', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnCaptionsFontColor(aObject: TConnectorObject; aColor: Integer); begin try aObject.FCaptionsFontColor := aColor; aObject.ReCreateCaptionsGroup(True, false); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnCaptionsFontColor', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnNotesFontColor(aObject: TConnectorObject; aColor: Integer); begin try aObject.FNotesFontColor := aColor; aObject.ReCreateNotesGroup(True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnNotesFontColor', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineCaptionsFontSize(aObject: TOrthoLine; aSize: Integer; aBold: Boolean); begin try aObject.FCaptionsFontSize := aSize; aObject.FCaptionsFontBold := aBold; aObject.ReCreateCaptionsGroup(True, false); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineCaptionsFontSize', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineNotesFontSize(aObject: TOrthoLine; aSize: Integer); begin try aObject.FNotesFontSize := aSize; aObject.ReCreateNotesGroup(True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineNotesFontSize', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineCaptionsFontColor(aObject: TOrthoLine; aColor: Integer); begin try aObject.FCaptionsFontColor := aColor; aObject.ReCreateCaptionsGroup(True, false); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineCaptionsFontColor', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineNotesFontColor(aObject: TOrthoLine; aColor: Integer); begin try aObject.FNotesFontColor := aColor; aObject.ReCreateNotesGroup(True); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineNotesFontColor', E.Message); end; end; procedure TF_SCSObjectsProp.SaveConnProp(var aConnProp: PConnectorProp); var i: Integer; Str: string; begin try aConnProp.fName := edConnName.Text; aConnProp.fIndex := seConnIndex.Value; aConnProp.fIndexWithName := cbConnIndexWithName.Checked; aConnProp.fWidth := edConnWidth.Text; aConnProp.fHeight := edConnHeight.Text; aConnProp.fAngle := edConnAngle.Text; aConnProp.fX := edConnX.Text; aConnProp.fY := edConnY.Text; aConnProp.fZ := edConnZ.Text; aConnProp.fDrawFigurePercent := edConnDrawFigurePercent.Text; aConnProp.fForAllSameType := cbConnForAllSameType.Checked; // подписи aConnProp.fCaptionsGroup := TStringList.Create; for i := 0 to mConnCaptionsGroup.Lines.Count - 1 do begin Str := mConnCaptionsGroup.Lines[i]; aConnProp.fCaptionsGroup.Add(Str); end; aConnProp.fCaptionsShow := cbConnShowCaptions.Checked; aConnProp.fCaptionsShowGrayed := (cbConnShowCaptions.State = cbGrayed); aConnProp.fCaptionsFontSize := cbConnCaptionsFontSize.Text; aConnProp.fCaptionsFontColor := cbConnCaptionsFontColor.ColorValue; if tbConn_CaptionUp.Down then aConnProp.fCaptionsShowType := cv_Up; if tbConn_CaptionDown.Down then aConnProp.fCaptionsShowType := cv_Down; if tbConn_CaptionLeft.Down then aConnProp.fCaptionsShowType := cv_Left; if tbConn_CaptionRight.Down then aConnProp.fCaptionsShowType := cv_Right; // выноски aConnProp.fNotesGroup := TStringList.Create; for i := 0 to mConnNotesGroup.Lines.Count - 1 do begin Str := mConnNotesGroup.Lines[i]; aConnProp.fNotesGroup.Add(Str); end; aConnProp.fNotesShow := cbConnShowNotes.Checked; aConnProp.fNotesShowGrayed := (cbConnShowNotes.State = cbGrayed); aConnProp.fNotesFontSize := cbConnNotesFontSize.Text; aConnProp.fNotesFontColor := cbConnNotesFontColor.ColorValue; aConnProp.fNotesShowType := nr_AutoSide; if tbConn_UpLeftSide.Down then aConnProp.fNotesShowType := nr_UpLeftSide; if tbConn_DownLeftSide.Down then aConnProp.fNotesShowType := nr_DownLeftSide; if tbConn_UpRightSide.Down then aConnProp.fNotesShowType := nr_UpRightSide; if tbConn_DownRightSide.Down then aConnProp.fNotesShowType := nr_DownRightSide; // уголок if rbCornerNone.Checked then aConnProp.fCornerType := crn_None; if rbCornerIn.Checked then aConnProp.fCornerType := crn_In; if rbCornerOut.Checked then aConnProp.fCornerType := crn_Out; if rbCornerVertical.Checked then aConnProp.fCornerType := crn_Vertical; if rbCornerAdapter.Checked then aConnProp.fCornerType := crn_Adapter; aConnProp.fBlock := TBitmap.Create; aConnProp.fBlock := imgConnBlock.Picture.Bitmap; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.SaveConnProp', E.Message); end; end; procedure TF_SCSObjectsProp.SaveLineProp(var aLineProp: POrtholineProp); var i: Integer; Str: string; begin try aLineProp.fName := edLineName.Text; aLineProp.fCaption := edLineCaption.Text; aLineProp.fIndex := seLineIndex.Value; aLineProp.fIndexWithName := cbLineIndexWithName.Checked; aLineProp.fGap := edLineGap.Text; aLineProp.fCount := edLineCount.Text; aLineProp.fAngle := edLineAngle.Text; aLineProp.fX := edLineX.Text; aLineProp.fY := edLineY.Text; aLineProp.fZ := edLineZ.Text; aLineProp.fDrawFigurePercent := edLineDrawFigurePercent.Text; aLineProp.fForAllSameType := cbLineForAllSameType.Checked; // Tolik -- 05/04/2017 -- //aLineProp.fShowLength := cbLineShowLength.Checked; aLineProp.fShowLength := (cbLineShowLength.Checked or (cbLineShowLength.State = cbGrayed)); // aLineProp.fShowLengthGrayed := (cbLineShowLength.State = cbGrayed); if Not cbUserLength.Checked then //02.04.2012 if rbLineAutoLength.Checked then begin aLineProp.fIsAutoLength := True; aLineProp.fLength := edLineAutoLength.Text; end else begin aLineProp.fIsAutoLength := False; aLineProp.fLength := edLineUserLength.Text; end; // подписи aLineProp.fCaptionsGroup := TStringList.Create; for i := 0 to mLineCaptionsGroup.Lines.Count - 1 do begin Str := mLineCaptionsGroup.Lines[i]; // Tolik 06/04/*--2017 -- // aLineProp.fCaptionsGroup.Add(Str); if ((cbLineShowLength.Checked or (cbLineShowLength.state = cbGrayed)) and tbLine_Center.Down) then aLineProp.fCaptionsGroup.Add(Str) else begin if Str <> '' then aLineProp.fCaptionsGroup.Add(Str); end; end; aLineProp.fCaptionsShow := cbLineShowCaptions.Checked; aLineProp.fCaptionsShowGrayed := (cbLineShowCaptions.State = cbGrayed); aLineProp.fCaptionsFontSize := cbLineCaptionsFontSize.Text; aLineProp.fCaptionsFontBold := cbLineCaptionsFontBold.Checked; aLineProp.fCaptionsFontBoldGrayed := (cbLineCaptionsFontBold.State = cbGrayed); aLineProp.fCaptionsFontColor := cbLineCaptionsFontColor.ColorValue; if tbLine_OverLine.Down then aLineProp.fCaptionsShowType := cv_OverLine; if tbLine_UnderLine.Down then aLineProp.fCaptionsShowType := cv_UnderLine; // Tolik 02/12/2015 if tbLine_Center.Down then aLineProp.fCaptionsShowType := cv_Center; if tbLine_Auto.Down then aLineProp.fCaptionsShowType := cv_Auto; // // выноски aLineProp.fNotesGroup := TStringList.Create; for i := 0 to mLineNotesGroup.Lines.Count - 1 do begin Str := mLineNotesGroup.Lines[i]; aLineProp.fNotesGroup.Add(Str); end; aLineProp.fNotesShow := cbLineShowNotes.Checked; aLineProp.fNotesShowGrayed := (cbLineShowNotes.State = cbGrayed); aLineProp.fNotesFontSize := cbLineNotesFontSize.Text; aLineProp.fNotesFontColor := cbLineNotesFontColor.ColorValue; aLineProp.fNotesShowType := nr_AutoSide; if tbLine_UpLeftSide.Down then aLineProp.fNotesShowType := nr_UpLeftSide; if tbLine_DownLeftSide.Down then aLineProp.fNotesShowType := nr_DownLeftSide; if tbLine_UpRightSide.Down then aLineProp.fNotesShowType := nr_UpRightSide; if tbLine_DownRightSide.Down then aLineProp.fNotesShowType := nr_DownRightSide; aLineProp.fColor := cbTraceColor.ColorValue; aLineProp.fStyle := cbTraceStyle.ItemIndex; aLineProp.fWidth := edTraceWidth.Text; aLineProp.fShowBlock := cbLineShowBlock.Checked; aLineProp.fShowBlockGrayed := (cbLineShowBlock.State = cbGrayed); aLineProp.fBlockStep := edLineBlockStep.Text; aLineProp.fBlock := TBitmap.Create; aLineProp.fBlock := imgLineBlock.Picture.Bitmap; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.SaveLineProp', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnCaptionsViewType(aObject: TConnectorObject; aValue: TConnCaptionsViewType); begin try aObject.FCaptionsViewType := aValue; aObject.ReCreateCaptionsGroup(false, false); // aObject.ReCreateCaptionsGroup(true, false); RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnCaptionsViewType', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeConnNotesViewType(aObject: TConnectorObject; aValue: TNotesRowsType); begin try aObject.FNotesRowsType := aValue; aObject.ReCreateNotesGroup(True); RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnNotesViewType', E.Message); end; end; //Tolik -- 17/12/2015 = тут немножко переделаем совсем { procedure TF_SCSObjectsProp.ChangeLineCaptionsViewType(aObject: TOrthoLine; aValue: TLineCaptionsViewType); begin try aObject.FCaptionsViewType := aValue; aObject.ReCreateCaptionsGroup(False, False); RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineCaptionsViewType', E.Message); end; end; } procedure TF_SCSObjectsProp.ChangeLineCaptionsViewType(aObject: TOrthoLine; aValue: TLineCaptionsViewType); var CanChangePosition: Boolean; Procedure CheckDelEmptyStrings(aLine: TOrthoLine); var Captions: TRichTextMod; i, LineCount: Integer; begin if aLine <> nil then begin if (aLine.FCaptionsViewType <> aValue) and ((aLine.FCaptionsViewType = cv_Center) or (aValue = cv_Center)) then begin if (aLine.CaptionsGroup <> nil) and (aLine.CaptionsGroup.InFigures.Count > 1) then begin Captions := TRichTextMod(aLine.CaptionsGroup.InFigures[1]); if Captions.re.Lines.Count > 1 then begin // удалить пустые if aLine.FCaptionsViewType = cv_Center then begin aLine.OutTextCaptions.Clear; for i := 0 to Captions.re.Lines.Count - 1 do aLine.OutTextCaptions.Add(Captions.re.Lines[i]); while aLine.OutTextCaptions[1] = '' do begin aLine.OutTextCaptions.Delete(1); if aLine.OutTextCaptions.Count = 1 then Break; //// BREAK ////; end; end // добавить пустые else begin // Tolik 12/04/2017 -- if {((aLine.FCaptionsViewType = cv_Center) or} ((aValue = cv_Center) and aLine.ShowLength) then begin aLine.OutTextCaptions.Insert(1,''); if aLine.GrpSizeY > 1 then begin // Tolik -- 23/12/2015 -- //LineCount := RoundUp((aLine.GrpSizeY + 0.1)/2) - 1; LineCount := GetEmptyLinesCount(aLine) - 1; // for i := 1 to LineCount do aLine.OutTextCaptions.Insert(1,''); end; end; end; end; end; end; end; end; begin try CanChangePosition := (aObject.FCaptionsViewType <> aValue); CheckDelEmptyStrings(aObject); aObject.FCaptionsViewType := aValue; if CanChangePosition then begin // Tolik -- 03/04/2017 -- aObject.ReCreateCaptionsGroup(False, False); //aObject.UpdateLengthTextBox(True, True); // RefreshCAD(GCadForm.PCad); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineCaptionsViewType', E.Message); end; end; // procedure TF_SCSObjectsProp.ChangeLineNotesViewType(aObject: TOrthoLine; aValue: TNotesRowsType); begin try aObject.FNotesRowsType := aValue; aObject.ReCreateNotesGroup(True); RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineNotesViewType', E.Message); end; end; procedure TF_SCSObjectsProp.bLineDrawPlusClick(Sender: TObject); var i: Integer; ApplyLine: TOrthoLine; ApplyList: TList; begin try ApplyList := FGroupObjectsList; ChangeLineDrawPlus(FClickLine); for i := 0 to ApplyList.Count - 1 do begin ApplyLine := TOrthoLine(ApplyList[i]); if ApplyLine <> FClickLine then ChangeLineDrawPlus(ApplyLine); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bLineDrawPlusClick', E.Message); end; end; procedure TF_SCSObjectsProp.bLineDrawMinusClick(Sender: TObject); var i: Integer; ApplyLine: TOrthoLine; ApplyList: TList; begin try ApplyList := FGroupObjectsList; ChangeLineDrawMinus(FClickLine); for i := 0 to ApplyList.Count - 1 do begin ApplyLine := TOrthoLine(ApplyList[i]); if ApplyLine <> FClickLine then ChangeLineDrawMinus(ApplyLine); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.bLineDrawMinusClick', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineDrawPlus(aObject: TOrthoLine); var i: integer; Bnd: TDoubleRect; InFigure: TFigureGrpMod; begin try if aObject.FSingleBlock <> nil then begin if aObject.FSingleBlock.InFigures.Count = 0 then begin // вычислить delta if not aObject.FIsRotated then aObject.FSingleBlockDelta := aObject.FSingleBlockDelta + 1 else aObject.FSingleBlockDelta := aObject.FSingleBlockDelta - 1; RefreshCAD(GCadForm.PCad); end; if aObject.FSingleBlock.InFigures.Count = 1 then begin // первый объект InFigure := TFiguregrpMod(aObject.FSingleBlock.InFigures[0]); // получить баундс Bnd := InFigure.GetBoundRect; // вычислить delta if not aObject.FIsRotated then aObject.FSingleBlockDelta := aObject.FSingleBlockDelta + (Bnd.Bottom - Bnd.Top) / 2 else aObject.FSingleBlockDelta := aObject.FSingleBlockDelta - (Bnd.Bottom - Bnd.Top) / 2; RefreshCAD(GCadForm.PCad); end; if aObject.FSingleBlock.InFigures.Count = 2 then begin // повернуть к 0 градусам aObject.FSingleBlock.Rotate(0 - aObject.FDrawFigureAngle, aObject.FSingleBlock.CenterPoint); // второй объект InFigure := TFiguregrpMod(aObject.FSingleBlock.InFigures[1]); // получить баундс Bnd := InFigure.GetBoundRect; // вычислить delta if not aObject.FIsRotated then aObject.FSingleBlockDelta := aObject.FSingleBlockDelta + (Bnd.Bottom - Bnd.Top) / 2 else aObject.FSingleBlockDelta := aObject.FSingleBlockDelta - (Bnd.Bottom - Bnd.Top) / 2; // move InFigure.Move(0, (Bnd.Bottom - Bnd.Top) / 2); // повернуть назад aObject.FSingleBlock.Rotate(aObject.FDrawFigureAngle, aObject.FSingleBlock.CenterPoint); // пересоздать aObject.ReCreateDrawFigureBlock; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineDrawPlus', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineDrawMinus(aObject: TOrthoLine); var i: integer; Bnd: TDoubleRect; InFigure: TFigure; begin try if aObject.FSingleBlock <> nil then begin if aObject.FSingleBlock.InFigures.Count = 0 then begin // вычислить delta if not aObject.FIsRotated then aObject.FSingleBlockDelta := aObject.FSingleBlockDelta - 1 else aObject.FSingleBlockDelta := aObject.FSingleBlockDelta + 1; RefreshCAD(GCadForm.PCad); end; if aObject.FSingleBlock.InFigures.Count = 1 then begin // первый объект InFigure := TFiguregrpMod(aObject.FSingleBlock.InFigures[0]); // получить баундс Bnd := InFigure.GetBoundRect; // вычислить delta if not aObject.FIsRotated then aObject.FSingleBlockDelta := aObject.FSingleBlockDelta - (Bnd.Bottom - Bnd.Top) / 2 else aObject.FSingleBlockDelta := aObject.FSingleBlockDelta + (Bnd.Bottom - Bnd.Top) / 2; RefreshCAD(GCadForm.PCad); end; if aObject.FSingleBlock.InFigures.Count = 2 then begin // повернуть к 0 градусам aObject.FSingleBlock.Rotate(0 - aObject.FDrawFigureAngle, aObject.FSingleBlock.CenterPoint); // второй объект InFigure := TFiguregrpMod(aObject.FSingleBlock.InFigures[1]); // получить баундс Bnd := InFigure.GetBoundRect; // вычислить delta if not aObject.FIsRotated then aObject.FSingleBlockDelta := aObject.FSingleBlockDelta - (Bnd.Bottom - Bnd.Top) / 2 else aObject.FSingleBlockDelta := aObject.FSingleBlockDelta + (Bnd.Bottom - Bnd.Top) / 2; // move InFigure.Move(0, - (Bnd.Bottom - Bnd.Top) / 2); // повернуть назад aObject.FSingleBlock.Rotate(aObject.FDrawFigureAngle, aObject.FSingleBlock.CenterPoint); // пересоздать aObject.ReCreateDrawFigureBlock; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineDrawMinus', E.Message); end; end; procedure TF_SCSObjectsProp.edConnDrawFigurePercentEditing(Sender: TObject; var CanEdit: Boolean); begin GsEdited := True; edConnDrawFigurePercent.Style.TextColor := $00E8731A; end; procedure TF_SCSObjectsProp.edConnDrawFigurePercentExit(Sender: TObject); var valPercent: Double; begin if isConnector then begin try if edConnDrawFigurePercent.Text = '' then begin if FConnProp <> nil then // Tolik 25/08/2021 -- edConnDrawFigurePercent.Text := FConnProp.fDrawFigurePercent; end else begin valPercent := StrToFloat_My(edConnDrawFigurePercent.Text); if valPercent < 1 then edConnDrawFigurePercent.Text := '1'; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnDrawFigurePercentExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.ChangeConnDrawFigurePercent(aObject: TConnectorObject; aPercent: Double); var i: Integer; FFigure: TFigure; SameTypeObjects: TIntList; ObjectsList: TList; CurID: Integer; CurObject: TConnectorObject; begin try ChangeDrawFigurePercentForObject(aObject, aPercent); if FForAllConnsSameType then begin SameTypeObjects := GetObjectIDsFromListBySameIcon(GCadForm.FCADListID, aObject.ID, aObject.FBlockGUID); ObjectsList := TList.Create; for i := 0 to SameTypeObjects.Count - 1 do begin CurID := SameTypeObjects[i]; FFigure := TFigure(GetFigureByID(GCadForm, CurID)); if FFigure <> nil then if CheckFigureByClassName(FFigure, cTConnectorObject) then if CheckNoFigureInList(FFigure, FGroupObjectsList) then ObjectsList.Add(FFigure); end; for i := 0 to ObjectsList.Count - 1 do begin CurObject := TConnectorObject(ObjectsList[i]); ChangeDrawFigurePercentForObject(CurObject, aPercent); // Tolik 26/09/2017 -- RedefineObjIcon(curObject); // end; FreeAndNil(ObjectsList); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeConnDrawFigurePercent', E.Message); end; end; procedure TF_SCSObjectsProp.ChangeLineDrawFigurePercent(aObject: TOrthoLine; aPercent: Double); var i: Integer; FFigure: TFigure; SameTypeObjects: TIntList; ObjectsList: TList; CurID: Integer; CurLine: TOrthoLine; begin try ChangeDrawFigurePercentForLine(aObject, aPercent); if FForAllLinesSameType then begin SameTypeObjects := GetObjectIDsFromListBySameIcon(GCadForm.FCADListID, aObject.ID, aObject.FBlockGUID); ObjectsList := TList.Create; for i := 0 to SameTypeObjects.Count - 1 do begin CurID := SameTypeObjects[i]; FFigure := TFigure(GetFigureByID(GCadForm, CurID)); if FFigure <> nil then if CheckFigureByClassName(FFigure, cTOrthoLine) then if CheckNoFigureInList(FFigure, FGroupObjectsList) then ObjectsList.Add(FFigure); end; for i := 0 to ObjectsList.Count - 1 do begin CurLine := TOrthoLine(ObjectsList[i]); ChangeDrawFigurePercentForLine(CurLine, aPercent); end; FreeAndNil(ObjectsList); end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ChangeLineDrawFigurePercent', E.Message); end; end; procedure TF_SCSObjectsProp.edLineDrawFigurePercentExit(Sender: TObject); var valPercent: Double; begin if not isConnector then begin try if edLineDrawFigurePercent.Text = '' then edLineDrawFigurePercent.Text := FLineProp.fDrawFigurePercent else begin valPercent := StrToFloat_My(edLineDrawFigurePercent.Text); if valPercent < 1 then edLineDrawFigurePercent.Text := '1'; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineDrawFigurePercentExit', E.Message); end; end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewConnConnectors; begin try seConnIndex.Enabled := False; edConnName.Enabled := False; edConnWidth.Enabled := False; edConnHeight.Enabled := False; edConnAngle.Enabled := False; edConnX.Enabled := True; edConnY.Enabled := True; edConnZ.Enabled := True; edConnDrawFigurePercent.Enabled := False; cbConnForAllSameType.Enabled := False; mConnCaptionsGroup.Enabled := False; mConnNotesGroup.Enabled := False; imgConnBlock.Clear; imgConnBlock.Enabled := False; bConnBlockChange.Enabled := False; tbConn_UpLeftSide.Enabled := False; tbConn_UpRightSide.Enabled := False; tbConn_DownLeftSide.Enabled := False; tbConn_DownRightSide.Enabled := False; tbConn_CaptionUp.Enabled := False; tbConn_CaptionDown.Enabled := False; tbConn_CaptionLeft.Enabled := False; tbConn_CaptionRight.Enabled := False; cbConnShowCaptions.Enabled := False; cbConnShowNotes.Enabled := False; bConnBlockClear.Enabled := False; cbConnCaptionsFontSize.Enabled := False; cbConnCaptionsFontColor.Enabled := False; cbConnNotesFontSize.Enabled := False; cbConnNotesFontColor.Enabled := False; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewConnConnectors', E.Message); end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewConnObjects; begin try if GCadForm.FSCSType = st_External then begin edConnName.Enabled := false; edConnWidth.Enabled := False; edConnHeight.Enabled := False; edConnAngle.Enabled := False; edConnX.Enabled := true; edConnY.Enabled := true; edConnZ.Enabled := GAllowExternalListCoordZ; //22.08.2012 false; edConnDrawFigurePercent.Enabled := false; cbConnForAllSameType.Enabled := false; imgConnBlock.Enabled := false; bConnBlockChange.Enabled := false; tbConn_UpLeftSide.Enabled := false; tbConn_UpRightSide.Enabled := false; tbConn_DownLeftSide.Enabled := false; tbConn_DownRightSide.Enabled := false; tbConn_CaptionUp.Enabled := false; tbConn_CaptionDown.Enabled := false; tbConn_CaptionLeft.Enabled := false; tbConn_CaptionRight.Enabled := false; cbConnShowCaptions.Enabled := false; cbConnShowNotes.Enabled := false; bConnBlockClear.Enabled := false; mConnCaptionsGroup.Enabled := false; mConnNotesGroup.Enabled := false; rbCornerNone.Checked := false; rbCornerNone.Enabled := false; rbCornerOut.Checked := false; rbCornerOut.Enabled := false; rbCornerIn.Checked := false; rbCornerIn.Enabled := false; rbCornerVertical.Checked := false; rbCornerVertical.Enabled := false; rbCornerAdapter.Checked := false; rbCornerAdapter.Enabled := false; // From Oleg seConnIndex.Enabled := false; cbConnCaptionsFontSize.Enabled := false; cbConnCaptionsFontColor.Enabled := false; cbConnNotesFontSize.Enabled := false; cbConnNotesFontColor.Enabled := false; end else begin seConnIndex.Enabled := False; edConnName.Enabled := False; edConnWidth.Enabled := True; edConnHeight.Enabled := True; edConnAngle.Enabled := True; edConnX.Enabled := True; edConnY.Enabled := True; edConnZ.Enabled := True; edConnDrawFigurePercent.Enabled := True; cbConnForAllSameType.Enabled := True; mConnCaptionsGroup.Enabled := True; mConnNotesGroup.Enabled := True; imgConnBlock.Enabled := True; bConnBlockChange.Enabled := True; tbConn_UpLeftSide.Enabled := True; tbConn_UpRightSide.Enabled := True; tbConn_DownLeftSide.Enabled := True; tbConn_DownRightSide.Enabled := True; tbConn_CaptionUp.Enabled := True; tbConn_CaptionDown.Enabled := True; tbConn_CaptionLeft.Enabled := True; tbConn_CaptionRight.Enabled := True; cbConnShowCaptions.Enabled := True; cbConnShowNotes.Enabled := True; bConnBlockClear.Enabled := True; cbConnCaptionsFontSize.Enabled := True; cbConnCaptionsFontColor.Enabled := True; cbConnNotesFontSize.Enabled := True; cbConnNotesFontColor.Enabled := True; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewConnObjects', E.Message); end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewConnRaises; begin try seConnIndex.Enabled := False; edConnName.Enabled := False; edConnWidth.Enabled := False; edConnHeight.Enabled := False; edConnAngle.Enabled := False; edConnX.Enabled := False; edConnY.Enabled := False; edConnZ.Enabled := False; edConnDrawFigurePercent.Enabled := False; cbConnForAllSameType.Enabled := False; mConnCaptionsGroup.Enabled := False; mConnNotesGroup.Enabled := False; imgConnBlock.Clear; imgConnBlock.Enabled := False; bConnBlockChange.Enabled := False; tbConn_UpLeftSide.Enabled := False; tbConn_UpRightSide.Enabled := False; tbConn_DownLeftSide.Enabled := False; tbConn_DownRightSide.Enabled := False; tbConn_CaptionUp.Enabled := False; tbConn_CaptionDown.Enabled := False; tbConn_CaptionLeft.Enabled := False; tbConn_CaptionRight.Enabled := False; cbConnShowCaptions.Enabled := False; cbConnShowNotes.Enabled := False; bConnBlockClear.Enabled := False; cbConnCaptionsFontSize.Enabled := False; cbConnCaptionsFontColor.Enabled := False; cbConnNotesFontSize.Enabled := False; cbConnNotesFontColor.Enabled := False; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewConnRaises', E.Message); end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewLineRaises; begin try seLineIndex.Enabled := False; edLineName.Enabled := False; cbTraceColor.Enabled := True; cbTraceStyle.Enabled := False; edTraceWidth.Enabled := False; edLineGap.Enabled := False; edLineCount.Enabled := False; edLineAngle.Enabled := False; edLineX.Enabled := False; edLineY.Enabled := False; edLineZ.Enabled := False; edLineDrawFigurePercent.Enabled := True; //10.01.2013 False; cbLineForAllSameType.Enabled := True; //10.01.2013 False; mLineCaptionsGroup.Enabled := True; mLineNotesGroup.Enabled := True; edLineCaption.Enabled := False; cbLineShowLength.Enabled := True; bLineDrawPlus.Enabled := False; bLineDrawMinus.Enabled := False; edLineBlockStep.Enabled := False; bLineBlockClear.Enabled := False; imgLineBlock.Clear; imgLineBlock.Enabled := False; bLineBlockChange.Enabled := False; if Not GCadForm.FListSettings.CADShowRaiseDrawFigure then begin cbLineShowBlock.Enabled := False; end else begin cbLineShowBlock.Enabled := True; end; tbLine_UpLeftSide.Enabled := True; tbLine_UpRightSide.Enabled := True; tbLine_DownLeftSide.Enabled := True; tbLine_DownRightSide.Enabled := True; tbLine_OverLine.Enabled := False; tbLine_UnderLine.Enabled := False; // Tolik -- 02/12/2015 tbLine_Center.Enabled := False; tbLine_Auto.Enabled := False; // cbLineShowCaptions.Enabled := True; cbLineShowNotes.Enabled := True; cbLineCaptionsFontSize.Enabled := True; cbLineCaptionsFontColor.Enabled := True; cbLineCaptionsFontBold.Checked := True; cbLineCaptionsFontBold.Enabled := True; cbLineNotesFontSize.Enabled := True; cbLineNotesFontColor.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewLineRaises', E.Message); end; end; procedure TF_SCSObjectsProp.LoadPropertiesForFewLineTraces; begin try seLineIndex.Enabled := False; edLineName.Enabled := False; if GCadForm.FKeepLineTypesRules then begin cbTraceColor.Enabled := False; cbTraceStyle.Enabled := False; edTraceWidth.Enabled := False; end else begin cbTraceColor.Enabled := True; cbTraceStyle.Enabled := True; edTraceWidth.Enabled := True; end; edLineGap.Enabled := True; edLineCount.Enabled := True; edLineAngle.Enabled := False; edLineX.Enabled := False; edLineY.Enabled := False; edLineZ.Enabled := True; edLineDrawFigurePercent.Enabled := True; cbLineForAllSameType.Enabled := True; mLineCaptionsGroup.Enabled := True; mLineNotesGroup.Enabled := True; edLineCaption.Enabled := True; cbLineShowBlock.Enabled := True; edLineBlockStep.Enabled := True; imgLineBlock.Enabled := True; bLineBlockChange.Enabled := True; tbLine_UpLeftSide.Enabled := True; tbLine_UpRightSide.Enabled := True; tbLine_DownLeftSide.Enabled := True; tbLine_DownRightSide.Enabled := True; tbLine_OverLine.Enabled := True; tbLine_UnderLine.Enabled := True; //Tolik -- 02/12/2015 tbLine_Center.Enabled := True; //tbLine_Auto.Enabled := True; // cbLineShowCaptions.Enabled := True; cbLineShowNotes.Enabled := True; bLineBlockClear.Enabled := True; cbLineCaptionsFontSize.Enabled := True; cbLineCaptionsFontColor.Enabled := True; cbLineCaptionsFontBold.Checked := True; cbLineCaptionsFontBold.Enabled := True; cbLineNotesFontSize.Enabled := True; cbLineNotesFontColor.Enabled := True; bLineDrawPlus.Enabled := True; bLineDrawMinus.Enabled := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LoadPropertiesForFewLineTraces', E.Message); end; end; procedure TF_SCSObjectsProp.ApplyConnectorProperties(AObject: TConnectorObject; aNewProperties: PConnectorProp; aMultiple: Boolean); var ObjectParams: TObjectParams; ObjCatalog: TSCSCatalog; i: Integer; begin try // Tolik -- 11/07/2016 -- если в результате подъема объект попадет на другой // объект, то он будет уничтожен, поэтому дальше нечего будет применять... // так что сначала применяем высоту, а потом все остальное, если останется объект // Z ObjectToSnap := nil; if edConnZ.Enabled then if ((FConnProp.fZ <> aNewProperties.fZ) or (zEdited = true)) then begin ChangeConnZ(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fZ))); ObjCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesbySCSID(AObject.ID); if ObjCatalog <> nil then begin ObjCatalog.NameMark := TF_MAIN(ObjCatalog.ActiveForm).MakeNameMarkCatalog(ObjCatalog.ID, false, qmMemory); if Assigned(ObjCatalog.TreeViewNode) then ObjCatalog.TreeViewNode.Text := ObjCatalog.GetNameForVisible(true); ObjCatalog.DefineComponsNameMarks; end; { ObjCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(aObject.ID); if ObjCatalog <> nil then begin for i := 0 to ObjCatalog.ComponentReferences.Count - 1 do begin ApplyChangeComponMarkID(TSCSComponent(ObjCatalog.ComponentReferences[i]), true, false, nil); end; end; } {ObjectParams.MarkID := round(aNewProperties.fIndex); ObjectParams.IndexWithName := BoolToInt(aNewProperties.fIndexWithName); ObjectParams.Name := aNewProperties.fName; SaveFigureParams(AObject.ID, ObjectParams); ChangeConnIndex(AObject, aNewProperties.fIndex);} end; if ObjectToSnap <> nil then begin ObjectToSnap := nil; AObject := nil; FClickConn := nil; Exit; end; // // изменение подписи к точ. объекту if mConnCaptionsGroup.Enabled then if IsStringListsDifferent(FConnProp.fCaptionsGroup, aNewProperties.fCaptionsGroup) then begin ChangeConnCaptionsGroup(AObject, aNewProperties.fCaptionsGroup); AObject.FIsCaptionsChanged := True; end; // изменение выноски к точ. объекту if mConnNotesGroup.Enabled then if IsStringListsDifferent(FConnProp.fNotesGroup, aNewProperties.fNotesGroup) then begin ChangeConnNotesGroup(AObject, aNewProperties.fNotesGroup); AObject.FIsNotesChanged := True; end; // тип уголка if FConnProp.fCornerType <> aNewProperties.fCornerType then ChangeConnCornerType(AObject, aNewProperties.fCornerType); // Имя if edConnName.Enabled then if FConnProp.fName <> aNewProperties.fName then begin AObject.FIsNameChanged := True; ChangeConnName(AObject, aNewProperties.fName); if AObject.ConnectorType <> ct_Clear then SetConnNameInCaptionOnCAD(AObject); end; // изменение отображения подписей if cbConnShowCaptions.Enabled then // if FConnProp.fCaptionsShow <> aNewProperties.fCaptionsShow then if FConnProp.fCaptionsShowGrayed <> aNewProperties.fCaptionsShowGrayed then AObject.ShowCaptions := aNewProperties.fCaptionsShow; // изменение отображения выносок if cbConnShowNotes.Enabled then // if FConnProp.fNotesShow <> aNewProperties.fNotesShow then if FConnProp.fNotesShowGrayed <> aNewProperties.fNotesShowGrayed then AObject.ShowNotes := aNewProperties.fNotesShow; // Ширина if edConnWidth.Enabled then if FConnProp.fWidth <> aNewProperties.fWidth then ChangeConnWidth(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fWidth))); // Высота if edConnHeight.Enabled then if FConnProp.fHeight <> aNewProperties.fHeight then ChangeConnHeight(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fHeight))); // Угол if edConnAngle.Enabled then if ((FConnProp.fAngle <> aNewProperties.fAngle) or (AngleEdited = true)) then ChangeConnAngle(AObject, StrToFloat_My(aNewProperties.fAngle)); // X if edConnX.Enabled then if ((FConnProp.fX <> aNewProperties.fX) or (xEdited = true)) then ChangeConnX(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fX))); // Y if edConnY.Enabled then if ((FConnProp.fY <> aNewProperties.fY) or (yEdited = true)) then ChangeConnY(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fY))); // Z { if edConnZ.Enabled then if FConnProp.fZ <> aNewProperties.fZ then ChangeConnZ(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fZ)));} // Изменение размера шрифта подписи if cbConnCaptionsFontSize.Enabled then if FConnProp.fCaptionsFontSize <> aNewProperties.fCaptionsFontSize then ChangeConnCaptionsFontSize(AObject, StrToInt(aNewProperties.fCaptionsFontSize)); // Изменение цвета подписи if cbConnCaptionsFontColor.Enabled then if FConnProp.fCaptionsFontColor <> aNewProperties.fCaptionsFontColor then ChangeConnCaptionsFontColor(AObject, aNewProperties.fCaptionsFontColor); // Изменение размера шрифта выноски if cbConnNotesFontSize.Enabled then if FConnProp.fNotesFontSize <> aNewProperties.fNotesFontSize then ChangeConnNotesFontSize(AObject, StrToInt(aNewProperties.fNotesFontSize)); // Изменение цвета выноски if cbConnNotesFontColor.Enabled then if FConnProp.fNotesFontColor <> aNewProperties.fNotesFontColor then ChangeConnNotesFontColor(AObject, aNewProperties.fNotesFontColor); // вид отображения подписей if tbConn_CaptionLeft.Enabled then if FConnProp.fCaptionsShowType <> aNewProperties.fCaptionsShowType then ChangeConnCaptionsViewType(AObject, aNewProperties.fCaptionsShowType); // вид отображения выносок if tbConn_UpLeftSide.Enabled then if FConnProp.fNotesShowType <> aNewProperties.fNotesShowType then ChangeConnNotesViewType(AObject, aNewProperties.fNotesShowType); if edConnDrawFigurePercent.Enabled then if ((FConnProp.fDrawFigurePercent <> aNewProperties.fDrawFigurePercent) or (GsEdited)) then ChangeConnDrawFigurePercent(AObject, StrToFloat_My(aNewProperties.fDrawFigurePercent)); // Index if aMultiple = false then begin if (FConnProp.fName <> aNewProperties.fName) or (FConnProp.fIndex <> aNewProperties.fIndex) or (FConnProp.fIndexWithName <> aNewProperties.fIndexWithName) or (FConnProp.fZ <> aNewProperties.fZ) then begin ObjectParams.MarkID := round(aNewProperties.fIndex); ObjectParams.IndexWithName := BoolToInt(aNewProperties.fIndexWithName); ObjectParams.Name := aNewProperties.fName; SaveFigureParams(AObject.ID, ObjectParams); ChangeConnIndex(AObject, aNewProperties.fIndex); end; end else begin ObjectParams := GetFigureParams(AObject.ID); if ObjectParams.IndexWithName <> BoolToInt(aNewProperties.fIndexWithName) then begin ObjectParams.IndexWithName := BoolToInt(aNewProperties.fIndexWithName); SaveFigureParams(AObject.ID, ObjectParams); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ApplyConnectorProperties', E.Message); end; end; procedure TF_SCSObjectsProp.ApplyConnectorProperty(AObject: TConnectorObject; aNewProperties: PConnectorProp; aTag: Integer); begin try if aTag = 100 then begin // Имя if edConnName.Enabled then if FConnProp.fName = aNewProperties.fName then begin AObject.FIsNameChanged := True; ChangeConnName(AObject, aNewProperties.fName); if AObject.ConnectorType <> ct_Clear then SetConnNameInCaptionOnCAD(AObject); end; end; if aTag = 101 then begin // Ширина if edConnWidth.Enabled then if FConnProp.fWidth = aNewProperties.fWidth then ChangeConnWidth(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fWidth))); end; if aTag = 102 then begin // Высота if edConnHeight.Enabled then if FConnProp.fHeight = aNewProperties.fHeight then ChangeConnHeight(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fHeight))); end; if aTag = 103 then begin // Угол if edConnAngle.Enabled then if ((FConnProp.fAngle = aNewProperties.fAngle) or (AngleEdited = True)) then ChangeConnAngle(AObject, StrToFloat_My(aNewProperties.fAngle)); end; if aTag = 104 then begin // X if edConnX.Enabled then if ((FConnProp.fX = aNewProperties.fX) or (xEdited = true)) then ChangeConnX(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fX))); end; if aTag = 105 then begin // Y if edConnY.Enabled then if ((FConnProp.fY = aNewProperties.fY) or (yEdited = true)) then ChangeConnY(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fY))); end; if aTag = 106 then begin // Z if edConnZ.Enabled then if ((FConnProp.fZ = aNewProperties.fZ) or (zEdited = true)) then ChangeConnZ(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fZ))); end; if aTag = 107 then begin // % УГО if edConnDrawFigurePercent.Enabled then if ((FConnProp.fDrawFigurePercent = aNewProperties.fDrawFigurePercent) or (GsEdited = true)) then ChangeConnDrawFigurePercent(AObject, StrToFloat_My(aNewProperties.fDrawFigurePercent)); end; if aTag = 108 then begin // изменение подписи к точ. объекту if mConnCaptionsGroup.Enabled then if not IsStringListsDifferent(FConnProp.fCaptionsGroup, aNewProperties.fCaptionsGroup) then begin ChangeConnCaptionsGroup(AObject, aNewProperties.fCaptionsGroup); AObject.FIsCaptionsChanged := True; end; end; if aTag = 109 then begin // изменение выноски к точ. объекту if mConnNotesGroup.Enabled then if not IsStringListsDifferent(FConnProp.fNotesGroup, aNewProperties.fNotesGroup) then begin ChangeConnNotesGroup(AObject, aNewProperties.fNotesGroup); AObject.FIsNotesChanged := True; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ApplyConnectorProperty', E.Message); end; end; procedure TF_SCSObjectsProp.ApplyOrtholineProperties(AObject: TOrthoLine; aNewProperties: POrtholineProp; aMultiple: Boolean); var ObjectParams: TObjectParams; begin try // Изменение Gap и Count if edLineGap.Enabled and edLineCount.Enabled then if (FLineProp.fGap <> aNewProperties.fGap) OR (FLineProp.fCount <> aNewProperties.fCount) then if not AObject.FIsRaiseUpDown then ChangeLineGapCount(AObject, StrToFloat_My(aNewProperties.fGap), StrToInt(aNewProperties.fCount)); // Изменение флага отображения длинны линии if cbLineShowLength.Enabled then // if FLineProp.fShowLength <> aNewProperties.fShowLength then // Tolik 05/04/2017 -- //if FLineProp.fShowLengthGrayed <> aNewProperties.fShowLengthGrayed then if ((FLineProp.fShowLengthGrayed <> aNewProperties.fShowLengthGrayed) or (FLineProp.fShowLength <> aNewProperties.fShowLength)) then ChangeLineShowLength(AObject, aNewProperties.fShowLength); // ДЛИНА !!! //02.04.2012 if edLineAutoLength.Enabled then if Not cbUserLength.Checked then //02.04.2012 if rbLineAutoLength.Checked then begin // Tolik -- 08/12/2015 if FormatFloat(ffMask, MetreToUOM(AObject.LineLength)) <> aNewProperties.fLength then begin // ChangeLineAutoLength(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fLength))); ChangeLineAutoLength(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fLength))); end; end; //02.04.2012 if edLineUserLength.Enabled then if cbUserLength.Checked then //02.04.2012 if rbLineUserLength.Checked then ChangeLineUserLength(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fLength))); // Изменение подписи мультилинии if edLineCaption.Enabled then if AObject.FCount <> 1 then if FLineProp.fCaption <> aNewProperties.fCaption then if not AObject.FIsRaiseUpDown then ChangeLineCaption(AObject, aNewProperties.fCaption); // Изменение имени линии if edLineName.Enabled then if FLineProp.fName <> aNewProperties.fName then begin AObject.FIsNameChanged := True; ChangeLineName(AObject, aNewProperties.fName); end; // Изменение угла поворота линии if edLineAngle.Enabled then if FLineProp.fAngle <> aNewProperties.fAngle then if not AObject.FIsRaiseUpDown then ChangeLineAngle(AObject, StrToFloat_My(aNewProperties.fAngle)); // Изменение расположения по X if edLineX.Enabled then if FLineProp.fX <> aNewProperties.fX then if not AObject.FIsRaiseUpDown then ChangeLineX(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fX))); // Изменение расположения по Y if edLineY.Enabled then if FLineProp.fY <> aNewProperties.fY then if not AObject.FIsRaiseUpDown then ChangeLineY(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fY))); // Изменение флага отображение усл.обозначений if cbLineShowBlock.Enabled then // if FLineProp.fShowBlock <> aNewProperties.fShowBlock then if FLineProp.fShowBlockGrayed <> aNewProperties.fShowBlockGrayed then //if not AObject.FIsRaiseUpDown then ChangeLineShowBlock(AObject, aNewProperties.fShowBlock); // Изменение шага усл.обозначения if edLineBlockStep.Enabled then if FLineProp.fBlockStep <> aNewProperties.fBlockStep then if not AObject.FIsRaiseUpDown then ChangeLineBlockStep(AObject, StrToFloat_My(aNewProperties.fBlockStep)); // изменение подписи к трассе if mLineCaptionsGroup.Enabled then if IsStringListsDifferent(FLineProp.fCaptionsGroup, aNewProperties.fCaptionsGroup) then begin ChangeLineCaptionsGroup(AObject, aNewProperties.fCaptionsGroup); AObject.FIsCaptionsChanged := True; end; // изменение выноски к трассе if mLineNotesGroup.Enabled then if IsStringListsDifferent(FLineProp.fNotesGroup, aNewProperties.fNotesGroup) then begin ChangeLineNotesGroup(AObject, aNewProperties.fNotesGroup); AObject.FIsNotesChanged := True; end; // изменение цвета if cbTraceColor.Enabled then if FLineProp.fColor <> aNewProperties.fColor then ChangeLineColor(AObject, aNewProperties.fColor); // изменение стиля if cbTraceStyle.Enabled then if FLineProp.fStyle <> aNewProperties.fStyle then ChangeLineStyle(AObject, aNewProperties.fStyle); // изменения ширины if edTraceWidth.Enabled then if FLineProp.fWidth <> aNewProperties.fWidth then ChangeLineWidth(AObject, StrToInt(aNewProperties.fWidth)); // изменение отображения подписей if cbLineShowCaptions.Enabled then // if FLineProp.fCaptionsShow <> aNewProperties.fCaptionsShow then if FLineProp.fCaptionsShowGrayed <> aNewProperties.fCaptionsShowGrayed then AObject.ShowCaptions := aNewProperties.fCaptionsShow; // изменение отображения выносок if cbLineShowNotes.Enabled then // if FLineProp.fNotesShow <> aNewProperties.fNotesShow then if FLineProp.fNotesShowGrayed <> aNewProperties.fNotesShowGrayed then AObject.ShowNotes := aNewProperties.fNotesShow; // Изменение высоты по Z if edLineZ.Enabled then if FLineProp.fZ <> aNewProperties.fZ then if not AObject.FIsRaiseUpDown then //Tolik 26/08/2021 -- //ChangeLineZ(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fZ))); ChangeLineZ(AObject, StrToFloat_My(aNewProperties.fZ)); // // Изменение размера шрифта подписи if cbLineCaptionsFontSize.Enabled and cbLineCaptionsFontBold.Enabled then // if (FLineProp.fCaptionsFontSize <> aNewProperties.fCaptionsFontSize) or (FLineProp.fCaptionsFontBold <> aNewProperties.fCaptionsFontBold) then if (FLineProp.fCaptionsFontSize <> aNewProperties.fCaptionsFontSize) or (FLineProp.fCaptionsFontBoldGrayed <> aNewProperties.fCaptionsFontBoldGrayed) then ChangeLineCaptionsFontSize(AObject, StrToInt(aNewProperties.fCaptionsFontSize), aNewProperties.fCaptionsFontBold); // Изменение цвета подписи if cbLineCaptionsFontColor.Enabled then if FLineProp.fCaptionsFontColor <> aNewProperties.fCaptionsFontColor then ChangeLineCaptionsFontColor(AObject, aNewProperties.fCaptionsFontColor); // Изменение размера шрифта выноски if cbLineNotesFontSize.Enabled then if FLineProp.fNotesFontSize <> aNewProperties.fNotesFontSize then ChangeLineNotesFontSize(AObject, StrToInt(aNewProperties.fNotesFontSize)); // Изменение цвета выноски if cbLineNotesFontColor.Enabled then if FLineProp.fNotesFontColor <> aNewProperties.fNotesFontColor then ChangeLineNotesFontColor(AObject, aNewProperties.fNotesFontColor); // вид отображения подписей if tbLine_OverLine.Enabled then if FLineProp.fCaptionsShowType <> aNewProperties.fCaptionsShowType then ChangeLineCaptionsViewType(AObject, aNewProperties.fCaptionsShowType); // вид отображения выносок if tbLine_UpLeftSide.Enabled then if FLineProp.fNotesShowType <> aNewProperties.fNotesShowType then ChangeLineNotesViewType(AObject, aNewProperties.fNotesShowType); if edLineDrawFigurePercent.Enabled then if FLineProp.fDrawFigurePercent <> aNewProperties.fDrawFigurePercent then ChangeLineDrawFigurePercent(AObject, StrToFloat_My(aNewProperties.fDrawFigurePercent)); // Index if aMultiple = false then begin if (FLineProp.fName <> aNewProperties.fName) or (FLineProp.fIndex <> aNewProperties.fIndex) or (FLineProp.fIndexWithName <> aNewProperties.fIndexWithName) then begin ObjectParams.MarkID := round(aNewProperties.fIndex); ObjectParams.IndexWithName := BoolToInt(aNewProperties.fIndexWithName); ObjectParams.Name := aNewProperties.fName; SaveFigureParams(AObject.ID, ObjectParams); ChangeLineIndex(AObject, aNewProperties.fIndex); end; end else begin ObjectParams := GetFigureParams(AObject.ID); if ObjectParams.IndexWithName <> BoolToInt(aNewProperties.fIndexWithName) then begin ObjectParams.IndexWithName := BoolToInt(aNewProperties.fIndexWithName); SaveFigureParams(AObject.ID, ObjectParams); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ApplyOrtholineProperties', E.Message); end; end; procedure TF_SCSObjectsProp.ApplyOrtholineProperty(AObject: TOrthoLine; aNewProperties: POrtholineProp; aTag: Integer); begin try if aTag = 200 then begin // Изменение имени линии if edLineName.Enabled then if FLineProp.fName = aNewProperties.fName then begin AObject.FIsNameChanged := True; ChangeLineName(AObject, aNewProperties.fName); end; end; if aTag = 201 then begin // Изменение подписи мультилинии if edLineCaption.Enabled then if AObject.FCount <> 1 then if FLineProp.fCaption = aNewProperties.fCaption then if not AObject.FIsRaiseUpDown then ChangeLineCaption(AObject, aNewProperties.fCaption); end; if (aTag = 202) or (aTag = 203) then begin // Изменение Gap и Count if edLineGap.Enabled and edLineCount.Enabled then if (FLineProp.fGap = aNewProperties.fGap) OR (FLineProp.fCount = aNewProperties.fCount) then if not AObject.FIsRaiseUpDown then ChangeLineGapCount(AObject, StrToFloat_My(aNewProperties.fGap), StrToInt(aNewProperties.fCount)); end; if aTag = 204 then begin // Изменение угла поворота линии if edLineAngle.Enabled then if FLineProp.fAngle = aNewProperties.fAngle then if not AObject.FIsRaiseUpDown then ChangeLineAngle(AObject, StrToFloat_My(aNewProperties.fAngle)); end; if aTag = 205 then begin // Изменение расположения по X if edLineX.Enabled then if FLineProp.fX = aNewProperties.fX then if not AObject.FIsRaiseUpDown then ChangeLineX(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fX))); end; if aTag = 206 then begin // Изменение расположения по Y if edLineY.Enabled then if FLineProp.fY = aNewProperties.fY then if not AObject.FIsRaiseUpDown then ChangeLineY(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fY))); end; if aTag = 207 then begin // Изменение высоты по Z if edLineZ.Enabled then if FLineProp.fZ = aNewProperties.fZ then if not AObject.FIsRaiseUpDown then ChangeLineZ(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fZ))); end; if aTag = 208 then begin // % УГО if edLineDrawFigurePercent.Enabled then if FLineProp.fDrawFigurePercent = aNewProperties.fDrawFigurePercent then ChangeLineDrawFigurePercent(AObject, StrToFloat_My(aNewProperties.fDrawFigurePercent)); end; if aTag = 209 then begin // изменения ширины if edTraceWidth.Enabled then if FLineProp.fWidth = aNewProperties.fWidth then ChangeLineWidth(AObject, StrToInt(aNewProperties.fWidth)); end; if aTag = 210 then begin // авто длина //02.04.2012 if edLineAutoLength.Enabled then if Not cbUserLength.Checked then //02.04.2012 if rbLineAutoLength.Checked then ChangeLineAutoLength(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fLength))); end; if aTag = 211 then begin // юзер длина //02.04.2012 if edLineUserLength.Enabled then //02.04.2012 if rbLineUserLength.Checked then if cbUserLength.Checked then ChangeLineUserLength(AObject, UOMToMetre(StrToFloat_My(aNewProperties.fLength))); end; if aTag = 212 then begin // Изменение шага усл.обозначения if edLineBlockStep.Enabled then if FLineProp.fBlockStep = aNewProperties.fBlockStep then //if not AObject.FIsRaiseUpDown then ChangeLineBlockStep(AObject, StrToFloat_My(aNewProperties.fBlockStep)); end; if aTag = 213 then begin // изменение подписи к трассе if mLineCaptionsGroup.Enabled then if not IsStringListsDifferent(FLineProp.fCaptionsGroup, aNewProperties.fCaptionsGroup) then begin ChangeLineCaptionsGroup(AObject, aNewProperties.fCaptionsGroup); AObject.FIsCaptionsChanged := True; end; end; if aTag = 214 then begin // изменение выноски к трассе if mLineNotesGroup.Enabled then if not IsStringListsDifferent(FLineProp.fNotesGroup, aNewProperties.fNotesGroup) then begin ChangeLineNotesGroup(AObject, aNewProperties.fNotesGroup); AObject.FIsNotesChanged := True; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ApplyOrtholineProperty', E.Message); end; end; function TF_SCSObjectsProp.GetFiguresByObjectsType(aObjectsTypeProp: TObjectsTypeProp): TList; var i: Integer; FFigure: TFigure; begin try Result := TList.Create; // одиночный объект if aObjectsTypeProp = otp_Single then Exit; // Объекты if aObjectsTypeProp = otp_ConnObjects then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).FConnRaiseType = crt_None then if TConnectorObject(FFigure).ConnectorType <> ct_Clear then Result.Add(TConnectorObject(FFigure)); end; end; // соединители if aObjectsTypeProp = otp_ConnConnectors then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).FConnRaiseType = crt_None then if TConnectorObject(FFigure).ConnectorType = ct_Clear then if TConnectorObject(FFigure).JoinedConnectorsList.Count = 0 then Result.Add(TConnectorObject(FFigure)); end; end; // вершины с-п if aObjectsTypeProp = otp_ConnRaises then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).FConnRaiseType <> crt_None then if TConnectorObject(FFigure).JoinedConnectorsList.Count = 0 then Result.Add(TConnectorObject(FFigure)); end; end; // трассы if aObjectsTypeProp = otp_LineTraces then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then if not TOrthoLine(FFigure).FIsRaiseUpDown then Result.Add(TOrthoLine(FFigure)); end; end; // с-п if aObjectsTypeProp = otp_LineRaises then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then if TOrthoLine(FFigure).FIsRaiseUpDown then Result.Add(TOrthoLine(FFigure)); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.GetFiguresByObjectsType', E.Message); end; end; function TF_SCSObjectsProp.Execute(aSCSObject: TFigure): Boolean; var i, j: Integer; FFigure: TFigure; ObjectsTypeProp: TObjectsTypeProp; begin // Tolik 01/10/2021 -- AngleEdited := False; xEdited := False; yEdited := False; zEdited := False; GsEdited := False; edConnAngle.Style.TextColor := clWindowText; edConnX.Style.TextColor := clWindowText; edConny.Style.TextColor := clWindowText; edConnz.Style.TextColor := clWindowText; edConnDrawFigurePercent.Style.TextColor := clWindowText; // isConnector := False; if aSCSObject is TconnectorObject then isConnector := true; try // ОБЪЕКТ ОДИН if GCadForm.PCad.SelectedCount = 1 then begin FIsMultiSelection := false; //02.04.2012 FObjectsTypeProp := otp_Single; gbTypes.Visible := False; edLineAutoLength.Enabled := true; Height := FNormalModeSize + 10; FGroupObjectsList.Clear; if CheckFigureByClassName(aSCSObject, cTOrthoLine) then begin if not F_SCSObjectsProp.Showing then Show; PageSCSObjects.ActivePageIndex := 1; // если это с-п или вертикаль if (TOrthoLine(aSCSObject).FIsRaiseUpDown) or (TOrthoLine(aSCSObject).FIsVertical) then OrtholinePropertiesForRaise else // если это трасса OrtholinePropertiesForNormal; LoadOrtholineProperties(TOrthoLine(aSCSObject)); bLineOK.Enabled := True; end else if CheckFigureByClassName(aSCSObject, cTConnectorObject) then begin if not F_SCSObjectsProp.Showing then Show; PageSCSObjects.ActivePageIndex := 0; // если это вершина с-п if TConnectorObject(aSCSObject).FConnRaiseType <> crt_None then ConnectorPropertiesForRaise else // если это обычный объект (РТ или соединитель) ConnectorPropertiesForNormal(TConnectorObject(aSCSObject).ConnectorType); LoadConnectorProperties(TConnectorObject(aSCSObject)); bConnOK.Enabled := True; end; end else // ЕСТЬ ГРУППА ОБЪЕКТОВ begin FIsMultiSelection := true; //02.04.2012 gbTypes.Visible := True; edLineAutoLength.Enabled := false; Height := FExtModeSize + 10; // выставить присутствующие объекты cbConnObjects.Enabled := False; cbConnConnectors.Enabled := False; cbConnRaises.Enabled := False; cbLineTraces.Enabled := False; cbLineRaises.Enabled := False; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); // ТО if CheckFigureByClassName(FFigure, cTConnectorObject) then begin // Вершина с-п if TConnectorObject(FFigure).FConnRaiseType <> crt_None then begin cbConnRaises.Enabled := True; // if TConnectorObject(FFigure) = aSCSObject then begin cbConnRaises.Checked := True; end; end else begin // соединитель if TConnectorObject(FFigure).ConnectorType = ct_Clear then begin if TConnectorObject(FFigure).JoinedConnectorsList.Count = 0 then begin cbConnConnectors.Enabled := True; // if TConnectorObject(FFigure) = aSCSObject then begin cbConnConnectors.Checked := True; end; end; end else // Объект begin cbConnObjects.Enabled := True; // if TConnectorObject(FFigure) = aSCSObject then begin cbConnObjects.Checked := True; end; end; end; end // ЛО else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin // c-п if TOrthoLine(FFigure).FIsRaiseUpDown then begin cbLineRaises.Enabled := True; // if TOrthoLine(FFigure) = aSCSObject then begin cbLineRaises.Checked := True; end; end else // Трасса begin cbLineTraces.Enabled := True; // if TOrthoLine(FFigure) = aSCSObject then begin cbLineTraces.Checked := True; end; end; end; end; // ВЫВЕСТИ СВОЙСТВА ДЛЯ НУЖНОЙ ГРУППЫ begin // группа if cbConnObjects.Checked then ObjectsTypeProp := otp_ConnObjects; if cbConnConnectors.Checked then ObjectsTypeProp := otp_ConnConnectors; if cbConnRaises.Checked then ObjectsTypeProp := otp_ConnRaises; if cbLineTraces.Checked then ObjectsTypeProp := otp_LineTraces; if cbLineRaises.Checked then ObjectsTypeProp := otp_LineRaises; // найти объект данной группы FFigure := FindFirstByObjectsType(ObjectsTypeProp); FGroupObjectsList := GetFiguresByObjectsType(ObjectsTypeProp); // от него показать свойства FObjectsTypeProp := ObjectsTypeProp; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if not F_SCSObjectsProp.Showing then Show; PageSCSObjects.ActivePageIndex := 1; // если это с-п if (TOrthoLine(FFigure).FIsRaiseUpDown) or (TOrthoLine(FFigure).FIsVertical) then OrtholinePropertiesForRaise else // если это трасса OrtholinePropertiesForNormal; LoadOrtholineProperties(TOrthoLine(FFigure)); bLineOK.Enabled := True; end else if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if not F_SCSObjectsProp.Showing then Show; PageSCSObjects.ActivePageIndex := 0; // если это вершина с-п if TConnectorObject(FFigure).FConnRaiseType <> crt_None then ConnectorPropertiesForRaise else // если это обычный объект (РТ или соединитель) ConnectorPropertiesForNormal(TConnectorObject(FFigure).ConnectorType); LoadConnectorProperties(TConnectorObject(FFigure)); bConnOK.Enabled := True; end; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.Execute', E.Message); end; end; function TF_SCSObjectsProp.FindFirstByObjectsType(aObjectsTypeProp: TObjectsTypeProp): TFigure; var i, j: Integer; FFigure: TFigure; begin try Result := nil; if aObjectsTypeProp = otp_ConnObjects then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).FConnRaiseType = crt_None then if TConnectorObject(FFigure).ConnectorType <> ct_Clear then begin Result := TConnectorObject(FFigure); exit; end; end; end; if aObjectsTypeProp = otp_ConnConnectors then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).FConnRaiseType = crt_None then if TConnectorObject(FFigure).ConnectorType = ct_Clear then begin Result := TConnectorObject(FFigure); exit; end; end; end; if aObjectsTypeProp = otp_ConnRaises then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).FConnRaiseType <> crt_None then begin Result := TConnectorObject(FFigure); exit; end; end; end; if aObjectsTypeProp = otp_LineTraces then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then if not TOrthoLine(FFigure).FIsRaiseUpDown then begin Result := TOrthoLine(FFigure); exit; end; end; end; if aObjectsTypeProp = otp_LineRaises then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then if TOrthoLine(FFigure).FIsRaiseUpDown then begin Result := TOrthoLine(FFigure); exit; end; end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.FindFirstByObjectsType', E.Message); end; end; procedure TF_SCSObjectsProp.FormCreate(Sender: TObject); begin // Tolik 01/11/2019 -- seConnIndex.Min := 0; seConnIndex.Max := 0; seLineIndex.Min := 0; seLineIndex.Max := 0; // FGroupObjectsList := TList.Create; FNormalModeSize := 518; FExtModeSize := 609; rbLineAutoLength.Visible := False; //02.04.2012 rbLineUserLength.Visible := False; //02.04.2012 FIsMultiSelection := false; //02.04.2012 end; procedure TF_SCSObjectsProp.FormDestroy(Sender: TObject); begin if FGroupObjectsList <> nil then FreeAndNil(FGroupObjectsList); end; procedure TF_SCSObjectsProp.cbConnObjectsClick(Sender: TObject); var FFigure: TFigure; begin try FObjectsTypeProp := otp_ConnObjects; // найти объект данной группы FFigure := FindFirstByObjectsType(FObjectsTypeProp); FGroupObjectsList := GetFiguresByObjectsType(FObjectsTypeProp); // от него показать свойства PageSCSObjects.ActivePageIndex := 0; if FFigure <> nil then begin ConnectorPropertiesForNormal(TConnectorObject(FFigure).ConnectorType); LoadConnectorProperties(TConnectorObject(FFigure)); bConnOK.Enabled := True; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnObjectsClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbConnConnectorsClick(Sender: TObject); var FFigure: TFigure; begin try FObjectsTypeProp := otp_ConnConnectors; // найти объект данной группы FFigure := FindFirstByObjectsType(FObjectsTypeProp); FGroupObjectsList := GetFiguresByObjectsType(FObjectsTypeProp); PageSCSObjects.ActivePageIndex := 0; if FFigure <> nil then begin ConnectorPropertiesForNormal(TConnectorObject(FFigure).ConnectorType); LoadConnectorProperties(TConnectorObject(FFigure)); bConnOK.Enabled := True; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnConnectorsClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbConnRaisesClick(Sender: TObject); var FFigure: TFigure; begin try FObjectsTypeProp := otp_ConnRaises; // найти объект данной группы FFigure := FindFirstByObjectsType(FObjectsTypeProp); FGroupObjectsList := GetFiguresByObjectsType(FObjectsTypeProp); PageSCSObjects.ActivePageIndex := 0; if FFigure <> nil then begin ConnectorPropertiesForRaise; LoadConnectorProperties(TConnectorObject(FFigure)); bConnOK.Enabled := True; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbConnRaisesClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbLineTracesClick(Sender: TObject); var FFigure: TFigure; begin try FObjectsTypeProp := otp_LineTraces; // найти объект данной группы FFigure := FindFirstByObjectsType(FObjectsTypeProp); FGroupObjectsList := GetFiguresByObjectsType(FObjectsTypeProp); // от него показать свойства PageSCSObjects.ActivePageIndex := 1; if FFigure <> nil then begin OrtholinePropertiesForNormal; LoadOrtholineProperties(TOrthoLine(FFigure)); bLineOK.Enabled := True; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbLineTracesClick', E.Message); end; end; procedure TF_SCSObjectsProp.cbLineRaisesClick(Sender: TObject); var FFigure: TFigure; begin try FObjectsTypeProp := otp_LineRaises; // найти объект данной группы FFigure := FindFirstByObjectsType(FObjectsTypeProp); FGroupObjectsList := GetFiguresByObjectsType(FObjectsTypeProp); // от него показать свойства PageSCSObjects.ActivePageIndex := 1; if FFigure <> nil then begin OrtholinePropertiesForRaise; LoadOrtholineProperties(TOrthoLine(FFigure)); bLineOK.Enabled := True; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.cbLineRaisesClick', E.Message); end; end; procedure TF_SCSObjectsProp.mLineCaptionsGroupKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var t: Integer; begin if (ssCtrl in Shift) and (Key = 13) then begin bLineOK.SetFocus; if Sender is TComponent then begin t := TComponent(sender).tag; LineOKExecute(t); end; end; end; procedure TF_SCSObjectsProp.mConnCaptionsGroupKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var t: integer; begin if (ssCtrl in Shift) and (Key = 13) then begin bConnOK.SetFocus; if Sender is TComponent then begin t := TComponent(sender).tag; ConnOKExecute(t); end; end; end; { procedure TF_SCSObjectsProp.ConnOKExecute(aTag: Integer = -1); var i: integer; NewConnProp: PConnectorProp; ApplyConn: TConnectorObject; SelFigure: TFigure; ApplyList: TList; SelList: TList; LastObjectsTypeProp: TObjectsTypeProp; begin try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; GCanRefreshProperties := False; SelList := TList.Create; // запомнить настройки New(NewConnProp); SaveConnProp(NewConnProp); FForAllConnsSameType := NewConnProp.fForAllSameType; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; // APPLY ApplyList := FGroupObjectsList; if not FClickConn.Deleted then begin ApplyConnectorProperties(FClickConn, NewConnProp, false); if aTag <> -1 then ApplyConnectorProperty(FClickConn, NewConnProp, aTag); RefreshCAD(GCadForm.PCad); end; for i := 0 to ApplyList.Count - 1 do begin ApplyConn := TConnectorObject(ApplyList[i]); if not ApplyConn.Deleted then begin if ApplyConn <> FClickConn then begin ApplyConnectorProperties(ApplyConn, NewConnProp, true); if aTag <> -1 then ApplyConnectorProperty(ApplyConn, NewConnProp, aTag); RefreshCAD(GCadForm.PCad); end; end; end; SetProjectChanged(True); if NewConnProp <> nil then begin FreeMem(NewConnProp); NewConnProp := nil; end; // перевыделить группу if (not FClickConn.Deleted) and CheckFigureByClassName(FClickConn, cTConnectorObject) then begin FClickConn.Select; end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTConnectorObject) or CheckFigureByClassName(SelFigure, cTOrthoLine) then if not SelFigure.Deleted then if SelFigure <> FClickConn then SelFigure.Select; end; LastObjectsTypeProp := FObjectsTypeProp; RefreshCAD(GCadForm.Pcad); LoadConnectorProperties(FClickConn); FreeAndNil(SelList); // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ConnOKExecute', E.Message); end; end; } // Tolik Procedure TF_SCSObjectsProp.RedefineObjIcon(aObj: TConnectorObject); var ObjCatalog: TSCSCatalog; begin if (aObj.ConnectorType = ct_NB) then if not aObj.deleted then begin ObjCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(aObj.ID); if ObjCatalog <> nil then if ObjCatalog.ActiveForm <> nil then TF_Main(ObjCatalog.ActiveForm).F_ChoiceConnectSide.DefineObjectIcon(ObjCatalog); end; end; // // Tolik -- 28/06/2016 -- оригинал закомменчен -- смотри выше procedure TF_SCSObjectsProp.ConnOKExecute(aTag: Integer = -1); var i: integer; NewConnProp: PConnectorProp; ApplyConn: TConnectorObject; SelFigure: TFigure; ApplyList: TList; SelList: TList; LastObjectsTypeProp: TObjectsTypeProp; CadRefreshFlag: Boolean; begin CadRefreshFlag := GCanRefreshCad; try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; GCanRefreshProperties := False; SelList := TList.Create; // запомнить настройки New(NewConnProp); SaveConnProp(NewConnProp); FForAllConnsSameType := NewConnProp.fForAllSameType; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; // APPLY ApplyList := FGroupObjectsList; // Tolik -- 10/11/2016-- if ApplyList.Count > 1 then GCanRefreshCad := False; try // if ((FClickConn <> nil) and (not FClickConn.Deleted)) then begin ApplyConnectorProperties(FClickConn, NewConnProp, false); if aTag <> -1 then ApplyConnectorProperty(FClickConn, NewConnProp, aTag); RefreshCAD(GCadForm.PCad); end; for i := 0 to ApplyList.Count - 1 do begin ApplyConn := TConnectorObject(ApplyList[i]); if not ApplyConn.Deleted then begin if ApplyConn <> FClickConn then begin ApplyConnectorProperties(ApplyConn, NewConnProp, true); if aTag <> -1 then ApplyConnectorProperty(ApplyConn, NewConnProp, aTag); // Tolik -- 06/07/2017 -- RedefineObjIcon(ApplyConn); // RefreshCAD(GCadForm.PCad); end; end; end; // Tolik -- 10/11/2016 -*- тут пусть ловит ошибки, чтобы случайно не вылетело совсем и не потерять флажок обновления Када except end; if ApplyList.Count > 1 then begin GCanRefreshCad := True; RefreshCAD(GCadForm.PCad); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); if NewConnProp <> nil then begin FreeMem(NewConnProp); NewConnProp := nil; end; // перевыделить группу if (FClickConn <> nil) and (not FClickConn.Deleted) and CheckFigureByClassName(FClickConn, cTConnectorObject) then begin FClickConn.Select; // Tolik -- 06/07/2017 -- RedefineObjIcon(FClickConn); // end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTConnectorObject) or CheckFigureByClassName(SelFigure, cTOrthoLine) then if not SelFigure.Deleted then if SelFigure <> FClickConn then SelFigure.Select; end; LastObjectsTypeProp := FObjectsTypeProp; RefreshCAD(GCadForm.Pcad); // Tolik -- 28/06/2016 -- чтобы не слетел SELECTION после обновления КАДА {for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[i]).ID = FClickConn.ID then begin TFigure(GCadForm.FSCSFigures[i]).Selected := True; Break; //// BREAK ////; end; end;} // // Tolik --11/07/2016 -- // LoadConnectorProperties(FClickConn); if ((FClickConn <> nil) and (not FClickConn.Deleted)) then begin LoadConnectorProperties(FClickConn); RedefineObjIcon(FClickConn); end else ClearAllProperties; // FreeAndNil(SelList); // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.ConnOKExecute', E.Message); end; GCanRefreshCad := CadRefreshFlag; end; procedure TF_SCSObjectsProp.LineOKExecute(aTag: Integer = -1); var i: integer; NewLineProp: POrtholineProp; ApplyList: TList; SelList: TList; ApplyLine: TOrthoLine; SelFigure: TFigure; LastObjectsTypeProp: TObjectsTypeProp; begin try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; GCanRefreshProperties := False; SelList := TList.Create; // запомнить параметры New(NewLineProp); SaveLineProp(NewLineProp); FForAllLinesSameType := NewLineProp.fForAllSameType; // сохранить Select for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); SelList.Add(SelFigure); end; // APPLY ApplyList := FGroupObjectsList; if not FClickLine.Deleted then begin ApplyOrtholineProperties(FClickLine, NewLineProp, false); if aTag <> -1 then ApplyOrtholineProperty(FClickLine, NewLineProp, aTag); // Tolik -- 04/12/2015 // RefreshCAD(GCadForm.PCad); // end; for i := 0 to ApplyList.Count - 1 do begin ApplyLine := TOrthoLine(ApplyList[i]); if not ApplyLine.Deleted then begin if ApplyLine <> FClickLine then begin ApplyOrtholineProperties(ApplyLine, NewLineProp, true); if aTag <> -1 then ApplyOrtholineProperty(ApplyLine, NewLineProp, aTag); // Tolik -- 04/12/2015 // RefreshCAD(GCadForm.PCad); // end; end; end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); if NewLineProp <> nil then begin // Tolik 12/10/2017 -- //FreeMem(NewLineProp); Dispose(NewLineProp); // NewLineProp := nil; end; // перевыделить группу if (not FClickLine.Deleted) and CheckFigureByClassName(FClickLine, cTOrthoLine) then begin FClickLine.Select; end; for i := 0 to SelList.Count - 1 do begin SelFigure := TFigure(SelList[i]); if CheckFigureByClassName(SelFigure, cTOrthoLine) or CheckFigureByClassName(SelFigure, cTConnectorObject) then if not SelFigure.Deleted then if SelFigure <> FClickLine then SelFigure.Select; end; LastObjectsTypeProp := FObjectsTypeProp; RefreshCAD(GCadForm.Pcad); LoadOrtholineProperties(FClickLine); FreeAndNil(SelList); // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.LineOKExecute', E.Message); end; end; procedure TF_SCSObjectsProp.edLineDrawFigurePercentKeyPress(Sender: TObject; var Key: Char); var t: integer; begin try { if (Key = '.') or (Key = ',') then if Key <> DecimalSeparator then Key := #0;} CorrectMaskKeyPress(Key); if Key = #13 then begin bLineOK.SetFocus; if Sender is TComponent then begin t := TComponent(sender).tag; LineOKExecute(t); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edLineDrawFigurePercentKeyPress', E.Message); end; end; procedure TF_SCSObjectsProp.edConnDrawFigurePercentKeyPress(Sender: TObject; var Key: Char); var t: Integer; begin try {//23.08.2012 if (Key = '.') or (Key = ',') then if Key <> DecimalSeparator then Key := #0;} CorrectMaskKeyPress(Key); if Key = #13 then begin bConnOK.SetFocus; if Sender is TComponent then begin t := TComponent(sender).tag; ConnOKExecute(t); end; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.edConnNameKeyPress', E.Message); end; end; procedure TF_SCSObjectsProp.SetUOM; begin try // система измерений if GCurrProjUnitOfMeasure = umSM then begin Label32.Caption := cMetric_sm; Label33.Caption := cMetric_sm; Label34.Caption := cMetric_sm; Label35.Caption := cMetric_sm; Label36.Caption := cMetric_sm; Label38.Caption := cMetric_sm; Label39.Caption := cMetric_sm; Label40.Caption := cMetric_sm; Label41.Caption := cMetric_sm; end; if GCurrProjUnitOfMeasure = umM then begin Label32.Caption := cMetric_m; Label33.Caption := cMetric_m; Label34.Caption := cMetric_m; Label35.Caption := cMetric_m; Label36.Caption := cMetric_m; Label38.Caption := cMetric_m; Label39.Caption := cMetric_m; Label40.Caption := cMetric_m; Label41.Caption := cMetric_m; end; if GCurrProjUnitOfMeasure = umIn then begin Label32.Caption := cWhitworth_in; Label33.Caption := cWhitworth_in; Label34.Caption := cWhitworth_in; Label35.Caption := cWhitworth_in; Label36.Caption := cWhitworth_in; Label38.Caption := cWhitworth_in; Label39.Caption := cWhitworth_in; Label40.Caption := cWhitworth_in; Label41.Caption := cWhitworth_in; end; if GCurrProjUnitOfMeasure = umFt then begin Label32.Caption := cWhitworth_ft; Label33.Caption := cWhitworth_ft; Label34.Caption := cWhitworth_ft; Label35.Caption := cWhitworth_ft; Label36.Caption := cWhitworth_ft; Label38.Caption := cWhitworth_ft; Label39.Caption := cWhitworth_ft; Label40.Caption := cWhitworth_ft; Label41.Caption := cWhitworth_ft; end; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.SetUOM', E.Message); end; end; procedure TF_SCSObjectsProp.SetMaskEdits; var FloatMask, FloatMaskUnsig: String; begin try FloatMask := GetFloatMask; FloatMaskUnsig := GetFloatMaskUnsig; // MaskEdit edLineAngle.Properties.EditMask := FloatMaskUnsig; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edLineBlockStep.Properties.EditMask := '\d?\d?' + DecimalSeparator + '\d?'; edLineAutoLength.Properties.EditMask := GetFloatMaskUnsig(5); //22.08.2012 '\d?\d?\d?\d?\d?' + DecimalSeparator + '\d?\d?\d?\d?\d?'; edLineUserLength.Properties.EditMask := GetFloatMaskUnsig(3); //22.08.2012 '\d?\d?\d?\d?\d?' + DecimalSeparator + '\d?\d?\d?'; edLineGap.Properties.EditMask := '[1-9]\d?' + DecimalSeparator + '\d?'; edLineX.Properties.EditMask := FloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edLineY.Properties.EditMask := FloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edLineZ.Properties.EditMask := FloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edLineDrawFigurePercent.Properties.EditMask := FloatMaskUnsig; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnAngle.Properties.EditMask := FloatMaskUnsig; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnWidth.Properties.EditMask := FloatMaskUnsig; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnHeight.Properties.EditMask := FloatMaskUnsig; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnX.Properties.EditMask := FloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnY.Properties.EditMask := FloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnZ.Properties.EditMask := FloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; edConnDrawFigurePercent.Properties.EditMask := FloatMaskUnsig; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; except on E: Exception do AddExceptionToLogEx('TF_SCSObjectsProp.SetMaskEdits', E.Message); end; end; procedure TF_SCSObjectsProp.cbUserLengthClick(Sender: TObject); begin try edLineUserLength.Enabled := cbUserLength.Checked; // Select Edit if F_SCSObjectsProp.Visible and edLineUserLength.Visible and edLineUserLength.Enabled and edLineUserLength.Showing then begin try edLineUserLength.SetFocus; except end; edLineUserLength.SelStart := 0; edLineUserLength.SelLength := length(edLineUserLength.Text) + 1; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'cbUserLineClick', E.Message); end; end; // Tolik -- 02/12/2015 -- переключение кнопочек состояния выравнивания для ортолинии procedure TF_SCSObjectsProp.tbLine_OverLineClick(Sender: TObject); begin tbLine_OverLine.Down := True; tbLine_Auto.Down := False; tbLine_Center.Down := False; tbLine_UnderLine.Down := False; end; procedure TF_SCSObjectsProp.tbLine_UnderLineClick(Sender: TObject); begin tbLine_UnderLine.Down := True; tbLine_Auto.Down := False; tbLine_Center.Down := False; tbLine_OverLine.Down := False; end; procedure TF_SCSObjectsProp.tbLine_CenterClick(Sender: TObject); begin tbLine_Center.Down := True; tbLine_Auto.Down := False; tbLine_OverLine.Down := False; tbLine_UnderLine.Down := False; end; procedure TF_SCSObjectsProp.tbLine_AutoClick(Sender: TObject); begin tbLine_Auto.Down := True; tbLine_Center.Down := False; tbLine_OverLine.Down := False; tbLine_UnderLine.Down := False; end; // -- Tolik 13/12/2018 -- procedure TF_SCSObjectsProp.Label42Click(Sender: TObject); var i: Integer; SelFigure: TFigure; SelCatalog: TSCSCatalog; begin for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); if not SelFigure.Deleted then begin if CheckFigureByClassName(SelFigure, cTConnectorObject) then begin SelCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(SelFigure.Id); if SelCatalog <> nil then begin TConnectorObject(SelFigure).FIsCaptionsChanged := False; TF_Main(GCadForm).F_ChoiceConnectSide.DefineObjectSignature(SelCatalog); end; end; end; end; end; end.