unit U_ChoiceConnectSide; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxLookAndFeelPainters, StdCtrls, cxButtons, cxControls, cxContainer, cxEdit, cxRadioGroup, ExtCtrls, ActnList, ActnMan, RzPanel, ComCtrls, Contnrs, DrawObjects, U_CAD, U_BaseCommon, U_BaseConstants, U_Constants, U_Common, U_SCSComponent, U_SCSLists, U_SCSClasses, U_TrunkSCS, siComp, siLngLnk, cxGraphics, cxLookAndFeels, Menus, PlatformDefaultStyleActnCtrls; type TFChoiceConnSideMode = (fmChoiceConnSide, fmChoiceLineObject); { type TConnectInterfRes = record CanConnect: Boolean; ConnectInterfCount: Integer; end; } type TF_ChoiceConnectSide = class(TForm) ActionManager1: TActionManager; Act_AddToConnList: TAction; Act_DelFromConnList: TAction; GroupBox_ConnectingList: TGroupBox; ListView_ToConnect: TListView; Panel_Container: TPanel; GroupBox_ChoiceConnSide: TGroupBox; Splitter1: TSplitter; GroupBox_Comp1: TGroupBox; Splitter2: TSplitter; Panel_InterfComp1: TPanel; ListView_InterfComp1: TListView; Panel1: TPanel; Label1: TLabel; Panel_ConnComp1: TPanel; ListView_ConnComp1: TListView; Panel3: TPanel; Label2: TLabel; GroupBox_Comp2: TGroupBox; Splitter3: TSplitter; Panel_ConnComp2: TPanel; ListView_ConnComp2: TListView; Panel4: TPanel; Label4: TLabel; Panel_InterfComp2: TPanel; ListView_InterfComp2: TListView; Panel2: TPanel; Label3: TLabel; GroupBox_ChoiceLineObject: TGroupBox; Splitter4: TSplitter; Splitter5: TSplitter; ListView_Compons1: TListView; ListView_Compons2: TListView; Panel_OKCancel: TRzPanel; Button_OK: TcxButton; Button_Cancel: TcxButton; Timer_UpdateOnJoin: TTimer; Timer_UpdateOnDisJoin: TTimer; Timer_RefreshAllLists: TTimer; Timer_DefineObjetsParamsInCAD: TTimer; RzPanel1: TRzPanel; Button_AddConnList: TcxButton; Button_DelFromConnList: TcxButton; lng_Forms: TsiLangLinked; procedure FormCreate(Sender: TObject); procedure ListView_InterfComp1Change(Sender: TObject; Item: TListItem; Change: TItemChange); procedure ListView_InterfComp2Change(Sender: TObject; Item: TListItem; Change: TItemChange); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); procedure Act_AddToConnListExecute(Sender: TObject); procedure Act_DelFromConnListExecute(Sender: TObject); procedure FormHide(Sender: TObject); procedure Panel_OKCancelResize(Sender: TObject); procedure Timer_UpdateOnJoinTimer(Sender: TObject); procedure Timer_UpdateOnDisJoinTimer(Sender: TObject); procedure Timer_RefreshAllListsTimer(Sender: TObject); procedure Timer_DefineObjetsParamsInCADTimer(Sender: TObject); private FSideCompon1: Integer; FSideCompon2: Integer; public GForm: TForm; GFormMode: TFChoiceConnSideMode; GIDComp1: Integer; GIDComp2: Integer; GConnectKind: TConnectkind; //***** Общие процедуры для всех режимов //function ConnectInterfaces(ASCSCompon1, ASCSCompon2: TSCSComponent; // ASideComp1, ASideComp2: Integer; AConnectKind: TConnectkind; ACanCabling: Boolean; // AShowMessageType: TShowMessageType; ASimulation: Boolean = false): TConnectInterfRes; function CanConnectInterfaces(AInterfDat1, AInterfDat2: TSCSInterface; AInterf1Form, AInterf2Form: TForm; AConnectKind: TConnectKind): TCheckInterfForUnionResult; function MoveItemsToConnectList(ALItem1, ALItem2: TListItem; AListView: TlistView): Boolean; function MoveItemsFromConnectList(AMoveLItem: TListItem; ATargetListView1, ATargetListView2: TListView): Boolean; procedure FreeToConectListView(AListView: TlistView); procedure RefreshCurrListComponents; procedure RefreshComponWholeLength(AComponent: TSCSComponent; AWholeObj: Pointer=nil); procedure OnAfterCopyDelComponFromObject(ASCSObject: TSCSCatalog); procedure OnAfterCopyDelCompon(ASCSCompon: TSCSComponent); procedure OnAfterCopyCompon(ASCSCompon: TSCSComponent; ASourceForm, ATargetForm: TForm); procedure OnAfterDeleteCompon(ASCSCompon: TSCSComponent); procedure OnAfterMoveComponInCatalog(ASCSCompon: TSCSComponent); procedure OnAfterMoveComponBetweenCatalogs(ASCSCompon: TSCSComponent; AOldCatalog, ANewCatalog: TSCSCatalog); procedure OnAfterConnectCompons(ASCSCompon, ASCSChild: TSCSComponent); procedure OnAfterDisConnectCompons(ASCSCompon, ASCSChild: TSCSComponent; AIDCompRel: Integer); procedure OnAfterJoinCompons(ASCSCompon1, ASCSCompon2: TSCSComponent; ASide1, ASide2: Integer); procedure OnAfterDisJoinCompons(ACompon1, ACompon2: TSCSComponent); procedure OnBeforeDeleteComponent(AComponent: TSCSComponent); procedure DeleteConnectedComponByWholeID(AWholeID: Integer); procedure InsertToConnectedComponents(AComponent, AConnectCompon: TSCSComponent; AIDSideCompon, ATypeConect: Integer); procedure DefinePortConnected(ACompon: TSCSComponent); //procedure DefineDisconnectedComponsObjects(AComponent1, AComponent2: TSCSComponent); procedure DefineObjectParams(ASCSObject: TSCSCatalog); procedure DefineObjectParamsInFuture(ASCSObject: TSCSCatalog); procedure DefineObjectParamsByServFldsInFuture(ASCSObject: TSCSCatalog; AObjectParams: TDefineObjectParams); procedure DefineObjectCoordZ(AObject: TSCSCatalog); procedure DefineObjectStatus(ASCSObject: TSCSCatalog); procedure DefineObjectHaveCableChannel(AObject: TSCSCatalog); procedure DefineObjectSignature(ASCSObject: TSCSCatalog); procedure DefineObjectNote(ASCSObject: TSCSCatalog); procedure DefineTraceStyleInCAD(ATraceObject: TSCSCatalog); procedure DefineObjectNetworkTypes(AObject: TSCSCatalog); // Tolik -- 09/06/2017 -- procedure ModifyDrawFigureByProps(AObject: TSCSCatalog); // procedure DefineObjectIcon(AObject: TSCSCatalog); procedure DefineObjectJoinedTrunk(AObject: TSCSCatalog); procedure DefineObjectParamsAfterChangeComponMark(AObject: TSCSCatalog); procedure DefineObjectsParamsAfterChangeComponMark(AObjects: TSCSCatalogs); procedure DefineObjectTrunkAfterChange(AObject: TSCSCatalog); procedure DefineChildComponsMarksByTop(ATopComponent: TSCSComponent; ANoDefineCompons: TSCSComponents); procedure DefineComponTrunkInFuture(AComponent: TSCSComponent); procedure DefineComponTrunkAfterChangeInFuture(AComponent: TSCSComponent; ARestartTimer: Boolean); procedure DefineJoinedTrunkAfterChangeInFuture(AComponent: TSCSComponent); procedure RefreshApproachInCAD(AAproachCompon: TSCSComponent); //***** Процедуры для режима fmChoiceConnSide function ChoiceSides(ACompData1, ACompData2: TSCSComponent; AConnectKind: TConnectkind): Boolean; function GetIDInterfRel(AListView: TListView): Integer; procedure SetGroupBoxCaption(AComboBox: TGroupBox; ACaption: String); procedure LoadInterfaces(AInterfaces: TSCSInterfaces; ASide: Integer; AListView: TListView); procedure LoadInterfDataToListView(AListItem: TListItem); procedure LoadComponsByInterf(ACurrCompon: Integer; AInterfListItem: TListItem; AListView_Compons: TListView); procedure FreeListView(AListView: TListView); procedure EnableAddDelInterfToConn; //***** Процедуры для режима fmChoiceLineObject function GetNumSideByObject(AObject: TSCSCatalog; AConnectObjectParams: TList): Integer; function CanConnectLineComponWithConObjects(AIDNBLineCompon, AIDPointFigure, AIDFinalFigure: Integer; aConsiderBoxAndRack: Boolean=false): Boolean; function CanJoinComponsByCAD(ACompon1, ACompon2: TSCSComponent): Boolean; function ConnectCrossWithModules(ACrossComponent, AComponFrom, AComponTo: TSCSComponent; ANoCopyCrossAsFirst: Boolean): TCrossConnectRes; function ConnectObjectCompons(AObject1, AObject2: TSCSCatalog; ASideObject1, ASideObject2: Integer; AOnlyNewLineCompon: Boolean): Boolean; function ConnectObjects(AConnectObjectParams1, AConnectObjectParams2: Tlist): Boolean; function ConnectObjectsByWay(AWay: TIntList; AFigures, ASCSObjs: TList; APosList: TIntList = nil; aConsiderBoxAndRack: Boolean=false): Boolean; function JoinWithDefineSides(AComponent1, AComponent2: TSCSComponent; ACheck: Boolean; ACompon1Interfaces: TSCSInterfaces = nil; ACompon2Interfaces: TSCSInterfaces = nil; ACanWithNoInterfaces: Boolean = false): TConnectInterfRes; procedure JoinConnectorWithLines(AConnector: TSCSCatalog; AComponentFromConnector: TSCSComponent; ALineComponsFromTraces: TSCSComponents); procedure JoinLineWithJoinedObjects(ALineObject: TSCSCatalog); procedure SetObjectComponAsCanToJoin(ASCSObject: TSCSCatalog; ACanToJoin: Boolean); // Tolik 26/09/2018 -- { function AutoConnectOverRaiseLine(APointObjectID: Integer; ARaiseLineID: Integer; AJoinedBeforeRaise, AJoinedAfterRaise: TList; ALineType: TLineType): Boolean; } function AutoConnectOverRaiseLine(APointObjectID: Integer; ARaiseLineID: Integer; AJoinedBeforeRaise, AJoinedAfterRaise: TList; ALineType: TLineType; aNoCopyList: TList = nil): Boolean; // function AutoDisconnectOverRaiseLine(ARaiseLineID: Integer; AJoinedBeforeRaise, AJoinedAfterRaise: TList): Boolean; function MakeCabling(AIDObjectList: Tlist; ASaveForUndo: Boolean=false): Boolean; function DisconnectObjects(AIDObjectList1, AIDObjectList2: Tlist): Boolean; function GetCatalogList(AConnectObjectParams: Tlist; var AComponCount: Integer): TSCSCatalogs; //function GetComponList(AInterfList: TList): TSCSComponents; procedure FreeComponList(AComponList: TList); procedure FreeCatalogList(ACatalogList: TList); procedure JoinCrossConnections(ASCSComponent: TSCSComponent); procedure LoadTrassaName(AListItem: TListItem); constructor Create(AOwner: TComponent; AForm: TForm); destructor Destroy; override; end; {var F_ChoiceConnectSide: TF_ChoiceConnectSide;} implementation Uses Unit_DM_SCS, U_Main, FIBQuery, U_ESCadClasess, U_HouseClasses, USCS_main, U_AutoTraceConnectOrder, U_PEAutotraceDialog, PCDrawing, {Tolik}Math; {$R *.dfm} { TF_ChoiceConnectSide } // ########################## Общие для режимов формы ######################## // ############################################################################# // // ##### Соединяет 2-е компоненты интерфейсами ##### (* function TF_ChoiceConnectSide.ConnectInterfaces(ASCSCompon1, ASCSCompon2: TSCSComponent; ASideComp1, ASideComp2: Integer; AConnectKind: TConnectkind; ACanCabling: Boolean; AShowMessageType: TShowMessageType; ASimulation: Boolean = false): TConnectInterfRes; var i, j: Integer; InterfList1: TSCSInterfaces; InterfList2: TSCSInterfaces; InterfDat1: TSCSInterface; InterfDat2: TSCSInterface; ID_Compon1: Integer; ID_Compon2: Integer; CanConnBusyMultiple: Boolean; CanWhile: Boolean; CanConn: Boolean; ConnectInterfCount: Integer; begin try Result.CanConnect := false; Result.ConnectInterfCount := 0; ID_Compon1 := -1; ID_Compon2 := -1; CanWhile := true; //*** Проверка на возможность соединения компонентов по // параметрам, (тип сети, цвет...) if Not TF_Main(GForm).CanConnCompon(ASCSCompon1, ASCSCompon2, cntUnion, AShowMessageType) then Exit; //// EXIT //// CanConn := false; ConnectInterfCount := 0; CanConnBusyMultiple := ACanCabling; if CanConnBusyMultiple = false then if (ASCSCompon1.IsLine = biFalse) or (ASCSCompon2.IsLine = biFalse) then CanConnBusyMultiple := true; InterfList1 := TSCSInterfaces.Create(false); InterfList2 := TSCSInterfaces.Create(false); try InterfList1.Assign(ASCSCompon1.Interfaces, laCopy); InterfList2.Assign(ASCSCompon2.Interfaces, laCopy); while CanWhile do begin CanWhile := false; for i := 0 to InterfList1.Count - 1 do begin InterfDat1 := InterfList1.Items[i]; for j := 0 to InterfList2.Count - 1 do begin InterfDat2 := InterfList2.Items[j]; if (InterfDat1.TypeI = itFunctional) and (InterfDat2.TypeI = itFunctional) then if ( ((ASideComp1 > -1) and ((InterfDat1.Side = ASideComp1) or (InterfDat1.Side = 0)) ) or (ASideComp1 = -1) ) and ( ((ASideComp2 > -1) and ((InterfDat2.Side = ASideComp2) or (InterfDat2.Side = 0)) ) or (ASideComp2 = -1) ) then if ((InterfDat1.IsBusy = biFalse) or ( (InterfDat1.Multiple = biTrue) and CanConnBusyMultiple)) and ((InterfDat2.IsBusy = biFalse) or ( (InterfDat2.Multiple = biTrue) and CanConnBusyMultiple)) then if CanConnectInterfaces(InterfDat1, InterfDat2, ASCSCompon1.ActiveForm, ASCSCompon2.ActiveForm, AConnectKind) = chrSuccess then begin if ASimulation = false then begin TF_Main(GForm).ConnectInterfaces(InterfDat1, InterfDat2, -1, cntUnion); //TF_Main(GForm).UnionInterfaces(InterfDat1.ID, InterfDat2.ID, AConnectKind); //IdentifyConnectedForPort(InterfDat1); //IdentifyConnectedForPort(InterfDat2); ID_Compon1 := InterfDat1.ID_Component; ID_Compon2 := InterfDat2.ID_Component; //if InterfDat1.Multiple = biFalse then //begin //FreeMem(InterfDat1); //InterfDat1.IsBusy := biTrue; //ASCSCompon1.Interfaces.Delete(i); //end; //if InterfDat1.Multiple = biFalse then //begin //FreeMem(InterfDat2); //InterfDat2.IsBusy := biTrue; //ASCSCompon2.Interfaces.Delete(j); //end; //CanWhile := true; end; //if InterfDat1.Multiple = biFalse then InterfList1.Delete(i); //if InterfDat1.Multiple = biFalse then InterfList2.Delete(j); CanWhile := true; CanConn := true; ConnectInterfCount := ConnectInterfCount + 1; Break; end; end; if CanWhile then Break; end; end; { //*** Проверка на возможность соединения компонентов по // другим факторам, (тип сети, цвет...) if CanConn then if Not TF_Main(GForm).CanConnCompon(ASCSCompon1, ASCSCompon2, cntUnion, AShowMessageType) then CanConn := false; } if (CanConn) and (ASimulation = false) then with TF_Main(GForm) do begin AppendToComponRel(ID_Compon1, ID_Compon2, 1, cntUnion); OnAfterJoinCompons(ASCSCompon1, ASCSCompon2, ASideComp1, ASideComp2); {//*** Если оба компонента линейного типа, то определить подсоединенные //*** объекты можна для одного, а для второго это сделается автоматически if (ASCSCompon1.IsLine = biTrue) and (ASCSCompon2.IsLine = biTrue) then DefineComponConnObjectsAfterConnect(ASCSCompon1) else begin if ASCSCompon1.IsLine = biTrue then DefineComponConnObjectsAfterConnect(ASCSCompon1); if ASCSCompon2.IsLine = biTrue then DefineComponConnObjectsAfterConnect(ASCSCompon2); end; } end; Result.CanConnect := CanConn; Result.ConnectInterfCount := ConnectInterfCount; finally InterfList1.Free; InterfList2.Free; end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.ConnectInterfaces: '+E.Message); end; end; *) // ##### Проверяет могут ли соединится интерфейсы ##### function TF_ChoiceConnectSide.CanConnectInterfaces(AInterfDat1, AInterfDat2: TSCSInterface; AInterf1Form, AInterf2Form: TForm; AConnectKind: TConnectKind): TCheckInterfForUnionResult; var HowCheck: TCheckInterfForUnionResult; begin Result := chrFail; HowCheck := {TF_Main(GForm).}CheckInterfForUnion(AInterfDat1, AInterfDat2, AInterf1Form, AInterf2Form, {AConnectKind, }cntUnion, nil, nil); Result := HowCheck; {if HowCheck = chrSuccess then Result := true;} end; // ##### Перемещает ListItems в список соединений ##### function TF_ChoiceConnectSide.MoveItemsToConnectList(ALItem1, ALItem2: TListItem; AListView: TlistView): Boolean; var ConnData: PConnectListData; ConnLItem: TlistItem; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; //Interfaces: TList; begin Result := false; try New(ConnData); ConnData.Data1 := ALItem1.Data; ConnData.Data2 := ALItem2.Data; ConnLItem := AListView.Items.Add; ConnLItem.Caption := ALItem1.Caption; ConnLItem.ImageIndex := ALItem1.ImageIndex; ConnLItem.Data := ConnData; ConnLItem.SubItems.Add(ALItem2.Caption); ConnLItem.SubItemImages[0] := ALItem2.ImageIndex; ConnLItem.Selected := true; case GFormMode of fmChoiceConnSide: begin ALItem1.Delete; ALItem2.Delete; end; fmChoiceLineObject: begin {SCSComponent1 := ConnData.Data1; SCSComponent2 := ConnData.Data2; SCSComponent1.EmConnectTo(SCSComponent2); if (SCSComponent1.IsLine = ctConn) and (SCSComponent1.GetNotBusyInterfCount = 0) then ALItem1.Delete else if SCSComponent1.IsLine = ctLine then ALItem1.Delete; if (SCSComponent2.IsLine = ctConn) and (SCSComponent2.GetNotBusyInterfCount = 0) then ALItem2.Delete else if SCSComponent2.IsLine = ctLine then ALItem2.Delete; } end; end; except on E: Exception do AddExceptionToLogEx('U_ChoiceConnectSide: MoveItemsToConnectList ', E.Message); end; Result := true; end; // ##### Перемещает ListItems из списка соединений ##### function TF_ChoiceConnectSide.MoveItemsFromConnectList( AMoveLItem: TListItem; ATargetListView1, ATargetListView2: TListView): Boolean; var ListItem1: TListItem; ListItem2: TListItem; ConnData: PConnectListData; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; function AddListItem(AListView: TListView; ACaption: String; AImageIndex: Integer; AData: Pointer): TListItem; var ResListItem: TListItem; begin Result := nil; ResListItem := AListView.Items.Add; ResListItem.Caption := ACaption; ResListItem.ImageIndex := AImageIndex; ResListItem.Data := AData; ResListItem.Selected := true; Result := ResListItem; end; function FindSCSComponInListView(AListView: TListView; ASCSComponent: TSCSComponent): Boolean; var i: Integer; begin Result := false; for i := 0 to AListView.Items.Count - 1 do if TSCSComponent(AListView.Items[i].Data).ID = ASCSComponent.ID then begin Result := True; Break; end; end; begin try Result := false; ConnData := AMoveLItem.Data; {ListItem1 := ATargetListView1.Items.Add; //ATargetListView1.Items.Add; ListItem1.Caption := AMoveLItem.Caption; ListItem1.ImageIndex := AMoveLItem.ImageIndex; ListItem1.Data := ConnData.Data1; ListItem1.Selected := true;} {ListItem2 := ATargetListView2.Items.Add; ListItem2.Caption := AMoveLItem.SubItems.Strings[0]; ListItem2.ImageIndex := AMoveLItem.SubItemImages[0]; ListItem2.Data := ConnData.Data2; ListItem2.Selected := true;} if GFormMode = fmChoiceConnSide then begin ListItem1 := AddListItem(ATargetListView1, AMoveLItem.Caption, AMoveLItem.ImageIndex, ConnData.Data1); ListItem2 := AddListItem(ATargetListView2, AMoveLItem.SubItems.Strings[0], AMoveLItem.SubItemImages[0], ConnData.Data2); LoadInterfDataToListView(ListItem1); LoadInterfDataToListView(ListItem2); //ATargetListView1.OnChange(ATargetListView1, ATargetListView1.Selected, ctText); //ATargetListView2.OnChange(ATargetListView2, ATargetListView2.Selected, ctText); end; if GFormMode = fmChoiceLineObject then begin {SCSComponent1 := ConnData.Data1; SCSComponent2 := ConnData.Data2; if Not FindSCSComponInListView(ATargetListView1, SCSComponent1) then begin ListItem1 := AddListItem(ATargetListView1, AMoveLItem.Caption, AMoveLItem.ImageIndex, ConnData.Data1); LoadTrassaName(ListItem1); end; if Not FindSCSComponInListView(ATargetListView2, SCSComponent2) then begin ListItem2 := AddListItem(ATargetListView2, AMoveLItem.SubItems.Strings[0], AMoveLItem.SubItemImages[0], ConnData.Data2); LoadTrassaName(ListItem2); end; SCSComponent1.EmDisconnect(SCSComponent2);} end; AMoveLItem.Delete; except on E: Exception do AddExceptionToLogEx('U_ChoiceConnectSide: MoveItemsFromConnectList ', E.Message); end; Result := true; end; // ##### Очищает список соединений ##### procedure TF_ChoiceConnectSide.FreeToConectListView(AListView: TlistView); var i: integer; ConnData: PConnectListData; begin for i := 0 to AListView.Items.Count - 1 do begin ConnData := AListView.Items[i].Data; if GFormMode = fmChoiceConnSide then begin FreeMem(ConnData.Data1); FreeMem(ConnData.Data2); end; FreeMem(ConnData); end; AListView.Items.Clear; end; procedure TF_ChoiceConnectSide.RefreshCurrListComponents; var CurrListNode: TTreeNode; begin Exit; ///// EXIT ///// Старая функция - немного тормозит работу программы try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// GDragPrevTickCount := GetTickCount; with TF_Main(GForm) do begin CurrListNode := nil; if Assigned(GSCSBase.CurrProject) then if GSCSBase.CurrProject.Active then if Assigned(GSCSBase.CurrProject.CurrList) then if Assigned(GSCSBase.CurrProject.CurrList.TreeViewNode) then CurrListNode := GSCSBase.CurrProject.CurrList.TreeViewNode; //FindComponOrDirInTree(CurrIDCatalogList, false); if CurrListNode <> nil then RefreshNodesText(CurrListNode, [itComponLine]); end; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.RefreshCurrListComponents: '+E.Message); end; end; procedure TF_ChoiceConnectSide.RefreshComponWholeLength(AComponent: TSCSComponent; AWholeObj: Pointer=nil); var WholeComponObj: TSCSComponents; begin if AWholeObj <> nil then TObject(AWholeObj^) := nil; if AComponent.IsLine = biTrue then begin AComponent.LoadWholeComponent(true, @WholeComponObj); AComponent.RefreshWholeLengthInFuture(WholeComponObj); AComponent.DefineFirstLast; if WholeComponObj <> nil then begin //WholeComponObj.Free; if AWholeObj <> nil then TObject(AWholeObj^) := WholeComponObj else WholeComponObj.Free; end; end; end; procedure TF_ChoiceConnectSide.OnAfterCopyDelComponFromObject(ASCSObject: TSCSCatalog); begin if Assigned(ASCSObject) then begin if ASCSObject <> nil then OpenNoExistsListInCAD(ASCSObject.GetListOwner); DefineObjectParamsInFuture(ASCSObject); end; end; procedure TF_ChoiceConnectSide.OnAfterCopyDelCompon(ASCSCompon: TSCSComponent); var ObjectOwner: TSCSCatalog; begin if ASCSCompon = nil then Exit; //// EXIT //// if TF_Main(GForm).GDBMode = bkProjectManager then begin ObjectOwner := ASCSCompon.GetFirstParentCatalog; if ObjectOwner <> nil then begin OpenNoExistsListInCAD(ObjectOwner.GetListOwner); DefineObjectParamsInFuture(ObjectOwner); ObjectOwner.ServToDefineObjParams := ObjectOwner.ServToDefineObjParams + [dopLengthNearPointObject]; ObjectOwner.NotifyChange; end; //DefineObjectFullness(ASCSCompon.GetFirstParentCatalog); { if ASCSCompon.OwnerCatalog = nil then ASCSCompon.LoadOwnerCatalog(false); //TSCSCAtalog(ASCSCompon.OwnerCatalog).LoadAllComponentsByObjectID(ASCSCompon.ObjectID, [fiAll]); DefineObjectParems(TSCSCatalog(ASCSCompon.OwnerCatalog)); DefineObjectFullness(ASCSCompon); } { DefineObjectFullness(ASCSCompon); DefineObjectNetworkTypes(TSCSCatalog(ASCSCompon.OwnerCatalog)); DefineObjectIcon(TSCSCatalog(ASCSCompon.OwnerCatalog)); //TF_Main(GForm).DM.DefineComponObjectFullness(ASCSCompon); if ASCSCompon.IsLine = biTrue then begin DefineObjectNoteInCAD(ASCSCompon); DefineTraceStyleInCAD(TSCSCatalog(ASCSCompon.OwnerCatalog)); RefreshAllLists; end; } end; end; procedure TF_ChoiceConnectSide.OnAfterCopyCompon(ASCSCompon: TSCSComponent; ASourceForm, ATargetForm: TForm); var i: Integer; ComponOwner: TSCSCatalog; begin OnAfterCopyDelCompon(ASCSCompon); if Assigned(ASourceForm) and Assigned(ATargetForm) then if (TF_Main(ASourceForm).GDBMode = bkNormBase) and (TF_Main(ATargetForm).GDBMode = bkProjectManager) then begin AddNewSprGUIDsToProjectFromComponent(ASCSCompon, ASCSCompon.ProjectOwner.Spravochnik); // Определить аксессуары, нормы и ресурсы по свойствам for i := 0 to ASCSCompon.Properties.Count - 1 do DefineComponNormResByProperty(ASCSCompon, PProperty(ASCSCompon.Properties.List^[i])); end; //*** Подключение кроссами if ASCSCompon.CrossConnections.Count > 0 then begin TF_Main(GForm).GSCSBase.CurrProject.DefineSpravDataFromOtherSpravByNewGUIDs(F_NormBase.GSCSBase.NBSpravochnik); JoinCrossConnections(ASCSCompon); if TF_Main(GForm).GDBMode = bkProjectManager then ASCSCompon.CrossConnections.Clear; //ClearList(ASCSCompon.CrossConnections); end; { //18.06.2013 if TF_Main(GForm).GDBMode = bkProjectManager then if ASCSCompon.ComponentType.SysName = ctsnCupBoard then begin ComponOwner := ASCSCompon.GetFirstParentCatalog; if ComponOwner <> nil then begin if GIsProgress then PauseProgress(true); try if MessageQuastYN(cMain_Mes138) = IDYES then FSCS_Main.SetFigureAsEndObject(GCadForm, GetFigureByID(GCadForm, ComponOwner.SCSID) ); finally if GIsProgress then PauseProgress(false); end; end; end; } end; procedure TF_ChoiceConnectSide.OnAfterDeleteCompon(ASCSCompon: TSCSComponent); begin OnAfterCopyDelCompon(ASCSCompon); end; procedure TF_ChoiceConnectSide.OnAfterMoveComponInCatalog(ASCSCompon: TSCSComponent); var SCSObject: TSCSCatalog; begin try if ASCSCompon = nil then Exit; ///// EXIT ///// if TF_Main(GForm).GDBMode = bkProjectManager then begin SCSObject := ASCSCompon.GetFirstParentCatalog; DefineObjectIcon(SCSObject); DefineObjectCoordZ(SCSObject); SCSObject.NotifyChange; {if ASCSCompon.OwnerCatalog = nil then ASCSCompon.LoadOwnerCatalog(false); DefineObjectIcon(TSCSCatalog(ASCSCompon.OwnerCatalog)); } end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.OnAfterMoveComponInCatalog: '+E.Message); end; end; procedure TF_ChoiceConnectSide.OnAfterMoveComponBetweenCatalogs(ASCSCompon: TSCSComponent; AOldCatalog, ANewCatalog: TSCSCatalog); begin try if ASCSCompon = nil then Exit; ///// EXIT ///// if TF_Main(GForm).GDBMode = bkProjectManager then begin DefineObjectParamsInFuture(AOldCatalog); DefineObjectParamsInFuture(ANewCatalog); AOldCatalog.NotifyChange; ANewCatalog.NotifyChange; //DefineObjectFullness(ASCSCompon); end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.OnAfterMoveComponBetweenCatalogs: '+E.Message); end; end; procedure TF_ChoiceConnectSide.OnAfterConnectCompons(ASCSCompon, ASCSChild: TSCSComponent); var DesignList: TSCSList; NodeList: TList; Node: TTreeNode; Dat: POBjectData; Expanded: Boolean; ChildNodes: TObjectlist; ChildNode: TTreeNode; i: Integer; OldTick, CurrTick: Cardinal; begin DesignList := nil; if TF_Main(GForm).GDBMode = bkProjectManager then begin //20.08.2012 TF_Main(GForm).DM.DefineComponNppPorts(ASCSCompon, ASCSChild); ASCSChild.DefineNppPorts(ASCSCompon); ASCSChild.DefineNppInterfaces; //TF_Main(GForm).DM.DefineNppInterfaces(ASCSChild); OnAfterCopyDelCompon(ASCSCompon); //*** Если Шкаф, то обновить его дизайн if ASCSCompon.ComponentType.SysName = ctsnCupBoard then begin DesignList := TF_Main(GForm).GSCSBase.CurrProject.GetDesignListByComponent(ASCSCompon); if Assigned(DesignList) then UpdateDesignListOnBoxChange(DesignList.CurrID, DesignList.Setting.IDFigureForDesignList); end; DefineComponTrunkAfterChangeInFuture(ASCSCompon, false); TF_Main(GForm).CalcPriceForParents(ASCSChild.ID); RemarkComponChild(ASCSCompon, ASCSChild); {if ASCSCompon.OwnerCatalog = nil then ASCSCompon.LoadOwnerCatalog(false); TSCSCAtalog(ASCSCompon.OwnerCatalog).LoadAllComponentsByObjectID(ASCSCompon.ObjectID, [fiAll]); //*** Определить заполненность на КАД DefineObjectFullness(ASCSCompon); DefineObjectNetworkTypes(TSCSCatalog(ASCSCompon.OwnerCatalog)); if ASCSCompon.IsLine = biTrue then begin DefineObjectNoteInCAD(ASCSCompon); DefineTraceStyleInCAD(TSCSCatalog(ASCSCompon.OwnerCatalog)); RefreshAllLists; end; } end else if TF_Main(GForm).GDBMode = bkNormBase then begin if ASCSCompon.IDTopComponent <> 0 then TF_Main(GForm).CalcPrice(ASCSCompon.IDTopComponent) else TF_Main(GForm).CalcPriceForParents(ASCSChild.ID); {NodeList := TList.Create; ChildNodes := TObjectlist.Create(false); for i := 0 to TF_Main(GForm).Tree_Catalog.Items.Count - 1 do begin Node := TF_Main(GForm).Tree_Catalog.Items[i]; Dat := Node.Data; if Node <> ASCSCompon.TreeViewNode then if Dat.ObjectID = ASCSCompon.ID then NodeList.Add(Node); end; for i := 0 to NodeList.Count - 1 do begin Node := NodeList.Items[i]; Expanded := Node.Expanded; DeleteChildNodes(Node); if i = 0 then begin TF_Main(GForm).FillCompl(PObjectData(Node.Data).ObjectID, Node); ChildNode := Node.getFirstChild; while ChildNode <> nil do begin ChildNodes.Add(ChildNode); ChildNode := ChildNode.getNextSibling; end; Node.Text := TF_Main(GForm).GetNameNode(Node, nil, true, true); end else begin CopyChildNodesFromList(TF_Main(GForm).Tree_Catalog, Node, ChildNodes); Node.Text := TTreeNode(NodeList[0]).Text; end; Node.Expanded := Expanded; ////Node.Text := ATargetNode.Text; //Node.Text := TF_Main(GForm).GetNameNode(Node, nil, true, true); end; FreeAndNil(ChildNodes); FreeAndNil(NodeList);} end; ASCSCompon.NotifyChange; ASCSChild.NotifyChange; ShowMessageByType(0, smtNone, ChoiceConnectSide_Msg1_1+' '+ASCSCompon.GetNameForVisible+' '+ChoiceConnectSide_Msg1_2+' '+ASCSChild.GetNameForVisible+'', '', 0); end; procedure TF_ChoiceConnectSide.OnAfterDisConnectCompons(ASCSCompon, ASCSChild: TSCSComponent; AIDCompRel: Integer); var UpperSrcCompon: TSCSComponent; DesignList: TSCSList; i: Integer; DelNodes: TObjectList; NodesToRefresh: TObjectList; Node: TTreeNode; DeletingNode: TTreeNode; ParentNode: TTreeNode; SCSComponent: TSCSComponent; begin DesignList := nil; if TF_Main(GForm).GDBMode = bkProjectManager then begin UpperSrcCompon := ASCSCompon.GetTopComponent; //20.08.2012 TF_Main(GForm).DM.DefineComponNppPorts(UpperSrcCompon); //20.08.2012 TF_Main(GForm).DM.DefineComponNppPorts(ASCSChild); OnAfterCopyDelCompon(ASCSCompon); OnAfterCopyDelCompon(ASCSChild); //*** Если Шкаф, то обновить его дизайн if ASCSCompon.ComponentType.SysName = ctsnCupBoard then begin DesignList := TF_Main(GForm).GSCSBase.CurrProject.GetDesignListByComponent(ASCSCompon); if Assigned(DesignList) then UpdateDesignListOnBoxChange(DesignList.CurrID, DesignList.Setting.IDFigureForDesignList); end; DefineComponTrunkAfterChangeInFuture(ASCSCompon, false); TF_Main(GForm).CalcPriceForParents(ASCSCompon.ID); RemarkComponChild(ASCSCompon, ASCSChild); { //*** Определить заполненность на КАД DefineObjectFullness(ASCSCompon); DefineObjectFullness(ASCSChild); //*** Предполагаеться, что оба компонента находяться в одном объекте if ASCSCompon.IsLine = biTrue then begin if ASCSCompon.OwnerCatalog = nil then ASCSCompon.LoadOwnerCatalog(false); TSCSCAtalog(ASCSCompon.OwnerCatalog).LoadAllComponentsByObjectID(ASCSCompon.ObjectID, [fiAll]); DefineObjectNoteInCAD(ASCSCompon); DefineTraceStyleInCAD(TSCSCatalog(ASCSCompon.OwnerCatalog)); RefreshAllLists; end;} end else if TF_Main(GForm).GDBMode = bkNormBase then begin if ASCSCompon.IDTopComponent <> 0 then TF_Main(GForm).CalcPrice(ASCSCompon.IDTopComponent) else TF_Main(GForm).CalcPriceForParents(ASCSChild.ID); NodesToRefresh := TObjectList.Create(false); DelNodes := TObjectList.Create(false); for i := 0 to TF_Main(GForm).Tree_Catalog.Items.Count - 1 do begin Node := TF_Main(GForm).Tree_Catalog.Items[i]; if Node.HasChildren and (Node.Count = 0) then if (PObjectData(Node.Data).ObjectID = ASCSCompon.ID) and (PObjectData(Node.Data).ItemType = ASCSCompon.GetItemType) then NodesToRefresh.Add(Node); //*** Занести удаляемую ветвь в список if PObjectData(Node.Data).ID_CompRel = AIDCompRel then DelNodes.Add(Node); end; for i := 0 to DelNodes.Count - 1 do begin //if i = 0 then // обновить количество 1-н раз // TF_Main(GForm).OnAddDeleteNode(TTreeNode(DelNodes.Items[i]), nil, false); ParentNode := TTreeNode(DelNodes.Items[i]).Parent; if NodesToRefresh.IndexOf(ParentNode) = -1 then NodesToRefresh.Add(ParentNode); if (ASCSChild.ServNoDelNodeInDiscomplect = false) or (DelNodes[i] <> ASCSChild.TreeViewNode) then DeleteNode(TTreeNode(DelNodes.Items[i])); //TTreeNode(DelNodes.Items[i]).Delete; {if Assigned(ParentNode) then begin if SCSComponent.ID <> PObjectData(ParentNode.Data).ObjectID then begin SCSComponent.ID := PObjectData(ParentNode.Data).ObjectID; //SCSComponent.KolComplect := DM.GetComponFieldValueAsInteger(SCSComponent.ID, fnKolComplect); SCSComponent.LoadComponentByID(SCSComponent.ID, False); end; ParentNode.Text := TF_Main(GForm).GetNameNode(ParentNode, SCSComponent, true, true); PObjectData(ParentNode.Data).ChildNodesCount := SCSComponent.KolComplect; if SCSComponent.KolComplect = 0 then ParentNode.HasChildren := false; end;} end; //*** Обновить ветви {//#20070703# SCSComponent := TSCSComponent.Create(GForm); for i := 0 to NodesToRefresh.Count - 1 do begin Node := TTreeNode(NodesToRefresh[i]); if SCSComponent.ID <> PObjectData(Node.Data).ObjectID then begin if PObjectData(Node.Data).ObjectID = ASCSCompon.ID then begin SCSComponent.Assign(ASCSCompon, false, false); SCSComponent.KolComplect := TF_Main(GForm).DM.GetComponFieldValueAsInteger(ASCSCompon.ID, fnKolComplect); end else begin SCSComponent.ID := PObjectData(Node.Data).ObjectID; SCSComponent.LoadComponentByID(SCSComponent.ID, False); end; end; Node.Text := TF_Main(GForm).GetNameNode(Node, SCSComponent, true, true); PObjectData(Node.Data).ChildNodesCount := SCSComponent.KolComplect; if SCSComponent.KolComplect = 0 then Node.HasChildren := false; end; FreeAndNil(SCSComponent);} FreeAndNil(DelNodes); FreeAndNil(NodesToRefresh); end; ASCSCompon.NotifyChange; ASCSChild.NotifyChange; ShowMessageByType(0, smtNone, ChoiceConnectSide_Msg2_1+' '+ASCSChild.GetNameForVisible+' '+ChoiceConnectSide_Msg2_2+' '+ASCSCompon.GetNameForVisible+' ', '', 0); end; procedure TF_ChoiceConnectSide.OnAfterJoinCompons(ASCSCompon1, ASCSCompon2: TSCSComponent; ASide1, ASide2: Integer); var i: integer; //id_component: Integer; //IDObjectFrom: Integer; //IDObjectTo: Integer; LineCompon: TSCSComponent; LineComponChanged: TSCSComponent; LineComponentsChanged: TSCSComponents; WholeComponent: TSCSComponents; OldWholeID: Integer; PartComponObject: TSCSCatalog; PartCompon: TSCSComponent; SCSCompon: TSCSComponent; JoinedLineCompon: TSCSComponent; SCSComponConn: TSCSComponent; MarkID: Integer; MarkIDRemoved: Integer; NameMark: String; //Node: TTreeNode; SCSObj1: TSCSCatalog; SCSObj2: TSCSCatalog; SprComponTypeFromRemovedMarkID: TNBComponentTYpe; ComponID: Integer; ComponsDefectAct: TObjectsBlob; ComponsDefectActChanged: TObjectsBlob; k: integer; Side1ToOther: integer; Side2ToOther: integer; Compon1FuncIntCount: integer; Compon2FuncIntCount: integer; From1To2Count: integer; // Tolik MaxMarkId : Integer; SprComponentType: TNBComponentType; CanChangeCounter: boolean; l: integer; SCSComponent: TSCSComponent; // { procedure DefinePortConnected(ACompon: TSCSComponent); var FirstCompon: TSCSComponent; LastCompon: TSCSComponent; FirstConnCompon: TSCSComponent; LastConnCompon: TSCSComponent; FirstPort: TSCSInterface; LastPort: TSCSInterface; begin if (ACompon.FirstIDConnectedConnCompon <> 0) and (ACompon.LastIDConnectedConnCompon <> 0) then with TF_Main(GForm).DM do begin FirstCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompon.FirstIDCompon); LastCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompon.LastIDCompon); FirstConnCompon := nil; LastConnCompon := nil; FirstPort := nil; LastPort := nil; FirstConnCompon := ACompon.FirstConnectedConnCompon; LastConnCompon := ACompon.LastConnectedConnCompon; if Assigned(FirstConnCompon) and Assigned(FirstCompon) then FirstPort := FirstConnCompon.GetPortJoinedToLine(FirstCompon); if Assigned(LastConnCompon) and Assigned(LastCompon) then LastPort := LastConnCompon.GetPortJoinedToLine(LastCompon); if (FirstPort <> nil) and (LastPort <> nil) then begin FirstPort.IDConnected := LastPort.ID; LastPort.IDConnected := FirstPort.ID; //UpdateInterfFieldAsInteger(FirstPort.ID, LastPort.ID, fnIDConnected); //UpdateInterfFieldAsInteger(LastPort.ID, FirstPort.ID, fnIDConnected); end; end; end;} { procedure DefinePortConnected(ACompon: TSCSComponent); var ConnInterfFirst: TList; ConnInterfLast: TList; i: Integer; PortCount: Integer; FirstConnCompon: TSCSComponent; LastConnCompon: TSCSComponent; ptrFirstInterf: TSCSInterface; ptrLastInterf: TSCSInterface; begin if (ACompon.FirstIDConnectedConnCompon > 0) and (ACompon.LastIDConnectedConnCompon > 0) then with TF_Main(GForm).DM do begin FirstConnCompon := ACompon.FirstConnectedConnCompon; LastConnCompon := ACompon.LastConnectedConnCompon; ConnInterfFirst := GetInterfacesThatConnectCompons(ACompon.FirstIDConnectedConnCompon, ACompon.FirstIDCompon); ConnInterfLast := GetInterfacesThatConnectCompons(ACompon.LastIDConnectedConnCompon, ACompon.LastIDCompon); if (ConnInterfFirst = nil) or (ConnInterfLast = nil) then Exit; //// EXIT //// //*** Из найденных интерфейсов оставить только нужные порты if ConnInterfFirst <> nil then begin for i := 0 to ConnInterfFirst.Count - 1 do if GetInterfCountByFilter('(id = '''+IntToStr(Integer(ConnInterfFirst[i]^))+''') and (id_component = '''+IntTostr(ACompon.FirstIDConnectedConnCompon)+''') and (isPort = '''+IntTostr(biTrue)+''')', true) = 0 then begin FreeMem(ConnInterfFirst[i]); ConnInterfFirst[i] := nil; end; ConnInterfFirst.Pack; end; if ConnInterfLast <> nil then begin for i := 0 to ConnInterfLast.Count - 1 do if GetInterfCountByFilter('(id = '''+IntToStr(Integer(ConnInterfLast[i]^))+''') and (id_component = '''+IntTostr(ACompon.LastIDConnectedConnCompon)+''') and (isPort = '''+IntTostr(biTrue)+''')', true) = 0 then begin FreeMem(ConnInterfLast[i]); ConnInterfLast[i] := nil; end; ConnInterfLast.Pack; end; //*** Сохранение указателей на порты PortCount := 0; if (ConnInterfFirst.Count > 0) and (ConnInterfLast.Count > 0) then if ConnInterfFirst.Count > ConnInterfLast.Count then PortCount := ConnInterfLast.Count else PortCount := ConnInterfFirst.Count; for i := 0 to PortCount - 1 do begin UpdateInterfFieldAsInteger(Integer(ConnInterfFirst[i]^), Integer(ConnInterfLast[i]^), fnIDConnected); UpdateInterfFieldAsInteger(Integer(ConnInterfLast[i]^), Integer(ConnInterfFirst[i]^), fnIDConnected); ptrFirstInterf := FirstConnCompon.GetInterfaceByID(Integer(ConnInterfFirst[i]^)); ptrLastInterf := LastConnCompon.GetInterfaceByID(Integer(ConnInterfLast[i]^)); if ptrFirstInterf <> nil then ptrFirstInterf.IDConnected := Integer(ConnInterfLast[i]^); if ptrLastInterf <> nil then ptrLastInterf.IDConnected := Integer(ConnInterfFirst[i]^); end; FreeList(ConnInterfFirst); FreeList(ConnInterfLast); end; end; } { procedure DefinePortConnected(ACompon: TSCSComponent); var ConnInterfFirst: TList; ConnInterfLast: TList; i: Integer; PortCount: Integer; begin if (ACompon.FirstIDConnectedConnCompon > 0) and (ACompon.LastIDConnectedConnCompon > 0) then with TF_Main(GForm).DM do begin ConnInterfFirst := GetInterfacesThatConnectCompons(ACompon.FirstIDConnectedConnCompon, ACompon.FirstIDCompon); ConnInterfLast := GetInterfacesThatConnectCompons(ACompon.LastIDConnectedConnCompon, ACompon.LastIDCompon); if (ConnInterfFirst = nil) or (ConnInterfLast = nil) then Exit; //// EXIT //// //*** Из найденных интерфейсов оставить только нужные порты ChangeSQLQuery(scsQSelect, ' select count(id) As Cnt from interface_relation '+ ' where (id = :id) and (id_component = :id_component) and (isport = '''+IntTostr(biTrue)+''') '); if ConnInterfFirst <> nil then begin for i := 0 to ConnInterfFirst.Count - 1 do begin scsQSelect.Close; scsQSelect.SetParamAsInteger('id', Integer(ConnInterfFirst[i]^) ); scsQSelect.SetParamAsInteger('id_component', ACompon.FirstIDConnectedConnCompon); scsQSelect.ExecQuery; if scsQSelect.GetFNAsInteger('Cnt') = 0 then begin FreeMem(ConnInterfFirst[i]); ConnInterfFirst[i] := nil; end; end; ConnInterfFirst.Pack; end; if ConnInterfLast <> nil then begin for i := 0 to ConnInterfLast.Count - 1 do begin scsQSelect.Close; scsQSelect.SetParamAsInteger('id', Integer(ConnInterfLast[i]^) ); scsQSelect.SetParamAsInteger('id_component', ACompon.LastIDConnectedConnCompon); scsQSelect.ExecQuery; if scsQSelect.GetFNAsInteger('cnt') = 0 then begin FreeMem(ConnInterfLast[i]); ConnInterfLast[i] := nil; end; end; ConnInterfLast.Pack; end; //*** Сохранение указателей на порты PortCount := 0; if (ConnInterfFirst.Count > 0) and (ConnInterfLast.Count > 0) then if ConnInterfFirst.Count > ConnInterfLast.Count then PortCount := ConnInterfLast.Count else PortCount := ConnInterfFirst.Count; ChangeSQLQuery(scsQOperat, ' update interface_relation set id_connected = :id_connected where id = :id '); for i := 0 to PortCount - 1 do begin scsQOperat.Close; scsQOperat.SetParamAsInteger('id', Integer(ConnInterfFirst[i]^)); scsQOperat.SetParamAsInteger('id_connected', Integer(ConnInterfLast[i]^)); scsQOperat.ExecQuery; scsQOperat.Close; scsQOperat.SetParamAsInteger('id', Integer(ConnInterfLast[i]^)); scsQOperat.SetParamAsInteger('id_connected', Integer(ConnInterfFirst[i]^)); scsQOperat.ExecQuery; end; FreeList(ConnInterfFirst); FreeList(ConnInterfLast); end; end; } { procedure InsertToConnectedComponents(AWholeID, AIDConnectCompon, AIDSideCompon, ATypeConect: Integer); var IDObject: Integer; begin if AIDConnectCompon > 0 then with TF_Main(GForm).DM do begin IDObject := GetIDCatalogByIDNoUppCompon(AIDConnectCompon); InsertToConnCompons(AWholeID, IDObject, AIDConnectCompon, AIDSideCompon, ATypeConect); end; end; } begin WholeComponent := nil; if TF_Main(GForm).GDBMode = bkProjectManager then begin {IGOR} //D0000006310 Side1ToOther := -1; Side2ToOther := -1; Compon1FuncIntCount := -1; Compon2FuncIntCount := -2; From1To2Count := -3; try for k := 0 to ASCSCompon1.Interfaces.Count - 1 do begin if ASCSCompon1.Interfaces[k].TypeI = itFunctional then // if ASCSCompon1.Interfaces[k].ConnectedInterfaces.Count > 0 then begin for i := 0 to ASCSCompon1.Interfaces[k].ConnectedInterfaces.Count - 1 do //From Dimon ;) if ASCSCompon1.Interfaces[k].ConnectedInterfaces[i].ID_Component = ASCSCompon2.ID then begin Side1ToOther := ASCSCompon1.Interfaces[k].Side; break; end; end; if Side1ToOther <> -1 then break; end; for k := 0 to ASCSCompon2.Interfaces.Count - 1 do begin if ASCSCompon2.Interfaces[k].TypeI = itFunctional then // if ASCSCompon2.Interfaces[k].ConnectedInterfaces.Count > 0 then begin for i := 0 to ASCSCompon2.Interfaces[k].ConnectedInterfaces.Count - 1 do //From Dimon ;) if ASCSCompon2.Interfaces[k].ConnectedInterfaces[i].ID_Component = ASCSCompon1.ID then begin Side2ToOther := ASCSCompon2.Interfaces[k].Side; break; end; end; if Side2ToOther <> -1 then break; end; except Side1ToOther := -1; Side2ToOther := -1; end; try if (Side1ToOther <> -1) and (Side2ToOther <> -1) then begin Compon1FuncIntCount := 0; Compon2FuncIntCount := 0; From1To2Count := 0; for k := 0 to ASCSCompon1.Interfaces.Count - 1 do begin if ASCSCompon1.Interfaces[k].TypeI = itFunctional then if ASCSCompon1.Interfaces[k].Side = Side1ToOther then begin Compon1FuncIntCount := Compon1FuncIntCount + 1; // if ASCSCompon1.Interfaces[k].ConnectedInterfaces.Count > 0 then for i := 0 to ASCSCompon1.Interfaces[k].ConnectedInterfaces.Count - 1 do //From Dimon ;) if ASCSCompon1.Interfaces[k].ConnectedInterfaces[i].ID_Component = ASCSCompon2.ID then From1To2Count := From1To2Count + 1; end; end; for k := 0 to ASCSCompon2.Interfaces.Count - 1 do begin if ASCSCompon2.Interfaces[k].TypeI = itFunctional then if ASCSCompon2.Interfaces[k].Side = Side2ToOther then begin Compon2FuncIntCount := Compon2FuncIntCount + 1; end; end; end; except Compon1FuncIntCount := -1; Compon2FuncIntCount := -2; From1To2Count := -3; end; {END} //D0000006310 //*** Если оба компонента линейного типа, то определить подсоединенные //*** объекты можна для одного, а для второго это сделается автоматически if (ASCSCompon1.GuidNB = ASCSCompon2.GuidNB) and (ASCSCompon1.IsLine = biTrue) and (ASCSCompon2.IsLine = biTrue) and //OLD OLD {ASCSCompon1.CheckJoinedByAllPosibleInterfaces(ASCSCompon2, ASide1, ASide2)} ( ((ASCSCompon1.JoinedComponents.Count <= 2) and (ASCSCompon2.JoinedComponents.Count <= 2)) or ((Compon1FuncIntCount = Compon2FuncIntCount) and (Compon2FuncIntCount = From1To2Count)) ) and (ASCSCompon1.ComponentType.SysName <> ctsnCableChannel) and (ASCSCompon2.ComponentType.SysName <> ctsnCableChannel) then begin //DefineComponConnObjectsAfterConnect(ASCSCompon1); LineCompon := nil; LineComponChanged := nil; LineComponentsChanged := TSCSComponents.Create(false); if ASCSCompon2.Whole_ID >= ASCSCompon1.Whole_ID then begin LineCompon := ASCSCompon1; LineComponChanged := ASCSCompon2; end else begin LineCompon := ASCSCompon2; LineComponChanged := ASCSCompon1; end; OldWholeID := LineComponChanged.Whole_ID; LineCompon.LoadWholeComponent(true, @WholeComponent); LineCompon.RefreshWholeLengthInFuture(WholeComponent); LineCompon.DefineFirstLast; DefinePortConnected(LineCompon); //*** обновить указатель на цельный кабель with TF_Main(GForm).DM do begin //UpdateComponFieldAsIntegerByField(ASCSCompon2.Whole_ID, ASCSCompon1.Whole_ID, fnWholeID, fnWholeID); //TF_Main(GForm).GSCSBase.CurrProject.SetComponentsNewWholeID(ASCSCompon2.Whole_ID, ASCSCompon1.Whole_ID); TF_Main(GForm).GSCSBase.CurrProject.SetComponentsNewWholeID(LineComponChanged.Whole_ID, LineCompon.Whole_ID, LineComponentsChanged); //*** Обновить данные таблици подключений DeleteConnectedComponByWholeID(LineCompon.Whole_ID); DeleteConnectedComponByWholeID(OldWholeID); {ChangeSQLQuery(scsQOperat, ' insert into connected_components (compon_whole_id, id_connect_object, id_connect_compon, id_side_compon, type_connect) '+ ' values(:compon_whole_id, :id_connect_object, :id_connect_compon, :id_side_compon, :type_connect) '); InsertToConnectedComponents(ASCSCompon1.Whole_ID, ASCSCompon1.FirstIDConnectedConnCompon, ASCSCompon1.FirstIDCompon, tcoFrom); InsertToConnectedComponents(ASCSCompon1.Whole_ID, ASCSCompon1.LastIDConnectedConnCompon, ASCSCompon1.LastIDCompon, tcoTo); } InsertToConnectedComponents(LineCompon{.Whole_ID}, LineCompon.FirstConnectedConnCompon, LineCompon.FirstIDCompon, tcoFrom); InsertToConnectedComponents(LineCompon{.Whole_ID}, LineCompon.LastConnectedConnCompon, LineCompon.LastIDCompon, tcoTo); //*** Обновить маркировки //PartCompon := TSCSComponent.Create(GForm); try MarkID := 0; MarkIDRemoved := 0; SprComponTypeFromRemovedMarkID := nil; //Tolik {B0000001} // if LineCompon.MarkID < LineComponChanged.MarkID then if ((LineCompon.MarkID < LineComponChanged.MarkID) or (LineComponChanged.MarkID = 0)) then // begin MarkID := LineCompon.MarkID; MarkIDRemoved := LineComponChanged.MarkID; SprComponTypeFromRemovedMarkID := LineComponChanged.ProjectOwner.Spravochnik.GetComponentTypeByGUID(LineComponChanged.GUIDComponentType); end else begin MarkID := LineComponChanged.MarkID; MarkIDRemoved := LineCompon.MarkID; SprComponTypeFromRemovedMarkID := LineCompon.ProjectOwner.Spravochnik.GetComponentTypeByGUID(LineCompon.GUIDComponentType); end; //Tolik if LineComponChanged.MarkID <> 0 then begin SprComponentType := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.GetComponentTypeByGUID(LineComponChanged.GUIDComponentType); if SprComponentType.ComponentType.ComponentIndex > 1 then begin dec(SprComponentType.ComponentType.ComponentIndex); end; end; for i := 0 to WholeComponent.Count - 1 do //12.03.2009 for i := 0 to LineCompon.WholeComponent.Count - 1 do begin //12.03.2009 PartCompon := nil; //12.03.2009 PartCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(LineCompon.WholeComponent[i]); PartCompon := WholeComponent[i]; if Assigned(PartCompon) then begin if PartCompon.MarkID <> MarkID then begin //PartComponObject := PartCompon.GetFirstParentCatalog; //if Assigned(PartComponObject) then //begin PartCompon.MarkID := MarkID; //Tolik PartCompon.ServToMark := false; // //Tolik //PartCompon.ServChangedMarkID := true; // //NameMark := TF_Main(GForm).MakeNameMarkComponent(PartCompon, PartComponObject, false); //PartCompon.NameMark := NameMark; //end; end; PartCompon.ServChangedNameFromTo := true; {B0000002} //Tolik ApplyChangeComponMarkID(PartCompon, true, true, nil); // //if Assigned(PartCompon.TreeViewNode) then // PartCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartCompon.TreeViewNode, PartCompon, true, true); end; end; //*** Обновить наименования в дереве для LineComponentsChanged for i := 0 to LineComponentsChanged.Count - 1 do begin PartCompon := nil; PartCompon := LineComponentsChanged[i]; //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ASCSCompon2.WholeComponent[i]); if Assigned(PartCompon) then begin PartCompon.ServChangedNameFromTo := true; //if Assigned(PartCompon.TreeViewNode) then // PartCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartCompon.TreeViewNode, PartCompon, true, true); end; end; LineCompon.MarkID := MarkID; LineComponChanged.MarkID := MarkID; // Если TIAEIA606A if (LineCompon.ProjectOwner <> nil) and (LineCompon.ProjectOwner.Setting.MarkMode = mmTIAEIA606A) then if (LineCompon.FirstIDConnectedConnCompon <> 0) and (LineCompon.LastIDConnectedConnCompon <> 0) then RemarkComponsRelatedToLineCompon(LineCompon, LineCompon.ProjectOwner); // Если больший бывший индекс линейного компонента совпадал с последним сгенерированным, то // установим значение генератора индекса в минимальное if SprComponTypeFromRemovedMarkID <> nil then if SprComponTypeFromRemovedMarkID.ComponentType.ComponentIndex = MarkIDRemoved then ; //15.01.2011 LineCompon.ProjectOwner.SetComponMarkIDGeneratorToMin(SprComponTypeFromRemovedMarkID); // Учет дефектных актов ComponsDefectAct := LineCompon.ProjectOwner.GetObjectsBlobByParams(tiComponent, obdkDefectAct, LineCompon.ID); ComponsDefectActChanged := LineCompon.ProjectOwner.GetObjectsBlobByParams(tiComponent, obdkDefectAct, LineComponChanged.ID); // Дефектный акт главного куска кабеля идет на подключенный кусок if ComponsDefectAct <> nil then begin // список ID подключенных кусков for i := 0 to LineComponentsChanged.Count - 1 do begin PartCompon := LineComponentsChanged[i]; if ComponsDefectAct.ObjIDs.IndexOf(PartCompon.ID) = -1 then ComponsDefectAct.ObjIDs.Add(PartCompon.ID); if ComponsDefectActChanged <> nil then ComponsDefectActChanged.ObjIDs.Remove(PartCompon.ID); end; if ComponsDefectActChanged.ObjIDs.Count = 0 then ComponsDefectActChanged.Owner.DeleteObjectsBlob(ComponsDefectActChanged); end else if ComponsDefectActChanged <> nil then begin // добавляем список ID основных кусков for i := 0 to LineCompon.WholeComponent.Count - 1 do begin ComponID := LineCompon.WholeComponent[i]; if LineComponentsChanged.GetComponenByID(ComponID) = nil then if ComponsDefectActChanged.ObjIDs.IndexOf(ComponID) = -1 then ComponsDefectActChanged.ObjIDs.Add(ComponID); end; end; RestartTimer(Timer_UpdateOnJoin); finally //PartCompon.Free; end; end; //ASCSCompon2.Whole_ID := ASCSCompon1.Whole_ID; LineComponChanged.Whole_ID := LineCompon.Whole_ID; FreeAndNil(LineComponentsChanged); end else if (ASCSCompon1.IsLine = biFalse) or (ASCSCompon2.IsLine = biFalse) then begin {if ASCSCompon1.IsLine = biTrue then DefineComponConnObjectsAfterConnect(ASCSCompon1); if ASCSCompon2.IsLine = biTrue then DefineComponConnObjectsAfterConnect(ASCSCompon2);} SCSCompon := nil; SCSComponConn := nil; //*** Обновление подсоединений к точечным компонентам if ASCSCompon1.IsLine = biTrue then begin SCSCompon := ASCSCompon1; SCSComponConn := ASCSCompon2; end; if ASCSCompon2.IsLine = biTrue then begin SCSCompon := ASCSCompon2; SCSComponConn := ASCSCompon1; end; if SCSCompon <> nil then begin // Если точ-й компонент внедряется в связь цельного кабеля, то он стает не цельным for i := 0 to SCSCompon.JoinedComponents.Count - 1 do begin JoinedLineCompon := SCSCompon.JoinedComponents[i]; if JoinedLineCompon.IsLine = biTrue then if JoinedLineCompon.Whole_ID = SCSCompon.Whole_ID then // Если к подключенному лин-му подключен текущий точ-й if JoinedLineCompon.JoinedComponents.IndexOf(SCSComponConn) <> -1 then OnAfterDisJoinCompons(SCSCompon, JoinedLineCompon); end; SCSCompon.LoadWholeComponent(true, @WholeComponent); SCSCompon.RefreshWholeLengthInFuture(WholeComponent); SCSCompon.DefineFirstLast; DefinePortConnected(SCSCompon); DeleteConnectedComponByWholeID(SCSCompon.Whole_ID); InsertToConnectedComponents(SCSCompon{.Whole_ID}, SCSCompon.FirstConnectedConnCompon, SCSCompon.FirstIDCompon, tcoFrom); InsertToConnectedComponents(SCSCompon{.Whole_ID}, SCSCompon.LastConnectedConnCompon, SCSCompon.LastIDCompon, tcoTo); //*** Обновить ветви for i := 0 to WholeComponent.Count - 1 do //12.03.2009 for i := 0 to SCSCompon.WholeComponent.Count - 1 do begin //12.03.2009 PartCompon := nil; //12.03.2009 PartCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSCompon.WholeComponent[i]); PartCompon := WholeComponent[i]; if Assigned(PartCompon) then begin PartCompon.ServChangedNameFromTo := true; //if Assigned(PartCompon.TreeViewNode) then // PartCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartCompon.TreeViewNode, PartCompon, true, true); end; end; RestartTimer(Timer_UpdateOnJoin); if SCSComponConn <> nil then begin DefineComponTrunkInFuture(SCSComponConn); if (SCSCompon.ProjectOwner <> nil) and (SCSCompon.ProjectOwner.Setting.MarkMode = mmTIAEIA606A) then if (SCSCompon.FirstIDConnectedConnCompon <> 0) and (SCSCompon.LastIDConnectedConnCompon <> 0) then RemarkComponsRelatedToPointCompon(SCSComponConn, SCSComponConn.ProjectOwner); end; end; ShowMessageByType(0, smtNone, ChoiceConnectSide_Msg3_1+' '+ASCSCompon1.GetNameForVisible+' '+ChoiceConnectSide_Msg3_2+' '+ASCSCompon2.GetNameForVisible+' ', '', 0); end; //*** Определить заполненность на КАД SCSObj1 := ASCSCompon1.GetFirstParentCatalog; SCSObj2 := ASCSCompon2.GetFirstParentCatalog; if Assigned(SCSObj1) and (SCSObj1.ServToDefineParamsInCAD = false) then DefineObjectParamsByServFldsInFuture(SCSObj1, [dopStatus]); //DefineObjectFullness(SCSObj1); if Assigned(SCSObj2) and (SCSObj2.ServToDefineParamsInCAD = false) then DefineObjectParamsByServFldsInFuture(SCSObj2, [dopStatus]); //DefineObjectFullness(SCSObj2); if (SCSObj1 = SCSObj2) and (SCSObj1.ItemType = itSCSConnector) then DefineObjectParamsByServFldsInFuture(SCSObj1, [dopIcon]); //DefineObjectIcon(SCSObj1); end; if WholeComponent <> nil then FreeAndNil(WholeComponent); ASCSCompon1.NotifyChange; ASCSCompon2.NotifyChange; end; (* procedure TF_ChoiceConnectSide.OnAfterJoinCompons(ASCSCompon1, ASCSCompon2: TSCSComponent; ASide1, ASide2: Integer); var i: integer; //id_component: Integer; //IDObjectFrom: Integer; //IDObjectTo: Integer; PartComponObject: TSCSCatalog; PartCompon: TSCSComponent; SCSCompon: TSCSComponent; SCSComponConn: TSCSComponent; MarkID: Integer; NameMark: String; //Node: TTreeNode; SCSObj1: TSCSCatalog; SCSObj2: TSCSCatalog; procedure DefinePortConnected(ACompon: TSCSComponent); var FirstCompon: TSCSComponent; LastCompon: TSCSComponent; FirstConnCompon: TSCSComponent; LastConnCompon: TSCSComponent; FirstPort: TSCSInterface; LastPort: TSCSInterface; begin if (ACompon.FirstIDConnectedConnCompon <> 0) and (ACompon.LastIDConnectedConnCompon <> 0) then with TF_Main(GForm).DM do begin FirstCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompon.FirstIDCompon); LastCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompon.LastIDCompon); FirstConnCompon := nil; LastConnCompon := nil; FirstPort := nil; LastPort := nil; FirstConnCompon := ACompon.FirstConnectedConnCompon; LastConnCompon := ACompon.LastConnectedConnCompon; if Assigned(FirstConnCompon) and Assigned(FirstCompon) then FirstPort := FirstConnCompon.GetPortJoinedToLine(FirstCompon); if Assigned(LastConnCompon) and Assigned(LastCompon) then LastPort := LastConnCompon.GetPortJoinedToLine(LastCompon); if (FirstPort <> nil) and (LastPort <> nil) then begin FirstPort.IDConnected := LastPort.ID; LastPort.IDConnected := FirstPort.ID; //UpdateInterfFieldAsInteger(FirstPort.ID, LastPort.ID, fnIDConnected); //UpdateInterfFieldAsInteger(LastPort.ID, FirstPort.ID, fnIDConnected); end; end; end; { procedure DefinePortConnected(ACompon: TSCSComponent); var ConnInterfFirst: TList; ConnInterfLast: TList; i: Integer; PortCount: Integer; FirstConnCompon: TSCSComponent; LastConnCompon: TSCSComponent; ptrFirstInterf: TSCSInterface; ptrLastInterf: TSCSInterface; begin if (ACompon.FirstIDConnectedConnCompon > 0) and (ACompon.LastIDConnectedConnCompon > 0) then with TF_Main(GForm).DM do begin FirstConnCompon := ACompon.FirstConnectedConnCompon; LastConnCompon := ACompon.LastConnectedConnCompon; ConnInterfFirst := GetInterfacesThatConnectCompons(ACompon.FirstIDConnectedConnCompon, ACompon.FirstIDCompon); ConnInterfLast := GetInterfacesThatConnectCompons(ACompon.LastIDConnectedConnCompon, ACompon.LastIDCompon); if (ConnInterfFirst = nil) or (ConnInterfLast = nil) then Exit; //// EXIT //// //*** Из найденных интерфейсов оставить только нужные порты if ConnInterfFirst <> nil then begin for i := 0 to ConnInterfFirst.Count - 1 do if GetInterfCountByFilter('(id = '''+IntToStr(Integer(ConnInterfFirst[i]^))+''') and (id_component = '''+IntTostr(ACompon.FirstIDConnectedConnCompon)+''') and (isPort = '''+IntTostr(biTrue)+''')', true) = 0 then begin FreeMem(ConnInterfFirst[i]); ConnInterfFirst[i] := nil; end; ConnInterfFirst.Pack; end; if ConnInterfLast <> nil then begin for i := 0 to ConnInterfLast.Count - 1 do if GetInterfCountByFilter('(id = '''+IntToStr(Integer(ConnInterfLast[i]^))+''') and (id_component = '''+IntTostr(ACompon.LastIDConnectedConnCompon)+''') and (isPort = '''+IntTostr(biTrue)+''')', true) = 0 then begin FreeMem(ConnInterfLast[i]); ConnInterfLast[i] := nil; end; ConnInterfLast.Pack; end; //*** Сохранение указателей на порты PortCount := 0; if (ConnInterfFirst.Count > 0) and (ConnInterfLast.Count > 0) then if ConnInterfFirst.Count > ConnInterfLast.Count then PortCount := ConnInterfLast.Count else PortCount := ConnInterfFirst.Count; for i := 0 to PortCount - 1 do begin UpdateInterfFieldAsInteger(Integer(ConnInterfFirst[i]^), Integer(ConnInterfLast[i]^), fnIDConnected); UpdateInterfFieldAsInteger(Integer(ConnInterfLast[i]^), Integer(ConnInterfFirst[i]^), fnIDConnected); ptrFirstInterf := FirstConnCompon.GetInterfaceByID(Integer(ConnInterfFirst[i]^)); ptrLastInterf := LastConnCompon.GetInterfaceByID(Integer(ConnInterfLast[i]^)); if ptrFirstInterf <> nil then ptrFirstInterf.IDConnected := Integer(ConnInterfLast[i]^); if ptrLastInterf <> nil then ptrLastInterf.IDConnected := Integer(ConnInterfFirst[i]^); end; FreeList(ConnInterfFirst); FreeList(ConnInterfLast); end; end; } { procedure DefinePortConnected(ACompon: TSCSComponent); var ConnInterfFirst: TList; ConnInterfLast: TList; i: Integer; PortCount: Integer; begin if (ACompon.FirstIDConnectedConnCompon > 0) and (ACompon.LastIDConnectedConnCompon > 0) then with TF_Main(GForm).DM do begin ConnInterfFirst := GetInterfacesThatConnectCompons(ACompon.FirstIDConnectedConnCompon, ACompon.FirstIDCompon); ConnInterfLast := GetInterfacesThatConnectCompons(ACompon.LastIDConnectedConnCompon, ACompon.LastIDCompon); if (ConnInterfFirst = nil) or (ConnInterfLast = nil) then Exit; //// EXIT //// //*** Из найденных интерфейсов оставить только нужные порты ChangeSQLQuery(scsQSelect, ' select count(id) As Cnt from interface_relation '+ ' where (id = :id) and (id_component = :id_component) and (isport = '''+IntTostr(biTrue)+''') '); if ConnInterfFirst <> nil then begin for i := 0 to ConnInterfFirst.Count - 1 do begin scsQSelect.Close; scsQSelect.SetParamAsInteger('id', Integer(ConnInterfFirst[i]^) ); scsQSelect.SetParamAsInteger('id_component', ACompon.FirstIDConnectedConnCompon); scsQSelect.ExecQuery; if scsQSelect.GetFNAsInteger('Cnt') = 0 then begin FreeMem(ConnInterfFirst[i]); ConnInterfFirst[i] := nil; end; end; ConnInterfFirst.Pack; end; if ConnInterfLast <> nil then begin for i := 0 to ConnInterfLast.Count - 1 do begin scsQSelect.Close; scsQSelect.SetParamAsInteger('id', Integer(ConnInterfLast[i]^) ); scsQSelect.SetParamAsInteger('id_component', ACompon.LastIDConnectedConnCompon); scsQSelect.ExecQuery; if scsQSelect.GetFNAsInteger('cnt') = 0 then begin FreeMem(ConnInterfLast[i]); ConnInterfLast[i] := nil; end; end; ConnInterfLast.Pack; end; //*** Сохранение указателей на порты PortCount := 0; if (ConnInterfFirst.Count > 0) and (ConnInterfLast.Count > 0) then if ConnInterfFirst.Count > ConnInterfLast.Count then PortCount := ConnInterfLast.Count else PortCount := ConnInterfFirst.Count; ChangeSQLQuery(scsQOperat, ' update interface_relation set id_connected = :id_connected where id = :id '); for i := 0 to PortCount - 1 do begin scsQOperat.Close; scsQOperat.SetParamAsInteger('id', Integer(ConnInterfFirst[i]^)); scsQOperat.SetParamAsInteger('id_connected', Integer(ConnInterfLast[i]^)); scsQOperat.ExecQuery; scsQOperat.Close; scsQOperat.SetParamAsInteger('id', Integer(ConnInterfLast[i]^)); scsQOperat.SetParamAsInteger('id_connected', Integer(ConnInterfFirst[i]^)); scsQOperat.ExecQuery; end; FreeList(ConnInterfFirst); FreeList(ConnInterfLast); end; end; } { procedure InsertToConnectedComponents(AWholeID, AIDConnectCompon, AIDSideCompon, ATypeConect: Integer); var IDObject: Integer; begin if AIDConnectCompon > 0 then with TF_Main(GForm).DM do begin IDObject := GetIDCatalogByIDNoUppCompon(AIDConnectCompon); InsertToConnCompons(AWholeID, IDObject, AIDConnectCompon, AIDSideCompon, ATypeConect); end; end; } begin if TF_Main(GForm).GDBMode = bkProjectManager then begin //*** Если оба компонента линейного типа, то определить подсоединенные //*** объекты можна для одного, а для второго это сделается автоматически if (ASCSCompon1.GuidNB = ASCSCompon2.GuidNB) and (ASCSCompon1.IsLine = biTrue) and (ASCSCompon2.IsLine = biTrue) and {ASCSCompon1.CheckJoinedByAllPosibleInterfaces(ASCSCompon2, ASide1, ASide2)} ((ASCSCompon1.JoinedComponents.Count <= 2) and (ASCSCompon2.JoinedComponents.Count <= 2)) then begin //DefineComponConnObjectsAfterConnect(ASCSCompon1); ASCSCompon1.LoadWholeComponent(true); ASCSCompon1.RefreshWholeLengthInFuture; ASCSCompon1.DefineFirstLast; DefinePortConnected(ASCSCompon1); //*** обновить указатель на цельный кабель with TF_Main(GForm).DM do begin //UpdateComponFieldAsIntegerByField(ASCSCompon2.Whole_ID, ASCSCompon1.Whole_ID, fnWholeID, fnWholeID); TF_Main(GForm).GSCSBase.CurrProject.SetComponentsNewWholeID(ASCSCompon2.Whole_ID, ASCSCompon1.Whole_ID); //*** Обновить данные таблици подключений DeleteConnectedComponByWholeID(ASCSCompon1.Whole_ID); DeleteConnectedComponByWholeID(ASCSCompon2.Whole_ID); {ChangeSQLQuery(scsQOperat, ' insert into connected_components (compon_whole_id, id_connect_object, id_connect_compon, id_side_compon, type_connect) '+ ' values(:compon_whole_id, :id_connect_object, :id_connect_compon, :id_side_compon, :type_connect) '); InsertToConnectedComponents(ASCSCompon1.Whole_ID, ASCSCompon1.FirstIDConnectedConnCompon, ASCSCompon1.FirstIDCompon, tcoFrom); InsertToConnectedComponents(ASCSCompon1.Whole_ID, ASCSCompon1.LastIDConnectedConnCompon, ASCSCompon1.LastIDCompon, tcoTo); } InsertToConnectedComponents(ASCSCompon1{.Whole_ID}, ASCSCompon1.FirstIDConnectedConnCompon, ASCSCompon1.FirstIDCompon, tcoFrom); InsertToConnectedComponents(ASCSCompon1{.Whole_ID}, ASCSCompon1.LastIDConnectedConnCompon, ASCSCompon1.LastIDCompon, tcoTo); //*** Обновить маркировки //PartCompon := TSCSComponent.Create(GForm); try if ASCSCompon1.MarkID < ASCSCompon2.MarkID then MarkID := ASCSCompon1.MarkID else MarkID := ASCSCompon2.MarkID; for i := 0 to ASCSCompon1.WholeComponent.Count - 1 do begin PartCompon := nil; PartCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ASCSCompon1.WholeComponent[i]); if Assigned(PartCompon) then begin if PartCompon.MarkID <> MarkID then begin //PartComponObject := PartCompon.GetFirstParentCatalog; //if Assigned(PartComponObject) then //begin PartCompon.MarkID := MarkID; PartCompon.ServChangedMarkID := true; //NameMark := TF_Main(GForm).MakeNameMarkComponent(PartCompon, PartComponObject, false); //PartCompon.NameMark := NameMark; //end; end; end; PartCompon.ServChangedNameFromTo := true; //if Assigned(PartCompon.TreeViewNode) then // PartCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartCompon.TreeViewNode, PartCompon, true, true); end; //*** Обновить наименования в дереве для ASCSCompon2 for i := 0 to ASCSCompon2.WholeComponent.Count - 1 do begin PartCompon := nil; PartCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ASCSCompon2.WholeComponent[i]); if Assigned(PartCompon) then begin PartCompon.ServChangedNameFromTo := true; //if Assigned(PartCompon.TreeViewNode) then // PartCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartCompon.TreeViewNode, PartCompon, true, true); end; end; ASCSCompon1.MarkID := MarkID; ASCSCompon2.MarkID := MarkID; if (ASCSCompon1.ProjectOwner <> nil) and (ASCSCompon1.ProjectOwner.Setting.MarkMode = mmTIAEIA606A) then if (ASCSCompon1.FirstIDConnectedConnCompon <> 0) and (ASCSCompon1.LastIDConnectedConnCompon <> 0) then RemarkComponsRelatedToLineCompon(ASCSCompon1, ASCSCompon1.ProjectOwner); RestartTimer(Timer_UpdateOnJoin); finally //PartCompon.Free; end; end; ASCSCompon2.Whole_ID := ASCSCompon1.Whole_ID; end else begin {if ASCSCompon1.IsLine = biTrue then DefineComponConnObjectsAfterConnect(ASCSCompon1); if ASCSCompon2.IsLine = biTrue then DefineComponConnObjectsAfterConnect(ASCSCompon2);} SCSCompon := nil; SCSComponConn := nil; //*** Обновление подсоединений к точечным компонентам if ASCSCompon1.IsLine = biTrue then begin SCSCompon := ASCSCompon1; SCSComponConn := ASCSCompon2; end; if ASCSCompon2.IsLine = biTrue then begin SCSCompon := ASCSCompon2; SCSComponConn := ASCSCompon1; end; if SCSCompon <> nil then begin SCSCompon.LoadWholeComponent(true); SCSCompon.RefreshWholeLengthInFuture; SCSCompon.DefineFirstLast; DefinePortConnected(SCSCompon); DeleteConnectedComponByWholeID(SCSCompon.Whole_ID); InsertToConnectedComponents(SCSCompon{.Whole_ID}, SCSCompon.FirstIDConnectedConnCompon, SCSCompon.FirstIDCompon, tcoFrom); InsertToConnectedComponents(SCSCompon{.Whole_ID}, SCSCompon.LastIDConnectedConnCompon, SCSCompon.LastIDCompon, tcoTo); //*** Обновить ветви for i := 0 to SCSCompon.WholeComponent.Count - 1 do begin PartCompon := nil; PartCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSCompon.WholeComponent[i]); if Assigned(PartCompon) then begin PartCompon.ServChangedNameFromTo := true; //if Assigned(PartCompon.TreeViewNode) then // PartCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartCompon.TreeViewNode, PartCompon, true, true); end; end; RestartTimer(Timer_UpdateOnJoin); if SCSComponConn <> nil then begin DefineComponTrunkInFuture(SCSComponConn); if (SCSCompon.ProjectOwner <> nil) and (SCSCompon.ProjectOwner.Setting.MarkMode = mmTIAEIA606A) then if (SCSCompon.FirstIDConnectedConnCompon <> 0) and (SCSCompon.LastIDConnectedConnCompon <> 0) then RemarkComponsRelatedToPointCompon(SCSComponConn, SCSComponConn.ProjectOwner); end; end; ShowMessageByType(0, smtNone, ChoiceConnectSide_Msg3_1+' '+ASCSCompon1.GetNameForVisible+' '+ChoiceConnectSide_Msg3_2+' '+ASCSCompon2.GetNameForVisible+' ', '', 0); end; //*** Определить заполненность на КАД SCSObj1 := ASCSCompon1.GetFirstParentCatalog; SCSObj2 := ASCSCompon2.GetFirstParentCatalog; if Assigned(SCSObj1) and (SCSObj1.ServToDefineParamsInCAD = false) then DefineObjectParamsByServFldsInFuture(SCSObj1, [dopFullness]); //DefineObjectFullness(SCSObj1); if Assigned(SCSObj2) and (SCSObj2.ServToDefineParamsInCAD = false) then DefineObjectParamsByServFldsInFuture(SCSObj2, [dopFullness]); //DefineObjectFullness(SCSObj2); if (SCSObj1 = SCSObj2) and (SCSObj1.ItemType = itSCSConnector) then DefineObjectParamsByServFldsInFuture(SCSObj1, [dopIcon]); //DefineObjectIcon(SCSObj1); end; ASCSCompon1.NotifyChange; ASCSCompon2.NotifyChange; end; *) procedure TF_ChoiceConnectSide.OnAfterDisJoinCompons(ACompon1, ACompon2: TSCSComponent); var NewWholeID: Integer; i: integer; ObjectOwner1: TSCSCatalog; ObjectOwner2: TSCSCatalog; WholeComponObj1: TSCSComponents; WholeComponObj2: TSCSComponents; WholeComponObj: TSCSComponents; //PartComponObject: TSCSCatalog; PartComponent: TSCSComponent; NewMarkID: Integer; //ComponForMark: TSCSComponent; SCSComponLine: TSCSComponent; SCSComponCon: TSCSComponent; DisjoinInDelEndPart: Boolean; WholeLineCompon: TWholeLineCompon; IsWasJoinedPointComponsInBothSides: Boolean; ComponsDefectAct: TObjectsBlob; //Tolik SCSComponent : TSCSComponent; CanGenNewMarkId : boolean; // NeedrestartTimer: boolean; procedure DefinePortDisConnectedLineComponents; var InterfList: TList; Interfac: TSCSInterface; ptrInterfaceConnected: TSCSInterface; i: Integer; LastConnectedConnCompon: TSCSComponent; LineCompon, OtherCcompon: TSCSComponent; begin if (ACompon1.IsLine = biTrue) or (ACompon2.IsLine = biTrue) then if (ACompon1.LastIDConnectedConnCompon <> 0) or (ACompon2.LastIDConnectedConnCompon <> 0) then with TF_Main(GForm).DM do begin LineCompon := nil; OtherCcompon := nil; if ACompon1.IsLine = biTrue then begin LineCompon := ACompon1; OtherCcompon := ACompon2; end; if ACompon2.IsLine = biTrue then begin LineCompon := ACompon2; OtherCcompon := ACompon1; end; LastConnectedConnCompon := nil; if Assigned(LineCompon) then if LineCompon.LastIDConnectedConnCompon <> 0 then begin //23.01.2013 if LineCompon.LastConnectedConnCompon <> nil then if LineCompon.LastConnectedConnCompon.ID = LineCompon.LastIDConnectedConnCompon then LastConnectedConnCompon := LineCompon.LastConnectedConnCompon; if LastConnectedConnCompon = nil then LastConnectedConnCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(LineCompon.LastIDConnectedConnCompon); end; {//23.01.2013 if Assigned(LastConnectedConnCompon) then begin InterfList := TList.Create; for i := 0 to LastConnectedConnCompon.Interfaces.Count - 1 do if TSCSInterface(LastConnectedConnCompon.Interfaces[i]).IDConnected > 0 then InterfList.Add(LastConnectedConnCompon.Interfaces[i]); for i := 0 to InterfList.Count - 1 do begin Interfac := InterfList[i]; //*** Проверить Эта ли связь портов ptrInterfaceConnected := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(Interfac.IDConnected); if ptrInterfaceConnected <> nil then begin //<#MemTableClear#> //UpdateInterfFieldAsInteger(Interfac.ID, 0, fnIDConnected); //UpdateInterfFieldAsInteger(Interfac.IDConnected, 0, fnIDConnected); Interfac.IDConnected := 0; ptrInterfaceConnected.IDConnected := 0; end; end; InterfList.Free; //FreeList(InterfList); end;} //23.01.2013 if Assigned(LastConnectedConnCompon) then begin for i := 0 to LastConnectedConnCompon.Interfaces.Count - 1 do begin Interfac := LastConnectedConnCompon.Interfaces[i]; if Interfac.IDConnected > 0 then begin ptrInterfaceConnected := nil; if OtherCcompon.IsLine = biFalse then ptrInterfaceConnected := OtherCcompon.GetInterfaceByID(Interfac.IDConnected) else if OtherCcompon.IsLine = biTrue then begin if OtherCcompon.LastConnectedConnCompon <> nil then ptrInterfaceConnected := OtherCcompon.LastConnectedConnCompon.GetInterfaceByID(Interfac.IDConnected); end; if ptrInterfaceConnected = nil then ptrInterfaceConnected := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(Interfac.IDConnected); if ptrInterfaceConnected <> nil then begin Interfac.IDConnected := 0; ptrInterfaceConnected.IDConnected := 0; end; end; end; end; end; end; { procedure DefinePortDisConnectedLineComponents; var InterfList: TList; Interfac: TSCSInterface; i: Integer; begin if (ACompon1.IsLine = biTrue) and (ACompon2.IsLine = biTrue) then if (ACompon1.LastIDConnectedConnCompon > 0) and (ACompon2.LastIDConnectedConnCompon > 0) then with TF_Main(GForm).DM do begin InterfList := TList.Create; SetFilterToSQLMemTable(tSQL_InterfaceRelation, '(id_component = '''+IntTostr(ACompon1.LastIDConnectedConnCompon)+''') and '+ '(id_connected <> ''0'')'); tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin New(Interfac); Interfac.ID := tSQL_InterfaceRelation.FieldByName(fnID).AsInteger; Interfac.IDConnected := tSQL_InterfaceRelation.FieldByName(fnIDConnected).AsInteger; InterfList.Add(Interfac); tSQL_InterfaceRelation.Next; end; ChangeSQLQuery(scsQSelect, ' select id from interface_relation '+ ' where (id = :id) and (id_component = '''+IntTostr(ACompon2.LastIDConnectedConnCompon)+''') '); ChangeSQLQuery(scsQOperat, ' update interface_relation set id_connected = ''0'' where id = :id '); for i := 0 to InterfList.Count - 1 do begin Interfac := InterfList[i]; //*** Проверить Эта ли связь портов SetFilterToSQLMemTable(tSQL_InterfaceRelation, 'id = '''+IntTostr(Interfac.IDConnected)+''''); if Not tSQL_InterfaceRelation.Eof then if tSQL_InterfaceRelation.FieldByName(fnIDComponent).AsInteger = ACompon2.LastIDConnectedConnCompon then begin UpdateInterfFieldAsInteger(Interfac.ID, 0, fnIDConnected); UpdateInterfFieldAsInteger(Interfac.IDConnected, 0, fnIDConnected); end; end; FreeList(InterfList); end; end; } { procedure DefinePortDisConnectedLineComponents; var InterfList: TList; Interfac: TSCSInterface; i: Integer; begin if (ACompon1.IsLine = biTrue) and (ACompon2.IsLine = biTrue) then if (ACompon1.LastIDConnectedConnCompon > 0) and (ACompon2.LastIDConnectedConnCompon > 0) then with TF_Main(GForm).DM do begin SetSQLToQuery(scsQSelect, ' select id, id_connected from interface_relation '+ ' where (id_component = '''+IntTostr(ACompon1.LastIDConnectedConnCompon)+''') and '+ ' Not(id_connected = ''0'') '); InterfList := TList.Create; while Not scsQSelect.Eof do begin New(Interfac); Interfac.ID := scsQSelect.GetFNAsInteger('ID'); Interfac.IDConnected := scsQSelect.GetFNAsInteger('ID_Connected'); InterfList.Add(Interfac); scsQSelect.Next; end; ChangeSQLQuery(scsQSelect, ' select id from interface_relation '+ ' where (id = :id) and (id_component = '''+IntTostr(ACompon2.LastIDConnectedConnCompon)+''') '); ChangeSQLQuery(scsQOperat, ' update interface_relation set id_connected = ''0'' where id = :id '); for i := 0 to InterfList.Count - 1 do begin Interfac := InterfList[i]; //*** Проверить Эта ли связь портов scsQSelect.Close; scsQSelect.SetParamAsInteger('id', Interfac.IDConnected); scsQSelect.ExecQuery; if scsQSelect.GetFNAsInteger('ID') = Interfac.IDConnected then begin scsQOperat.Close; scsQOperat.SetParamAsInteger('id', Interfac.ID); scsQOperat.ExecQuery; scsQOperat.Close; scsQOperat.SetParamAsInteger('id', Interfac.IDConnected); scsQOperat.ExecQuery; end; end; FreeList(InterfList); end; end; } {procedure RefreshComponWholeLength(AComponent: TSCSComponent); var WholeComponObj: TSCSComponents; begin if AComponent.IsLine = biTrue then begin AComponent.LoadWholeComponent(true, @WholeComponObj); AComponent.RefreshWholeLengthInFuture(WholeComponObj); AComponent.DefineFirstLast; if WholeComponObj <> nil then WholeComponObj.Free; end; end;} { procedure InsertToConnectedComponents(AComponent: TSCSComponent; ATypeConect: Integer); var //IDObject: Integer; OwnerCatalog: TSCSCatalog; begin if AIDConnectCompon > 0 then with TF_Main(GForm).DM do begin OwnerCatalog := AComponent.GetFirstParentCatalog; if Assigned(OwnerCatalog) then InsertToConnCompons(AComponent.Whole_ID, OwnerCatalog.ID, AComponent.LastIDConnectedConnCompon, ACompon1.LastIDCompon, ATypeConect); //IDObject := GetIDCatalogByIDNoUppCompon(AIDConnectCompon); //InsertToConnCompons(AWholeID, IDObject, AIDConnectCompon, AIDSideCompon, ATypeConect); end; end;} //disjoin begin //Tolik 16/05/2019 -- if GProjectClose then exit; //Tolik 04/12/2020 - if ACompon2.ProjectOwner = nil then exit; // -- если удаляется все -- нечего переопределять // //Tolik WholeComponObj1 := nil; WholeComponObj2 := nil; WholeComponObj := nil; // DisjoinInDelEndPart := false; if TF_Main(GForm).GDBMode = bkProjectManager then begin ObjectOwner1 := ACompon1.GetFirstParentCatalog; ObjectOwner2 := ACompon2.GetFirstParentCatalog; //DefineComponDisConnObjectsAfterDisConnect(ACompon1, ACompon1); //DefineComponDisConnObjectsAfterDisConnect(ACompon2, ACompon1); IsWasJoinedPointComponsInBothSides := false; if (ACompon1.IsLine = bitrue) and (ACompon2.IsLine = bitrue) then begin if ACompon1.Whole_ID = ACompon2.Whole_ID then begin RefreshComponWholeLength(ACompon1, @WholeComponObj1); RefreshComponWholeLength(ACompon2, @WholeComponObj2); //*** Обновить указатели на разъединенные порты DefinePortDisConnectedLineComponents; //*** Если разъединение идет на удалении края куска кабеля if ACompon1.ServToDelete or ACompon2.ServToDelete then begin if ACompon1.ServToDelete then if (ACompon1.ID = ACompon1.LastIDCompon) or (ACompon1.ID = ACompon1.FirstIDCompon) then DisjoinInDelEndPart := true; if ACompon2.ServToDelete then if (ACompon2.ID = ACompon2.LastIDCompon) or (ACompon2.ID = ACompon2.FirstIDCompon) then DisjoinInDelEndPart := true; end; with TF_Main(GForm).DM do //if Not DisjoinInDelEndPart then begin // Определить, были до разрыва подключения к точечным компонентам на обоих крнцах WholeLineCompon := GetLineComponsInTraceFromBase(ACompon1, false); if (WholeLineCompon.LastIDConnectedConnCompon <> 0) and (WholeLineCompon.FirstIDConnectedConnCompon <> 0) then IsWasJoinedPointComponsInBothSides := true; NewWholeID := GenNewComponentWholeID; // Tolik // NewMarkID := TF_Main(GForm).GenComponentMarkID(Acompon2); Acompon2.Whole_ID := NewWholeID; //*** Обновить данные таблици подключений DeleteConnectedComponByWholeID(ACompon1.Whole_ID); InsertToConnectedComponents(ACompon1{.Whole_ID}, ACompon1.FirstConnectedConnCompon, ACompon1.FirstIDCompon, tcoFrom); InsertToConnectedComponents(ACompon1{.Whole_ID}, ACompon1.LastConnectedConnCompon, ACompon1.LastIDCompon, tcoTo); InsertToConnectedComponents(ACompon2{.Whole_ID}, ACompon2.FirstConnectedConnCompon, ACompon2.FirstIDCompon, tcoFrom); InsertToConnectedComponents(Acompon2{.Whole_ID}, ACompon2.LastConnectedConnCompon, ACompon2.LastIDCompon, tcoTo); ComponsDefectAct := nil; if ACompon1.ProjectOwner <> nil then ComponsDefectAct := ACompon1.ProjectOwner.GetObjectsBlobByParams(tiComponent, obdkDefectAct, ACompon1.ID); CanGenNewMarkId := true; for i := 0 to WholeComponObj2.Count - 1 do //29.01.2013 begin PartComponent := WholeComponObj2[i]; if PartComponent.ServToDelete then begin CanGenNewMarkId := false; break; end; end; if CanGenNewMarkId then NewMarkID := TF_Main(GForm).GenComponentMarkID(Acompon2) else NewMarkID := Acompon2.MarkID; //29.01.2013 //for i := 0 to Acompon2.WholeComponent.Count - 1 do //begin // //UpdateComponFieldAsInteger(Integer(Acompon2.WholeComponent[i]^), NewWholeID, fnWholeID); // //UpdateComponFieldAsInteger(Integer(Acompon2.WholeComponent[i]^), NewMarkID, fnMarkID); // PartComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Acompon2.WholeComponent[i]); // if Assigned(PartComponent) then //Tolik if CanGenNewMarkId then begin // for i := 0 to WholeComponObj2.Count - 1 do //29.01.2013 begin begin PartComponent := WholeComponObj2[i]; if PartComponent <> nil then begin PartComponent.Whole_ID := NewWholeID; PartComponent.ServChangedWholeID := true; //PartComponObject := PartComponent.GetFirstParentCatalog; //if Assigned(PartComponObject) then //begin PartComponent.MarkID := NewMarkID; PartComponent.ServChangedMarkID := true; PartComponent.ServToMark := false; //Tolik ApplyChangeComponMarkID(PartComponent, true, true, nil); // // PartComponent.NameMark := TF_Main(GForm).MakeNameMarkComponent(PartComponent, PartComponObject, false); // if PartComponent.TreeViewNode <> nil then // PartComponent.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartComponent.TreeViewNode, PartComponent, true, true); //end; // Дефектный акт if ComponsDefectAct <> nil then ComponsDefectAct.ObjIDs.Remove(PartComponent.ID); end; end; end; end; //*** Обновить наименования в дереве для Acompon1 for i := 0 to WholeComponObj1.Count - 1 do //29.01.2013 begin PartComponent := WholeComponObj1[i]; //29.01.2013 //for i := 0 to Acompon1.WholeComponent.Count - 1 do //begin // PartComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Acompon1.WholeComponent[i]); // if Assigned(PartComponent) then begin PartComponent.ServChangedNameFromTo := true; //if PartComponent.TreeViewNode <> nil then // PartComponent.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartComponent.TreeViewNode, PartComponent, true, true); end; end; // Перемаркировать ранее подключенные точечные компоненты if (Acompon1.ProjectOwner <> nil) and (Acompon1.ProjectOwner.Setting.MarkMode = mmTIAEIA606A) then begin if WholeLineCompon.LastIDConnectedConnCompon <> 0 then RemarkComponentByID(WholeLineCompon.LastIDConnectedConnCompon); if WholeLineCompon.FirstIDConnectedConnCompon <> 0 then RemarkComponentByID(WholeLineCompon.FirstIDConnectedConnCompon); end; RestartTimer(Timer_UpdateOnDisJoin); end; end; if WholeComponObj1 <> nil then //29.01.2013 FreeAndNil(WholeComponObj1); if WholeComponObj2 <> nil then //29.01.2013 FreeAndNil(WholeComponObj2); end else begin SCSComponLine := nil; SCSComponCon := nil; //*** Обновление подсоединений к точечным компонентам if ACompon1.IsLine = biTrue then begin SCSComponLine := ACompon1; SCSComponCon := ACompon2; end; if ACompon2.IsLine = biTrue then begin SCSComponLine := ACompon2; SCSComponCon := ACompon1; end; if (SCSComponLine <> nil) and (SCSComponCon <> nil) then begin //29.01.2013 //SCSComponLine.LoadWholeComponent(true); //SCSComponLine.RefreshWholeLengthInFuture; //SCSComponLine.DefineFirstLast; RefreshComponWholeLength(SCSComponLine, @WholeComponObj); //29.01.2013 DefinePortDisConnectedLineComponents; //if (SCSComponLine.FirstIDConnectedConnCompon = SCSComponCon.ID) or // (SCSComponLine.LastIDConnectedConnCompon = SCSComponCon.ID) then DeleteConnectedComponByWholeID(SCSComponLine.Whole_ID); InsertToConnectedComponents(SCSComponLine{.Whole_ID}, SCSComponLine.FirstConnectedConnCompon, SCSComponLine.FirstIDCompon, tcoFrom); InsertToConnectedComponents(SCSComponLine{.Whole_ID}, SCSComponLine.LastConnectedConnCompon, SCSComponLine.LastIDCompon, tcoTo); for i := 0 to WholeComponObj.Count - 1 do begin PartComponent := WholeComponObj[i]; //29.01.2013 //for i := 0 to SCSComponLine.WholeComponent.Count - 1 do //begin // PartComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponLine.WholeComponent[i]); // if PartComponent <> nil then begin PartComponent.ServChangedNameFromTo := true; //if PartComponent.TreeViewNode <> nil then // PartComponent.TreeViewNode.Text := TF_Main(GForm).GetNameNode(PartComponent.TreeViewNode, PartComponent, true, true); end; end; RestartTimer(Timer_UpdateOnDisJoin); if SCSComponCon <> nil then begin // Перемаркировать ранее потключенные компоненты // Если TIAEIA606A if SCSComponLine.ProjectOwner <> nil then if SCSComponLine.ProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin RemarkComponsRelatedToLineCompon(SCSComponLine, SCSComponLine.ProjectOwner); RemarkComponent(SCSComponCon); end; DefineComponTrunkInFuture(SCSComponCon); end; if WholeComponObj <> nil then //29.01.2013 FreeAndNil(WholeComponObj); end; end; ShowMessageByType(0, smtNone, ChoiceConnectSide_Msg4_1+' '+ACompon1.GetNameForVisible+' '+ChoiceConnectSide_Msg4_2+' '+ACompon2.GetNameForVisible+' ', '', 0); //*** Определить заполненность на КАД //23.01.2013 - лучше сделать через таймер //if ObjectOwner1.ServToDefineParamsInCAD = false then // DefineObjectStatus(ObjectOwner1); //if ObjectOwner2.ServToDefineParamsInCAD = false then // DefineObjectStatus(ObjectOwner2); NeedrestartTimer := false; if Assigned(ObjectOwner1) then if (ObjectOwner1.ServToDefineParamsInCAD = false) then begin if ObjectOwner1.ServToDefineParamsInCAD = false then ObjectOwner1.ServToDefineObjParams := ObjectOwner1.ServToDefineObjParams + [dopStatus]; NeedrestartTimer := True; end; if Assigned(ObjectOwner2) then if (ObjectOwner2.ServToDefineParamsInCAD = false) then begin if ObjectOwner2.ServToDefineParamsInCAD = false then ObjectOwner2.ServToDefineObjParams := ObjectOwner2.ServToDefineObjParams + [dopStatus]; NeedrestartTimer := True; end; if NeedrestartTimer then RestartTimer(Timer_DefineObjetsParamsInCAD); if Assigned(ObjectOwner1) then if (ObjectOwner1 = ObjectOwner2) and (ObjectOwner1.ItemType = itSCSConnector) then DefineObjectIcon(ObjectOwner1); end; ACompon1.NotifyChange; ACompon2.NotifyChange; end; procedure TF_ChoiceConnectSide.OnBeforeDeleteComponent(AComponent: TSCSComponent); begin if (TF_Main(AComponent.ActiveForm).GDBMode = bkProjectManager) then if AComponent.ProjectOwner <> nil then begin AComponent.ProjectOwner.DeleteObjectsBlobByParams(tiComponent, obdkDefectAct, AComponent.ID, nil); end; end; procedure TF_ChoiceConnectSide.DeleteConnectedComponByWholeID(AWholeID: Integer); begin TF_Main(GForm).GSCSBase.CurrProject.ConnectedComponsList.RemoveByWholeID(AWholeID); end; procedure TF_ChoiceConnectSide.InsertToConnectedComponents(AComponent, AConnectCompon: TSCSComponent; AIDSideCompon, ATypeConect: Integer); var OwnerCatalog: TSCSCatalog; ConnectedConnCompon: TSCSComponent; IDConnectedCompon: Integer; IDConnectedObject: Integer; begin IDConnectedObject := -1; IDConnectedCompon := 0; //12.03.2009 ConnectedConnCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDConnectCompon); ConnectedConnCompon := AConnectCompon; OwnerCatalog := nil; if Assigned(ConnectedConnCompon) then begin IDConnectedCompon := ConnectedConnCompon.ID; OwnerCatalog := ConnectedConnCompon.GetFirstParentCatalog; end; if Assigned(OwnerCatalog) then IDConnectedObject := OwnerCatalog.ID; TF_Main(GForm).GSCSBase.CurrProject.ConnectedComponsList.InsertRecord(AComponent.Whole_ID, IDConnectedObject, IDConnectedCompon, AIDSideCompon, ATypeConect); { if AIDConnectCompon > 0 then with TF_Main(GForm).DM do begin ConnectedConnCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDConnectCompon); OwnerCatalog := nil; if Assigned(ConnectedConnCompon) then OwnerCatalog := ConnectedConnCompon.GetFirstParentCatalog; if Assigned(OwnerCatalog) then begin TF_Main(GForm).GSCSBase.CurrProject.ConnectedComponsList.InsertRecord(AComponent.Whole_ID, OwnerCatalog.ID, AIDConnectCompon, AIDSideCompon, ATypeConect); end; end; } end; procedure TF_ChoiceConnectSide.DefinePortConnected(ACompon: TSCSComponent); var FirstCompon: TSCSComponent; LastCompon: TSCSComponent; FirstConnCompon: TSCSComponent; LastConnCompon: TSCSComponent; FirstPort: TSCSInterface; LastPort: TSCSInterface; begin if (ACompon.FirstIDConnectedConnCompon <> 0) and (ACompon.LastIDConnectedConnCompon <> 0) then with TF_Main(GForm).DM do begin FirstCompon := nil; LastCompon := nil; if (ACompon.FirstCompon = nil) or (ACompon.FirstCompon.ID <> ACompon.FirstIDCompon) then FirstCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompon.FirstIDCompon) else FirstCompon := ACompon.FirstCompon; if (ACompon.LastCompon = nil) or (ACompon.LastCompon.ID <> ACompon.LastIDCompon) then LastCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompon.LastIDCompon) else LastCompon := ACompon.LastCompon; FirstConnCompon := nil; LastConnCompon := nil; FirstPort := nil; LastPort := nil; FirstConnCompon := ACompon.FirstConnectedConnCompon; LastConnCompon := ACompon.LastConnectedConnCompon; if Assigned(FirstConnCompon) and Assigned(FirstCompon) then FirstPort := FirstConnCompon.GetPortJoinedToLine(FirstCompon); if Assigned(LastConnCompon) and Assigned(LastCompon) then LastPort := LastConnCompon.GetPortJoinedToLine(LastCompon); if (FirstPort <> nil) and (LastPort <> nil) then begin FirstPort.IDConnected := LastPort.ID; LastPort.IDConnected := FirstPort.ID; //UpdateInterfFieldAsInteger(FirstPort.ID, LastPort.ID, fnIDConnected); //UpdateInterfFieldAsInteger(LastPort.ID, FirstPort.ID, fnIDConnected); end; end; end; { // ##### Опредиляет для разъединенных компонентов подключенные объекты ##### procedure TF_ChoiceConnectSide.DefineDisconnectedComponsObjects(AComponent1, AComponent2: TSCSComponent); begin try DefineComponDisConnObjectsAfterDisConnect(AComponent1, AComponent2); DefineComponDisConnObjectsAfterDisConnect(AComponent2, AComponent1); RefreshCurrListComponents; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineDisconnectedComponsObjects: '+E.Message); end; end; } procedure TF_ChoiceConnectSide.DefineObjectParams(ASCSObject: TSCSCatalog); begin try if (ASCSObject = nil) or (GLockDefineObjectParamsCount > 0) then Exit; //// EXIT //// if TF_Main(GForm).GDBMode = bkProjectManager then begin //if ASCSObject.SCSComponents.Count = 0 then // ASCSObject.LoadAllComponentsByObjectID(ASCSObject.ID, [fiAll]); DefineObjectStatus(ASCSObject); DefineObjectNetworkTypes(ASCSObject); DefineObjectIcon(ASCSObject); //TF_Main(GForm).DM.DefineComponObjectFullness(ASCSCompon); DefineObjectNote(ASCSObject); DefineObjectCoordZ(ASCSObject); //28.08.2013 if ASCSObject.ItemType = itSCSConnector then //28.08.2013 DefineObjectSignature(ASCSObject); DefineObjectSignature(ASCSObject); if ASCSObject.ItemType = itSCSLine then begin DefineObjectHaveCableChannel(ASCSObject); DefineTraceStyleInCAD(ASCSObject); RestartTimer(Timer_RefreshAllLists); //RefreshAllLists; end; end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineObjectParems: '+E.Message); end; end; procedure TF_ChoiceConnectSide.DefineObjectParamsInFuture(ASCSObject: TSCSCatalog); begin if Assigned(ASCSObject) then if Not ASCSObject.ServDeleteInCAD then begin ASCSObject.ServToDefineParamsInCAD := true; RestartTimer(Timer_DefineObjetsParamsInCAD); end; end; procedure TF_ChoiceConnectSide.DefineObjectParamsByServFldsInFuture(ASCSObject: TSCSCatalog; AObjectParams: TDefineObjectParams); begin if Assigned(ASCSObject) then if Not ASCSObject.ServDeleteInCAD then begin ASCSObject.ServToDefineObjParams := ASCSObject.ServToDefineObjParams + AObjectParams; RestartTimer(Timer_DefineObjetsParamsInCAD); end; end; procedure TF_ChoiceConnectSide.DefineObjectCoordZ(AObject: TSCSCatalog); var FirstComponent: TSCSComponent; ListOwner: TSCSList; SprComponentType: TNBComponentType; HeightOfPlacingValStr: String; CoordZ: Double; vList: TF_CAD; Figure: TFigure; ConnObj,JConnObj: TConnectorObject; i,j: integer; DoNotUseCoordZ: Boolean; begin if (AObject <> nil) and (AObject.ComponentReferences <> nil) then if AObject.ComponentReferences.Count > 0 then begin FirstComponent := AObject.GetFirstComponent; ListOwner := AObject.GetListOwner; if FirstComponent <> nil then begin if FirstComponent.ComponentType.SysName <> ctsnCableChannelElement then begin DoNotUseCoordZ := false; //SprComponentType := nil; //if ListOwner <> nil then // SprComponentType := ListOwner.Spravochnik.GetComponentTypeByGUID(FirstComponent.GUIDComponentType); //if SprComponentType <> nil then // if ListOwner.Setting.UseComponTypeHeights then //if SprComponentType.ComponentType.CoordZ <> -1 then // SetFigureCoordZ(ListOwner.CurrID, AObject.SCSID, SprComponentType.ComponentType.CoordZ); vList := GetListByID(FirstComponent.ListID); Figure := GetFigureByID(vList,AObject.SCSID); if (Figure <> nil)and(Figure.ClassName = 'TConnectorObject') then begin { ConnObj := TConnectorObject(Figure); for i := 0 to ConnObj.JoinedConnectorsList.Count - 1 do begin JConnObj := TConnectorObject(ConnObj.JoinedConnectorsList[i]); for j := 0 to JConnObj.JoinedOrtholinesList.Count - 1 do if TOrtholine(JConnObj.JoinedOrtholinesList[j]).FIsRaiseUpDown then DoNotUseCoordZ := true; end; } end; {CoordZ := -1; // Смотрим свойство "Высота размещения" HeightOfPlacingValStr := FirstComponent.GetPropertyValueBySysName(pnHeightOfPlacing); if (HeightOfPlacingValStr <> '')and(not DoNotUseCoordZ) then try CoordZ := StrToFloatU(CorrectStrToFloat(HeightOfPlacingValStr)); except end; // Смотрим в свойство автоприменяемой высоты в типе компоненты if CoordZ = -1 then begin SprComponentType := nil; if ListOwner <> nil then SprComponentType := ListOwner.Spravochnik.GetComponentTypeByGUID(FirstComponent.GUIDComponentType); if SprComponentType <> nil then if ListOwner.Setting.UseComponTypeHeights then //if SprComponentType.ComponentType.CoordZ <> -1 then CoordZ := SprComponentType.ComponentType.CoordZ; end; if CoordZ <> -1 then begin if CoordZ = 999 then CoordZ := ListOwner.Setting.HeightCorob else begin if ListOwner.Setting.UseComponTypeHeights then CoordZ := ListOwner.Setting.HeightSocket; end; SetFigureCoordZ(ListOwner.CurrID, AObject.SCSID, CoordZ); end;} end; end; end; //else // SetFigureCoordZ(ListOwner.CurrID, AObject.SCSID, -1); end; procedure TF_ChoiceConnectSide.DefineObjectStatus(ASCSObject: TSCSCatalog); var ListOwner: TSCSList; SCSCatalog: TSCSCatalog; //FigureID: Integer; //ItemType: Integer; FillingLineObj: TFillConnectLineObj; FillingObject: TFillConnectConObj; Fullness: TComponInterfacesFullness; // Tolik -- 18/05/2017 -- //ConnFigureParams: TConnFigureParams; ConnFigureParams: pConnFigureParams; // LineFigureParams: TLineFigureParams; function ConvertTypeToTComponInterfacesFullness(AFillingObj: TFillConnectConObj): TComponInterfacesFullness; begin Result := cif_None; case AFillingObj of foNone : Result := cif_None; foEmpty: Result := cif_Empty; foBusy : Result := cif_Full; foPartEmpty: Result := cif_HalfEmpty; end; end; begin if ASCSObject = nil then Exit; ///// EXIT ///// SCSCatalog := ASCSObject; try //SCSCatalog := AActComponent.GetFirstParentCatalog; if Not Assigned(SCSCatalog) then Exit; ////// EXIT ////// ListOwner := SCSCatalog.GetListOwner; OpenNoExistsListInCAD(ListOwner); FillingObject := foPartEmpty; //FigureID := TF_Main(GForm).DM.GetScsIDByIDCatalog(AActComponent.ObjectID); //ItemType := TF_Main(GForm).DM.GetCatalogIDItemType(AActComponent.ObjectID, qmMemory); //FigureID := ASCSObject.SCSID; //ItemType := ASCSObject.ItemType; //FigureID := ASCSObject.ID; case SCSCatalog.ItemType of itSCSConnector: begin //FillingObject := HowFillConnectConObj(SCSCatalog, true); //Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); //SetFullnessTypeForConnector(SCSCatalog.ListID, SCSCatalog.SCSID, Fullness); // Tolik -- 18/05/2017 -- New(ConnFigureParams); ConnFigureParams.DefectObjDegree := dodNone; ConnFigureParams.FigureID := -1; ConnFigureParams.Fullness := cif_Empty; ConnFigureParams.ListID := 1; // FillingObject := HowFillConnectConObj(SCSCatalog, true); ConnFigureParams.ListID := SCSCatalog.ListID; ConnFigureParams.FigureID := SCSCatalog.SCSID; ConnFigureParams.Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); ConnFigureParams.DefectObjDegree := GetObjDefectDegree(SCSCatalog); // Tolik 18/05/2017 -- //SetConnStatusInfo(@ConnFigureParams); SetConnStatusInfo(ConnFigureParams); Dispose(ConnFigureParams); // end; itSCSLine: begin //*** Подсоединенность кабелей на концах {FillingLineObj := HowFillConnectLineObj(SCSCatalog, true); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); SetFullnessTypeForCable(SCSCatalog.ListID, SCSCatalog.SCSID, 1, Fullness); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); SetFullnessTypeForCable(SCSCatalog.ListID, SCSCatalog.SCSID, 2, Fullness); //if AActComponent.ID_ComponentType = ctCableCanal then begin //*** Заглушенность коробов FillingLineObj := HowFillCablaCanalCorkInTrace(SCSCatalog); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); SetClosedTypeForCableChannel(SCSCatalog.ListID, SCSCatalog.SCSID, 1, Fullness); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); SetClosedTypeForCableChannel(SCSCatalog.ListID, SCSCatalog.SCSID, 2, Fullness); //*** Вложенность кабельных каналов FillingObject := HowFillCableCanal(SCSCatalog); Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); SetFullnessTypeForCableChannel(SCSCatalog.ListID, SCSCatalog.SCSID, Fullness); end;} LineFigureParams.ListID := SCSCatalog.ListID; LineFigureParams.FigureID := SCSCatalog.SCSID; //*** Подсоединенность кабелей на концах FillingLineObj := HowFillConnectLineObj(SCSCatalog, true); LineFigureParams.FullnesCableSide1 := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); LineFigureParams.FullnesCableSide2 := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); //*** Заглушенность коробов FillingLineObj := HowFillCablaCanalCorkInTrace(SCSCatalog); LineFigureParams.ClosedTypeForChannelSide1 := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); LineFigureParams.ClosedTypeForChannelSide2 := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); //*** Вложенность кабельных каналов FillingObject := HowFillCableCanal(SCSCatalog); LineFigureParams.ChannelFullness := ConvertTypeToTComponInterfacesFullness(FillingObject); LineFigureParams.DefectObjDegree := GetObjDefectDegree(SCSCatalog); SetLineStatusInfo(@LineFigureParams); end; end; { FillingObject := foPartEmpty; FigureID := TF_Main(GForm).DM.GetScsIDByIDCatalog(AActComponent.ObjectID); ItemType := TF_Main(GForm).DM.GetCatalogIDItemType(AActComponent.ObjectID, qmMemory); //FigureID := ASCSObject.SCSID; //ItemType := ASCSObject.ItemType; //FigureID := ASCSObject.ID; case ItemType of itSCSConnector: begin FillingObject := HowFillConnectConObj(FigureID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); SetFullnessTypeForConnector(FigureID, Fullness); end; itSCSLine: begin //*** Подсоединенность кабелей на концах FillingLineObj := HowFillConnectLineObj(FigureID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); SetFullnessTypeForCable(FigureID, 1, Fullness); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); SetFullnessTypeForCable(FigureID, 2, Fullness); if AActComponent.ID_ComponentType = ctCableCanal then begin //*** Заглушенность коробов FillingLineObj := HowFillCablaCanalCorkInTrace(FigureID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); SetClosedTypeForCableChannel(FigureID, 1, Fullness); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); SetClosedTypeForCableChannel(FigureID, 2, Fullness); //*** Вложенность кабельных каналов FillingObject := HowFillCableCanal(FigureID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); SetFullnessTypeForCableChannel(FigureID, Fullness); end; end; end; } {SCSCatalog := TSCSCatalog.Create(GForm); SCSCatalog.LoadCatalogByID(AIDObject, false); case SCSCatalog.ItemType of itSCSConnector: begin FillingObject := HowFillConnectConObj(SCSCatalog.SCSID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); SetFullnessTypeForConnector(SCSCatalog.SCSID, Fullness); end; itSCSLine: begin FillingLineObj := HowFillConnectLineObj(SCSCatalog.SCSID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide1); SetFullnessTypeForCable(SCSCatalog.SCSID, 1, Fullness); Fullness := ConvertTypeToTComponInterfacesFullness(FillingLineObj.FillingSide2); SetFullnessTypeForCable(SCSCatalog.SCSID, 2, Fullness); FillingObject := HowFillCableCanal(SCSCatalog.SCSID); Fullness := ConvertTypeToTComponInterfacesFullness(FillingObject); SetFullnessTypeForCableChannel(SCSCatalog.SCSID, Fullness); end; end; } except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineFigureFullness: '+E.Message); end; end; procedure TF_ChoiceConnectSide.DefineObjectHaveCableChannel(AObject: TSCSCatalog); begin if AObject.ItemType = itSCSLine then SetIsCableChannel(AObject.ListID, AObject.SCSID, IsHaveObjectCableChannel(AObject)); end; // #### Подписи #### procedure TF_ChoiceConnectSide.DefineObjectSignature(ASCSObject: TSCSCatalog); var //IDFigure: Integer; SignatureList: TStringList; function GetLineSignature: TStringList; //28.08.2013 - var i, j: Integer; Compon: TSCSComponent; AFigure: TFigure; SavedCadForm: TF_CAD; vList: TF_CAD; addLineCount: integer; begin Result := nil; addLineCount := 2; try vList := GetListByID(ASCSObject.ListID); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; AFigure := GetFigureByID(vList, ASCSObject.SCSID); if AFigure <> nil then begin if CheckFigureByClassName(AFigure, cTOrthoLine) then begin //Tolik 16/12/2015 -- вставлять пробелы, только если выравнивание надписи идет по центру if TOrthoLine(AFigure).FCaptionsViewType = cv_Center then begin // if TOrthoLine(AFigure).GrpSizeY = 0 then addLineCount := 1 else begin //Tolik - 23/12/2015 //addLineCount := RoundUp((TOrthoLine(AFigure).GrpSizeY + 0.1) / 2); addLineCount := GetEmptyLinesCount(TOrthoLine(AFigure)); end; if Not TOrthoLine(AFigure).ShowLength then begin {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} // если не отображать длину - отображается без поворота - можно и не добавлять // лишние строки - но это когда будет полностью вырулено отображение без переноса //addLineCount := 0; // а пока оставим так: // new mark addLineCount := addLineCount + 1; {$ELSE} addLineCount := addLineCount + 1; {$IFEND} end; end else addLineCount := 0; end; end; GCadForm := SavedCadForm; end; for i := 0 to ASCSObject.SCSComponents.Count - 1 do begin Compon := ASCSObject.SCSComponents[i]; if Compon.IsMarkInCaptions = biTrue then if Compon.NameMark <> '' then begin if Result = nil then begin Result := TStringList.Create; if addLineCount > 0 then for j := 1 to addLineCount do Result.Add(''); end; Result.Add(Compon.NameMark); end; end; if Result = nil then Result := TStringList.Create; except on E: Exception do addExceptionToLogEx('F_ChoiceConnectSide.DefineObjectSignature GetLineSignature', E.Message); end; end; begin if Not Assigned(ASCSObject) then Exit; //// EXIT //// try //IDFigure := TF_Main(GForm).DM.GetScsIDByIDCatalog(AActComponent.ObjectID); //IDFigure := ASCSObject.SCSID; SignatureList := nil; //if ASCSObject.ItemType = itSCSConnector then // SignatureList := GetObjectPortMultyPortNameMarks(ASCSObject) //GetFigureNote(IDFigure); //else if ASCSObject.ItemType = itSCSLine then // SignatureList := GetLineSignature; if ASCSObject.ItemType = itSCSLine then SignatureList := GetLineSignature else SignatureList := GetObjectPortMultyPortNameMarks(ASCSObject); //GetFigureNote(IDFigure); if SignatureList <> nil then begin SetConnCaptionsInCAD(ASCSObject.ListID, ASCSObject.SCSID, SignatureList); FreeAndNil(SignatureList); end; //SetFigureNoteInCAD(ASCSObject.ListID, ASCSObject.SCSID, NoteList); except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineObjectNoteInCAD: '+E.Message); end; end; (* // #### Подписи #### procedure TF_ChoiceConnectSide.DefineObjectSignature(ASCSObject: TSCSCatalog); var //IDFigure: Integer; SignatureList: TStringList; function GetLineSignature: TStringList; //28.08.2013 - var i, j: Integer; Compon: TSCSComponent; AFigure: TFigure; SavedCadForm: TF_CAD; vList: TF_CAD; addLineCount: integer; begin Result := nil; addLineCount := 2; try vList := GetListByID(ASCSObject.ListID); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; AFigure := GetFigureByID(vList, ASCSObject.SCSID); if AFigure <> nil then begin if CheckFigureByClassName(AFigure, cTOrthoLine) then begin // Tolik -- 07/12/2015 // если выравнивание надписи - под линией, над линией, или пользовательское, то // пустые строки в надпись добавлять не будем if ((TOrthoLine(AFigure).FCaptionsViewType = cv_UnderLine) or (TOrthoLine(AFigure).FCaptionsViewType = cv_OverLine) or ((TOrthoLine(AFigure).FCaptionsViewType = cv_Auto) and (TOrthoLine(AFigure).CaptionsGroupH <> 0))) then addLineCount := 0 else begin // if TOrthoLine(AFigure).GrpSizeY = 0 then addLineCount := 1 else begin addLineCount := RoundUp((TOrthoLine(AFigure).GrpSizeY + 0.1) / 2); end; if Not TOrthoLine(AFigure).ShowLength then begin {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} // если не отображать длину - отображается без поворота - можно и не добавлять // лишние строки - но это когда будет полностью вырулено отображение без переноса //addLineCount := 0; // а пока оставим так: // new mark addLineCount := addLineCount + 1; {$ELSE} addLineCount := addLineCount + 1; {$IFEND} end; end; end; end; GCadForm := SavedCadForm; end; for i := 0 to ASCSObject.SCSComponents.Count - 1 do begin Compon := ASCSObject.SCSComponents[i]; if Compon.IsMarkInCaptions = biTrue then if Compon.NameMark <> '' then begin if Result = nil then begin Result := TStringList.Create; if addLineCount > 0 then for j := 1 to addLineCount do Result.Add(''); end; Result.Add(Compon.NameMark); end; end; if Result = nil then Result := TStringList.Create; except on E: Exception do addExceptionToLogEx('F_ChoiceConnectSide.DefineObjectSignature GetLineSignature', E.Message); end; end; begin if Not Assigned(ASCSObject) then Exit; //// EXIT //// try //IDFigure := TF_Main(GForm).DM.GetScsIDByIDCatalog(AActComponent.ObjectID); //IDFigure := ASCSObject.SCSID; SignatureList := nil; //if ASCSObject.ItemType = itSCSConnector then // SignatureList := GetObjectPortMultyPortNameMarks(ASCSObject) //GetFigureNote(IDFigure); //else if ASCSObject.ItemType = itSCSLine then // SignatureList := GetLineSignature; if ASCSObject.ItemType = itSCSLine then SignatureList := GetLineSignature else SignatureList := GetObjectPortMultyPortNameMarks(ASCSObject); //GetFigureNote(IDFigure); if SignatureList <> nil then begin SetConnCaptionsInCAD(ASCSObject.ListID, ASCSObject.SCSID, SignatureList); FreeAndNil(SignatureList); end; //SetFigureNoteInCAD(ASCSObject.ListID, ASCSObject.SCSID, NoteList); except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineObjectNoteInCAD: '+E.Message); end; end; *) // #### Выноски #### procedure TF_ChoiceConnectSide.DefineObjectNote(ASCSObject: TSCSCatalog); var //List: TSCSList; Notes: TStringList; begin if Assigned(ASCSObject) then begin //List := ASCSObject.GetListOwner; //if Assigned(List) then begin Notes := nil; //Notes := TStringList.Create; //Notes.Add('Test '+#10+#13+'Test '+#10+#13+'Test '+#10+#13); Notes := GetObjectNotes(ASCSObject); case ASCSObject.ItemType of itSCSLine: begin SetLineNotesInCAD(ASCSObject.ListID, ASCSObject.SCSID, Notes); SetLineCaptionsInCAD(ASCSObject.ListID, ASCSObject.SCSID); end; itSCSConnector: SetConnNotesInCAD(ASCSObject.ListID, ASCSObject.SCSID, Notes); end; if Notes <> nil then FreeAndNil(Notes); end; end; end; procedure TF_ChoiceConnectSide.DefineTraceStyleInCAD(ATraceObject: TSCSCatalog); const CmpDelta = 0.001; var Height1, Height2: Double; List: TSCSList; Room: TSCSCatalog; i, j: Integer; SCSCompon: TSCSComponent; SCSChild: TSCSComponent; Cnt: Integer; CanOver10: Boolean; HeightCeiling: Double; begin try CanOver10 := false; List := nil; if ATraceObject = nil then Exit; //// EXIT //// if ATraceObject.ItemType <> itSCSLine then Exit; //// EXIT //// // ts_UnderFalseFloor List := TF_Main(GForm).GSCSBase.CurrProject.GetListBySCSID(ATraceObject.ListID); if List <> nil then begin HeightCeiling := List.Setting.HeightCeiling; Room := ATraceObject.GetParentCatalogByItemType(itRoom); if (Room <> nil) and (Room.RoomSetting <> nil) then if Room.RoomSetting.HeightCeiling > 0 then HeightCeiling := Room.RoomSetting.HeightCeiling; GetLineFigureHeghts(ATraceObject.ListID, ATraceObject.SCSID, Height1, Height2); if Abs(Height1 - Height2) < CmpDelta then if RoundCP(Height1 - (List.Setting.HeightRoom - HeightCeiling)) >= 0 then begin SetTraceStyle(ATraceObject.ListID, ATraceObject.SCSID, ts_UnderFalseFloor); Exit; //// EXIT ///// end; end; // ts_ClearTrace if ATraceObject.SCSComponents.Count = 0 then begin SetTraceStyle(ATraceObject.ListID, ATraceObject.SCSID, ts_ClearTrace); Exit; //// EXIT ///// end; //if ATraceObject.UpperComponents.Count = 0 then // ATraceObject.LoadComponents(ATraceObject.ID, false); // ts_Until10InCorob for i := 0 to ATraceObject.SCSComponents.Count - 1 do if Assigned(ATraceObject.SCSComponents[i]) then begin SCSCompon := ATraceObject.SCSComponents[i]; if SCSCompon.ComponentType.SysName = ctsnCableChannel then begin Cnt := 0; //SCSCompon.LoadChildComplects(false, false); for j := 0 to SCSCompon.ChildComplects.Count - 1 do if Assigned(SCSCompon.ChildComplects[j]) then begin SCSChild := SCSCompon.ChildComplects[j]; if CheckSysNameIsCable(SCSChild.ComponentType.SysName) then Cnt := Cnt + 1; end; if Cnt <= 10 then begin SetTraceStyle(ATraceObject.ListID, ATraceObject.SCSID, ts_Until10InCorob); Exit; //// EXIT ///// end else CanOver10 := true; end; end; // ts_Over10 if CanOver10 then begin SetTraceStyle(ATraceObject.ListID, ATraceObject.SCSID, ts_Over10); Exit; //// EXIT ///// end; // ts_Until10 Cnt := 0; for i := 0 to ATraceObject.SCSComponents.Count - 1 do if Assigned(ATraceObject.SCSComponents[i]) then begin SCSCompon := ATraceObject.SCSComponents[i]; if CheckSysNameIsCable(SCSCompon.ComponentType.SysName) then Cnt := Cnt + 1; end; if Cnt <= 10 then begin SetTraceStyle(ATraceObject.ListID, ATraceObject.SCSID, ts_Until10); Exit; //// EXIT ///// end else CanOver10 := true; // ts_Over10 if CanOver10 then begin SetTraceStyle(ATraceObject.ListID, ATraceObject.SCSID, ts_Over10); Exit; //// EXIT ///// end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineTraceStyleInCAD: '+E.Message); end; end; procedure TF_ChoiceConnectSide.DefineObjectNetworkTypes(AObject: TSCSCatalog); var ObjectNetworkTypes: TObjectNetworkTypes; {SCSComponent: TSCSComponent; i: Integer; } begin try if AObject = nil then Exit; ///// EXIT ///// //if AObject.SCSComponents.Count = 0 then // AObject.LoadAllComponentsByObjectID(AObject.ID, [fiAll]); {for i := 0 to AObject.SCSComponents.Count - 1 do begin SCSComponent := AObject.SCSComponents[i]; case SCSComponent.IDNetType of ntComputer: if Not(nt_Computer in ObjectNetworkTypes) then ObjectNetworkTypes := ObjectNetworkTypes + [nt_Computer]; ntTelephone: if Not(nt_Telephon in ObjectNetworkTypes) then ObjectNetworkTypes := ObjectNetworkTypes + [nt_Telephon]; ntElectric: if Not(nt_Electric in ObjectNetworkTypes) then ObjectNetworkTypes := ObjectNetworkTypes + [nt_Electric]; ntTelevision: if Not(nt_Television in ObjectNetworkTypes) then ObjectNetworkTypes := ObjectNetworkTypes + [nt_Television]; ntGas: if Not(nt_Gas in ObjectNetworkTypes) then ObjectNetworkTypes := ObjectNetworkTypes + [nt_Gas]; end; end; } ObjectNetworkTypes := GetNetworkTypesForSCSObject(AObject); SetNetworkTypesForObject(AObject.ListID, AObject.SCSID, ObjectNetworkTypes); except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineObjectNetworkTypes: '+E.Message); end; end; // Tolik -- 09/06/2017 -- procedure TF_ChoiceConnectSide.ModifyDrawFigureByProps(AObject: TSCSCatalog); var FFigure: TFigure; i, j: Integer; Component: TSCSComponent; VList, SavedGCadForm: TF_CAD; ComponentPropList: TList; ComponProp: PProperty; apx, apy: Double; MaxX, MaxY, MinX, MinY: Double; FAngle, SAngle: Integer; // углы сектора Transparency: integer; // прозрачность Radius, cutRadius, RZone, IDZone, FOffset, IDHeight, Height_Of_Detection: Double; ZoneCount, RAngle, TAngle, VAngle: Integer; ZoneSYSName: String; // ObjectDrawFigure: TFigureGrpMod; cpx, cpy: Double; DrawLastZone: boolean; // рисовать (последнюю) зону или то что ещё может вписаться в дальность действия ZoneCounter: Integer; // количество зон ZoneColor: TColor; // цвет зоны CanSortList: Boolean; CanDelete: Boolean; currZoneRadius: Double; // радиус текущеё зоны ZoneCutStyle: integer; // тип обрезки зоны LastRadius: Double; // PropName: String; // свойство объекта ObjectH: Double; // высота расположения объекта (точка отсчета зависит от дальности действия) MaxLength: Double; // максимальная дальность Detect_Height: Double; // высота обнаружения CutDelta: Double; // дельта обрезки HalfDrawFigureX, Angle: Double; DrawFigureAngle: Double; AutoFigureClassName: string; // класс фигуры, одбавляемой в фигуру отрисовки (эллипс, сектор и т.п.) ParamList: TStringList; // список параметров DrawEllipticZone: Boolean; // // рисовать эллиптическую зону Rx1, rx2, ry1, ry2, cpx1, cpy1, cpx2, cpy2: Double; Function GetVerticalRange: double; // макс зона покрытия если угол поворота = 90 градусов var tmpRadius: Double; begin Result := Radius; If Tangle = 0 then exit; if ObjectH > 0 then // если объект не лежит на полу... begin if ABS(TAngle) = 90 then Result := ObjectH // точно вертикально else begin if ABS(TAngle) < 90 then begin if TAngle <> 0 then begin //Result := FOffset + TConnectorObject(FFigure).ActualZOrder[1] / cos(((90 - TAngle)/180) * PI); Result := ObjectH * Tan(((90 - TAngle)/180) * PI); end; end; end; if GCadForm.PCad.RulerMode = rmPage then Result := cutDelta * 10 else if GCadForm.PCad.RulerMode = rmWorld then begin Result := (Result*1000)/GCadForm.PCad.MapScale; end; //Result := Result + HalfDrawFigureX; //если больше, чем макс. значение радиуса, возвращаем как было if CompareValue(Result, Radius) = 1 then Result := Radius; end; end; Function GetCutDelta: Double; begin Result := CutRadius; if ABS(TAngle) > 0 then // если камеру наклонить вниз (угол наклона положительный) begin Angle := ABS(TAngle); if Angle < 90 then if CompareValue(ObjectH,Height_Of_Detection) = 1 then // если высота размещения больше высоты обнаружения begin Result := ABS(ObjectH - Height_Of_Detection) * Tan(((90 - Angle)/180) * PI); if (Result <> 0) then begin if GCadForm.PCad.RulerMode = rmPage then Result := cutDelta * 10 else if GCadForm.PCad.RulerMode = rmWorld then begin Result := (Result*1000)/GCadForm.PCad.MapScale; end; //Result := Result + FOffset; end; if CompareValue(Result, CutRadius) = -1 then Result := CutRadius; end; end; end; function CanDrawEllipticZone: Boolean; var Angle: double; begin Result := False; if TAngle <> 0 then begin if ObjectH <> 0 then begin if ABS(TAngle) < 90 then begin if (TAngle + VAngle/2) > 90 then Result := True; end else Result := True; end; end; end; Procedure SetElparamsToParamList; var c: Double; Len1, Len2: double; cX, cY, cX1, cY1, Rad1, Rad2, CutRad1, CutRad2: Double; abrc:integer; LHandle: LongInt; begin ParamList := TStringList.Create; if TAngle = 90 then begin //Len1 := Radius * sin((VAngle/360)*PI); //Len2 := Radius * sin((VAngle/360)*PI); //Len1 := ObjectH cos((VAngle/360)*PI); //Len2 := ObjectH cos((VAngle/360)*PI); Len1 := ObjectH * Tan((VAngle/360)*PI); Len2 := ObjectH * Tan((VAngle/360)*PI); if GCadForm.PCad.RulerMode = rmPage then begin Len1 := Len1*10; Len2 := Len2*10; end else if GCadForm.PCad.RulerMode = rmWorld then begin Len1 := (Len1*1000)/GCadForm.PCad.MapScale; Len2 := (Len2*1000)/GCadForm.PCad.MapScale; end; Cx := apx; cy := Apy; ParamList.Add(Floattostr(cx)); ParamList.Add(Floattostr(cy)); ParamList.Add('0'); ParamList.Add('0'); ParamList.Add(Floattostr(Len1)); ParamList.Add(Floattostr(Len1)); ParamList.Add('0'); ParamList.Add('0'); ParamList.Add(inttostr(clRed)); ParamList.Add(inttostr(Transparency)); ParamList.Add(IntToStr(ObjectDrawFigure.LayerHandle)); end else // имеется ввиду, что (TAngle + VAngle/2) > 90 градусов begin if VAngle < 90 then begin if (TAngle + VAngle/2) > 90 then // заступаем за точку подвеса камеры (тут - центр фигуры отрисовки) begin end else if (TAngle + VAngle/2) < 90 then // не заступаем за точку подвеса камеры (тут - центр фигуры отрисовки) begin end; if (TAngle + VAngle) = 90 then // вплотную к точке подвеса камеры (центр фигуры отрисовки) begin Len1 := (ObjectH * Tan (((90 - VAngle)/180)*PI))/2; Len2 := Len1; Cx := apx; cy := Apy; if GCadForm.PCad.RulerMode = rmPage then begin Len1 := Len1*10; Len2 := Len2*10; end else if GCadForm.PCad.RulerMode = rmWorld then begin Len1 := (Len1*1000)/GCadForm.PCad.MapScale; Len2 := (Len2*1000)/GCadForm.PCad.MapScale; end; ParamList.Add(Floattostr(cx)); ParamList.Add(Floattostr(cy)); ParamList.Add('0'); ParamList.Add('0'); ParamList.Add(Floattostr(Len1)); ParamList.Add(Floattostr(Len1)); ParamList.Add('0'); ParamList.Add('0'); ParamList.Add(inttostr(clRed)); ParamList.Add(inttostr(Transparency)); ParamList.Add(IntToStr(ObjectDrawFigure.LayerHandle)); end; end; end; end; begin SavedGCadForm := GCadForm; ComponentPropList := nil; ParamList := Nil; DrawEllipticZone := False; vList := GetListByID(AObject.ListID); if vList <> nil then begin GCadForm := vList; HalfDrawFigureX := 0; try FFigure := GetFigureByID(GCadForm, AObject.SCSID); if FFigure = nil then FFigure := GetFigureByIDInSCSFigureGroups(GCadForm, AObject.SCSID); if FFigure <> nil then begin if not FFigure.Deleted then if checkFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).ConnectorType = ct_NB then begin if Assigned(TConnectorObject(FFigure).DrawFigure) then begin ObjectDrawFigure := TFigureGrpMod(TConnectorObject(FFigure).DrawFigure); if not ObjectDrawFigure.deleted then begin DrawFigureAngle := TConnectorObject(FFigure).FDrawFigureAngle; if DrawFigureAngle <> 0 then begin ObjectDrawFigure.Rotate(-1*DrawFigureAngle, ObjectDrawFigure.CenterPoint); TConnectorObject(FFigure).FDrawFigureAngle := 0; end; ObjectDrawFigure.RemoveAutoCreatedFigures; ComponentPropList := TList.Create; //TFigureGrpMod(ObjectDrawFigure).getbounds(MaxX, MaxY, MinX, MinY); TFigureGrpMod(ObjectDrawFigure).GetBoundsWithoutAutoCreatedFigures(MaxX, MaxY, MinX, MinY); // Drawfigure BoundRect Center Point if (MaxX = 0) or (MaxY = 0) then begin apx := FFigure.ActualPoints[1].x; apy := FFigure.ActualPoints[1].y; end else begin apx := (MaxX + MinX)/2; apy := (Maxy + MinY)/2; end; HalfDrawFigureX := (MaxX - MinX)/2; // ObjectH := TConnectorObject(FFigure).ActualZOrder[1]; // высота размещения // //на время теста //for i := 0 to aObject.SCSComponents.Count - 1 do for i := 0 to aObject.ComponentReferences.Count - 1 do begin Component := aObject.ComponentReferences[i]; // SCSComponents[i]; if not Component.ServToDelete then begin Sangle := -1; // стартовый угол для отрисовки сектора FAngle := -1; // конечный угол для отрисовки сектора TransParency := 50; // прозрачность Radius := -1; // зона действия cutRadius := -1; ZoneCount := 0; // количество зон для отрисовки VAngle := -1; // угол обзора RAngle := -1; // угол поворота компонента TAngle := 0; // угол наклона объекта/компонента //Height_Of_Detection := TconnectorObject(FFigure).actualZOrder[1]; // высота обнаружения по умолчанию = высоте размещения объекта Height_Of_Detection := -1; FOffset := -1; // смещение CurrZoneRadius := 0; ZoneCutStyle := 0; Detect_Height := -1; // -- высота обнаружения MaxLength := -1; // максимальная длина зоны действия, пока не упремся в пол (если есть угол наклона) // дальность действия ComponProp := Component.GetPropertyBySysName('ACT_RANGE'); if ComponProp <> nil then if ComponProp.IDDataType = dtFloat then Radius := StrToFloat_My(ComponProp.Value); //Radius := MetreToUom(StrToFloat_My(ComponProp.Value)); // угол обзора ComponProp := Component.GetPropertyBySysName('V_ANGLE'); if ComponProp <> nil then if ComponProp.IDDataType = dtInteger then VAngle := StrtoInt(ComponProp.Value); if ((Radius <> -1) and (VAngle <> -1)) then // если есть дальность действия и угол обзора -- можно рисовать зоны begin // если угол обзора более 160 градусов, то обрезка будет круговая if CompareValue(Vangle, 160) > 0 then ZoneCutStyle := 1; // угол наклона ComponProp := Component.GetPropertyBySysName('T_ANGLE'); if ComponProp <> nil then if ComponProp.IDDataType = dtInteger then TAngle := StrtoInt(ComponProp.Value); if TAngle < 0 then // угол наклона не может быть более 90 градусов по абсолютному значению begin if ABS(TAngle) > 90 then TAngle := -90; end else if TAngle > 90 then TAngle := 90; //поворот в полфигуры if Tangle <> 0 then if Tangle <= 90 then begin HalfDrawFigureX := HalfDrawFigureX*cos((TAngle/180)*PI); end; // если высота размещения больше зоны действия -- принимаем высоту размещения равную зоне // действия для адекватного отображения на плоскости if compareValue(ObjectH, Radius) = 1 then ObjectH := Radius; // прозрачность ComponProp := Component.GetPropertyBySysName('F_TRANSPARENCY'); if ComponProp <> nil then if ComponProp.IDDataType = dtInteger then Transparency := strtoint(ComponProp.Value); // высота обнаружения ComponProp := Component.GetPropertyBySysName('ID_HEIGHT'); if ComponProp <> nil then if ComponProp.IDDataType = dtFloat then Height_Of_Detection := StrToFloat_My(ComponProp.Value); //Height_Of_Detection := MetreToUom(StrToFloat_My(ComponProp.Value)); // смещение ComponProp := Component.GetPropertyBySysName('F_OFFSET'); if ComponProp <> nil then if ComponProp.IDDataType = dtFloat then FOffset := StrToFloat_My(ComponProp.Value); //FOffset := MetreToUom(StrToFloat_My(ComponProp.Value)); // угол поворота ComponProp := Component.GetPropertyBySysName('R_ANGLE'); if ComponProp <> nil then if ComponProp.IDDataType = dtInteger then RAngle := strtoint(ComponProp.Value); // зоны for j := 0 to Component.Properties.Count - 1 do begin ComponProp := PProperty(Component.Properties[j]); if ComponProp <> nil then begin if Pos('ZONE', Componprop.SysName) = Length(Componprop.SysName) - 3 then if ComponProp.IDDataType = dtFloat then ComponentPropList.Add(ComponProp); end; end; DrawEllipticZone := CanDrawEllipticZone;//проверка типа фигуры для отрисовки зон if DrawEllipticZone then begin if GCadForm.PCad.RulerMode = rmPage then begin Radius := Radius*10; // дальность end else if GCadForm.PCad.RulerMode = rmWorld then begin Radius := (Radius*1000)/GCadForm.PCad.MapScale; end; Radius := Radius + HalfDrawFigureX; // + полфигуры для поворота от центра объекта SetElparamsToParamList; TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure('TOverLappedEllipse', ParamList); ParamList.free; end else begin // С М Е Щ Е Н И Е и Ц Е Н Т Р cpy := (MinY + MaxY)/2; if FOffset = -1 then // -- если нет смещения, то рисовать нужно от самого края begin FOffset := 0; if VAngle <> 360 then cpx := apx + HalfDrawFigureX else cpx := apx; HalfDrawFigureX := 0; end else begin if GCadForm.PCad.RulerMode = rmPage then begin FOffset := FOffset*10; end else if GCadForm.PCad.RulerMode = rmWorld then begin FOffset := (FOffset*1000)/GCadForm.PCad.MapScale; // смещение end; if VAngle <> 360 then cpx := apx - FOffset // центр сектора по x else cpx := apx; end; // Дальность и обрезка cutRadius := 0; if GCadForm.PCad.RulerMode = rmPage then begin Radius := Radius*10; // дальность end else if GCadForm.PCad.RulerMode = rmWorld then begin Radius := (Radius*1000)/GCadForm.PCad.MapScale; end; if VAngle <> 360 then Radius := Radius + HalfDrawFigureX; // + полфигуры для поворота от центра объекта //проверка на угол наклона Radius := GetVerticalRange; // смещение if FOffset > 0 then begin if VAngle <> 360 then begin Radius := Radius + FOffset; cutRadius := FOffset + HalfDrawFigureX; // обрезка пока что на край фигуры end else cutRadius := FOffset; end else begin if VAngle = 360 then CutRadius := 0 else CutRadius := HalfDrawFigureX; // если нет смещения - обрезка по краю Фигуры end; // Высота обнаружения + угол наклона if Height_Of_Detection <> -1 then begin CutDelta := 0; CutRadius := GetCutDelta; end; if (MaxX = 0) or (MaxY = 0) then begin cpx := FFigure.ActualPoints[1].x; cpy := FFigure.ActualPoints[1].y; end; // // если зоны не заданы, но есть область действия и угол обзора -- рисуем ОДИН СЕКТОР по тем // параметрам, что получили if ComponentPropList.Count = 0 then begin if CompareValue(Radius, CutRadius) > 0 then begin ZoneColor := clSkyBlue; ParamList := TStringList.Create; ParamList.Add(FloatToStr(VAngle)); ParamList.Add(IntTostr(TransParency)); ParamList.Add(FloatTostr(cpx)); ParamList.Add(FloatTostr(cpy)); ParamList.Add(FloatTostr(Radius)); ParamList.Add(FloatTostr(CutRadius)); ParamList.Add(inttostr(ZoneColor)); ParamList.Add(inttostr(ZoneCutStyle)); ParamList.Add(FloatTostr(RAngle)); //TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure(VAngle, TransParency, cpx, cpy, Radius, cutRadius, clSkyBlue, TPieCutStyle(ZoneCutStyle), RAngle); TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure('TPie', ParamList); ParamList.free; CutDelta := 0; end; end else // если есть зоны, рисуем сектор для каждой зоны с учетом // их вхождение в зону действия объекта и перекрытие между собой begin ZoneCounter := 0; ZoneColor := clSkyBlue; LastRadius := Radius; // сортануть по длине, если больше одной if ComponentPropList.Count > 1 then begin CanSortList := True; While CanSortList do begin CanSortList := False; for j := 0 to ComponentPropList.Count - 2 do begin //CanSortList := False; if CompareValue(StrToFloat_My(PProperty(ComponentPropList[j]).Value), StrToFloat_My(PProperty(ComponentPropList[j+1]).Value)) = 1 then begin ComponProp := PProperty(ComponentPropList[j]); ComponentPropList[j] := ComponentPropList[j + 1]; ComponentPropList[j + 1] := ComponProp; CanSortList := True; end; end; end; end; DrawLastZone := True; // если последняя зона не перекрывает радиус -- дорисовать до радиуса действия for j := 0 to ComponentPropList.Count - 1 do begin if DrawLastZone then begin if j > 0 then ZoneCutStyle := 1 else ZoneCutStyle := 0; ComponProp := PProperty(ComponentPropList[j]); if ComponProp.IDDataType = dtFloat then begin CurrZoneRadius := StrToFloat_My(ComponProp.Value); //CurrZoneRadius := MetreToUom(StrToFloat_My(ComponProp.Value)); if GCadForm.PCad.RulerMode = rmPage then begin //Radius := Radius*10; // радиус CurrZoneRadius := CurrZoneRadius*10 + FOffset + HalfDrawFigureX; end else if GCadForm.PCad.RulerMode = rmWorld then begin CurrZoneRadius := (CurrZoneRadius*1000)/GCadForm.PCad.MapScale + FOffset + HalfDrawFigureX;//(((MaxX- MinX)/2)*1000)/GCadForm.PCad.MapScale; end; if (TAngle <> 0) then if (TAngle <> 90) then currZoneRadius := currZoneRadius*(cos((Tangle/180)*PI)); // если радиус зоны превышает дальность действия камеры, // обрезаем до значения дальности действия if CompareValue(CurrZoneRadius, LastRadius) = 1 then CurrZoneRadius := LastRadius; // цвет ZoneColor := -1; PropName := ComponProp.SysName + '#COLOR'; ComponProp := Component.GetPropertyBySysName(PropName); if ComponProp <> nil then begin if ComponProp.IDDataType = dtColor then ZoneColor := strtoint(ComponProp.Value); end; if ZoneCounter < 4 then Inc(ZoneCounter); if ((ZoneCounter <> 0) and (ZoneColor = -1)) then begin case ZoneCounter of // первые 4 зоны окрашиваем стандартно 1: ZoneColor := clRed; // (в том случае, если цвета для них не заданы 2: ZoneColor := clYellow; // пользователем) 3: ZoneColor := clGreen; 4: ZoneColor := clSkyBlue; end; end; if ZoneColor = -1 then ZoneColor := clSkyBlue; // если цвет зоны не задан или все-таки не определен - задаем по умолчанию if DrawLastZone then begin // если покрыли дальность действия, ставим флаг, что дальше рисовать не нужно if CompareValue(CurrZoneRadius, LastRadius) <> -1 then begin CurrZoneRadius := LastRadius; DrawLastZone := False; end; // если радиус зоны превышает радиус обрезки, то зону можно нарисовать if CompareValue(CurrZoneRadius, CutRadius) = 1 then begin //TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure(VAngle, TransParency, cpx, cpy, CurrZoneRadius, cutRadius, ZoneColor, TPieCutStyle(ZoneCutStyle), RAngle); ParamList := TStringList.Create; ParamList.Add(FloatToStr(VAngle)); ParamList.Add(IntTostr(TransParency)); ParamList.Add(FloatTostr(cpx)); ParamList.Add(FloatTostr(cpy)); ParamList.Add(FloatTostr(CurrZoneRadius)); ParamList.Add(FloatTostr(CutRadius)); ParamList.Add(inttostr(ZoneColor)); ParamList.Add(inttostr(ZoneCutStyle)); ParamList.Add(FloatTostr(RAngle)); //TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure(VAngle, TransParency, cpx, cpy, Radius, cutRadius, clSkyBlue, TPieCutStyle(ZoneCutStyle), RAngle); TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure('TPie', ParamList); ParamList.free; CutRadius := CurrZoneRadius; // если покрыли дальность действия, ставим флаг, что дальше рисовать не нужно if CompareValue(CutRadius, LastRadius) <> -1 then begin DrawLastZone := False; break; end; end; end; end; end; end; // если осталось непокрытое зонами пространство в области дальности действия, то рисуем и его if DrawLastZone then begin if CompareValue(LastRadius, CutRadius) = 1 then begin ZoneCutStyle := 1; ZoneColor := clSkyBlue; ParamList := TStringList.Create; ParamList.Add(FloatToStr(VAngle)); ParamList.Add(IntTostr(TransParency)); ParamList.Add(FloatTostr(cpx)); ParamList.Add(FloatTostr(cpy)); ParamList.Add(FloatTostr(Radius)); ParamList.Add(FloatTostr(CutRadius)); ParamList.Add(inttostr(ZoneColor)); ParamList.Add(inttostr(ZoneCutStyle)); ParamList.Add(FloatTostr(RAngle)); //TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure(VAngle, TransParency, cpx, cpy, Radius, cutRadius, clSkyBlue, TPieCutStyle(ZoneCutStyle), RAngle); TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure('TPie', ParamList); ParamList.free; //TConnectorObject(FFigure).AddAutoCreatedObjsToDrawFigure(VAngle, TransParency, cpx, cpy, LastRadius, cutRadius ,clSkyBlue, TPieCutStyle(ZoneCutStyle), RAngle); end; end; end; end; end; end; end; if DrawFigureAngle <> 0 then begin ObjectDrawFigure.BoundCalc := False; // чтобы пересчитались границы фигуры ObjectDrawFigure.Rotate(DrawFigureAngle, ObjectDrawFigure.CenterPoint); TConnectorObject(FFigure).FDrawFigureAngle := DrawFigureAngle; end; end; end; end; end; except end; end; GCadForm := SavedGCadForm; if ComponentPropList <> nil then ComponentPropList.Free; end; // procedure TF_ChoiceConnectSide.DefineObjectIcon(AObject: TSCSCatalog); var //IDFirstCompon: Integer; FirstCompon: TSCSComponent; FirstTopComponent: TSCSComponent; ActualComponent: TSCSComponent; //IDObjectIcon: Integer; IconType: Integer; IconBLK: TMemoryStream; FNameBLK: String; HaveObjectOtherIconType: Boolean; GUIDObjectOtherIconType: String; ObjectIconOtherType: TMemoryStream; //OldTick: Cardinal; //CurrTick: Cardinal; //CurrObjIcon: string; //CurrItemType: Integer; CurrFigureIconParams: TFigureIconParams; IconBlkList: TObjectList; IconBlkListOtherSignType: TObjectList; GUIDObjectIcon: String; SCSList: TSCSList; StepBlock: integer; SProp: PProperty; FFigure: TFigure; vList: TF_CAD; SavedCadForm: TF_CAD; aisDeleted: boolean; //Tolik -- NeedRecreateDrawFigure: Boolean; // function CheckDrawFigureHasAutoCreatedFigures: Boolean; var Figure: TFigure; ObjDrawFigure: TFigureGrpMod; i: Integer; begin Result := False; Figure := GetFigureByID(GCadForm, AObject.SCSID); if Figure <> nil then if checkFigureByClassName(Figure, cTConnectorObject) then if TConnectorObject(Figure).ConnectorType <> ct_Clear then begin if Assigned(TConnectorObject(Figure).DrawFigure) then begin Result := TConnectorObject(Figure).DrawFigure.HasAutocreatedFigures; { for i := 0 to TFigureGrpMod(TConnectorObject(Figure).DrawFigure).InFigures.Count - 1 do begin if (TFigure(TFigureGrpMod(TConnectorObject(Figure).DrawFigure).InFigures[i]).isAutoCreatedFigure = biTrue) then begin Result := True; exit; end; end; } end; end; end; // begin if Not Assigned(AObject) then Exit; ////// EXIT ////// aisDeleted := false; SavedCadForm := GCadForm; vList := GetListByID(AObject.ListID); try if vList <> nil then begin GCadForm := vList; FFigure := nil; FFigure := GetFigureByID(GCadForm, AObject.SCSID); if FFigure = nil then FFigure := GetFigureByIDInSCSFigureGroups(GCadForm, AObject.SCSID); if FFigure <> nil then aisDeleted := FFigure.Deleted; end; except end; GCadForm := SavedCadForm; if aisDeleted then Exit; //Tolik 09/03/2021 -- if FFigure <> nil then if FFigure is TConnectorobject then TConnectorObject(FFigure).ByDrawF := CheckConnectorUseUGOBounds(TConnectorObject(FFigure)); // try FNameBLK := ''; IconType := oitNone; //oitProjectible; IconBLK := nil; IconBlkList := nil; GUIDObjectOtherIconType := ''; // Tolik 12/06/2017 -- NeedRecreateDrawFigure := False; // with TF_Main(GForm) do begin // Выбрать Первый компонент объекта {SetSQLToQuery(DM.scsQSelect, ' select component.id, id_object_icon from component, katalog, catalog_relation '+ ' where (katalog.id = '''+IntTostr(AObject.ID)+''') and '+ ' (id_catalog = katalog.id) and (id_component = component.id) '+ ' order by component.sort_id ');} {IDFirstCompon := DM.GetIDFirstComponInCatalog(AObject.ID); // if IDFirstCompon > 0 then begin //IDObjectIcon := DM.scsQSelect.GetFNAsInteger('id_object_icon'); IDObjectIcon := DM.GetComponFieldValueAsInteger(IDFirstCompon, fnIDObjectIcon); IconType := GetPropertyValueAsInteger(tkComponent, IDFirstCompon, pnSignType, qmUndef, -1); with FNormBase.DM do begin IconBLK := GetComponIconByIconType(IDObjectIcon, IconType, ieBLK); //if Assigned(IconBLK) then SetBlockParamsForObject(AObject.SCSID, IDObjectIcon, IconType, IconBLK); end; end;} FirstCompon := AObject.GetFirstComponentWithObjectIcon; //AObject.GetFirstComponent; FirstTopComponent := AObject.GetFirstComponent; if FirstTopComponent <> nil then begin //CurrObjIcon := GetIconIDByObjectID(AObject.SCSID); //CurrItemType := GetObjectTypeIDByObjectID(AObject.SCSID); CurrFigureIconParams := GetFigureIconParams(AObject.ListID, AObject.SCSID); IconType := oitNone; IconBlkList := nil; IconBlkListOtherSignType := nil; GUIDObjectIcon := ''; ActualComponent := FirstTopComponent; if FirstCompon <> nil then ActualComponent := FirstCompon; IconType := ActualComponent.GetPropertyValueAsInteger(pnSignType); StepBlock := $FFFF; SProp := ActualComponent.GetPropertyBySysName('GRAPH_SYMBOL_SPACING'); if SProp <> nil then StepBlock := StrToIntDef(SProp^.Value, 0); GUIDObjectIcon := ActualComponent.GUIDObjectIcon; // Tolik 12/06/2017 -- { NeedRecreateDrawFigure := ((ActualComponent.GetPropertyBySysName('ACT_RANGE') <> nil) and (ActualComponent.GetPropertyBySysName('V_ANGLE') <> nil)); } // if IconType = oitNone then IconType := oitProjectible; // if (FirstCompon.IDObjectIcon = 0) or // (CurrObjIcon <> FirstCompon.IDObjectIcon) or (CurrItemType <> IconType) then if (CurrFigureIconParams.GUIDObjectIcon = '') or (CurrFigureIconParams.IconCount > 1) or {(FirstTopComponent.ChildReferences.Count > 0) or} (AObject.ItemType = itSCSLine) or ((CurrFigureIconParams.IconType <> IconType) or (CurrFigureIconParams.GUIDObjectIcon <> GUIDObjectIcon)) or CheckComponHaveInternalConnection(FirstTopComponent) {Tolik -- 12/06/2017 -- } or CheckDrawFigureHasAutoCreatedFigures or NeedRecreateDrawFigure then begin //OldTick := GetTickCount; //IconBLK := GetComponIconByIconType(FirstCompon.IDObjectIcon, IconType, ieBLK); //if Assigned(IconBLK) then //IconBLK := FirstCompon.GetObjectIconBlk; //IconBlkList := TObjectList.Create(true); //IconBlkList.Add(IconBLK); IconBlkList := GetSCSObjectIcons(ActualComponent); //GetSCSObjectIcons(AObject); if AObject.ItemType = itSCSLine then begin SCSList := AObject.GetListOwner; //*** учмтывать наличие второго типа сети для внешней СКС if (SCSList <> nil) and (SCSList.Setting.SCSType = st_External) then begin HaveObjectOtherIconType := CheckHaveObjectIconOtherType(AObject, IconType, ObjectIconOtherType, GUIDObjectOtherIconType); if ObjectIconOtherType <> nil then begin IconBlkListOtherSignType := TObjectList.Create(true); IconBlkListOtherSignType.Add(ObjectIconOtherType); //IconBlkList.Add(ObjectIconOtherType); end; SetExistOtherObjectType(AObject.ListID, AObject.SCSID, HaveObjectOtherIconType); end; //*** определить обозначение комплектующей линейной компоненты LoadChildComponObjectIconToList(FirstTopComponent, IconBlkList, GUIDObjectOtherIconType); end; if StepBlock <> $FFFF then begin try vList := GetListByID(AObject.ListID); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; try FFigure := GetFigureByID(GCadForm, AObject.SCSID); if FFigure = nil then FFigure := GetFigureByIDInSCSFigureGroups(GCadForm, AObject.SCSID); if CheckNoFigureinList(FFigure, GCadForm.FRemFigures) then begin if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if not TOrthoLine(FFigure).FIsBlockChanged then begin if TOrthoLine(FFigure).BlockStep = GCadForm.FDefaultBlockStep then TOrthoLine(FFigure).BlockStep := StepBlock; end; end; end; end; except end; GCadForm := SavedCadForm; end; except end; end; SetBlockParamsForObject(AObject.ListID, AObject.SCSID, GUIDObjectIcon, IconType, IconBlkList, IconBlkListOtherSignType, FirstTopComponent.ComponentType.SysName); // Tolik -- 09/06/2017 -- FFigure := GetFigureByID(GCadForm, AObject.SCSID); if FFigure <> nil then begin if checkFigureByClassName(FFigure, cTConnectorObject) then begin if TConnectorObject(FFigure).ConnectorType <> ct_Clear then ModifyDrawFigureByProps(AObject); //TConnectorObject(FFigure).AddPieObjToDrawFigure(90, 100, 10); end; end; // if IconBlkListOtherSignType <> nil then FreeAndNil(IconBlkListOtherSignType); if IconBlkList <> nil then FreeAndNil(IconBlkList); end; end else begin vList := GetListByID(AObject.ListID); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; try FFigure := GetFigureByID(GCadForm, AObject.SCSID); if FFigure = nil then FFigure := GetFigureByIDInSCSFigureGroups(GCadForm, AObject.SCSID); if CheckNoFigureinList(FFigure, GCadForm.FRemFigures) then begin if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if not TOrthoLine(FFigure).FIsBlockChanged then begin TOrthoLine(FFigure).BlockStep := GCadForm.FDefaultBlockStep; end; end; end; end; except end; GCadForm := SavedCadForm; end; SetBlockParamsForObject(AObject.ListID, AObject.SCSID, '', IconType, IconBlkList, nil, ''); end; end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DefineObjectIcon: '+E.Message); end; end; procedure TF_ChoiceConnectSide.DefineObjectJoinedTrunk(AObject: TSCSCatalog); var FirstComponent: TSCSComponent; ListOwner: TSCSList; CurrCadCrossObject: TCadCrossObject; begin FirstComponent := AObject.GetFirstComponent; if FirstComponent <> nil then begin ListOwner := AObject.GetListOwner; if ListOwner <> nil then begin CurrCadCrossObject := GetComponentTrunk(FirstComponent); ChangeCADCrossObject(ListOwner, AObject.ID, CurrCadCrossObject); if FirstComponent.ComponentType.SysName = ctsnCrossATS then ChangeCrossATSInterf(AObject.ListID, AObject.SCSID, CurrCadCrossObject); if FirstComponent.ComponentType.SysName = ctsnDistributionCabinet then ChangeDistribCabInterf(AObject.ListID, AObject.SCSID, CurrCadCrossObject); // if FirstComponent.ComponentType.SysName = ctsnCrossATS then // ReCreateCadCrossATS(AObject.ListID, AObject.SCSID, CurrCadCrossObject); // if FirstComponent.ComponentType.SysName = ctsnDistributionCabinet then // ReCreateCadDistribCab(AObject.ListID, AObject.SCSID, CurrCadCrossObject); //ObjectOwner.ServToDefineParamsInCAD := true; //RestartTimer(Timer_DefineObjetsParamsInCAD); end; end; end; procedure TF_ChoiceConnectSide.DefineObjectParamsAfterChangeComponMark(AObject: TSCSCatalog); begin if AObject.ItemType in [itSCSConnector, itSCSLine] then begin OpenNoExistsListInCAD(AObject.GetListOwner); TF_Main(GForm).DefineConnectorObjectNodeName(AObject); DefineObjectSignature(AObject); end; end; procedure TF_ChoiceConnectSide.DefineObjectsParamsAfterChangeComponMark(AObjects: TSCSCatalogs); var i: integer; SCSCatalog: TSCSCatalog; begin for i := 0 to AObjects.Count - 1 do begin DefineObjectParamsAfterChangeComponMark(AObjects[i]); //SCSCatalog := AObjects[i]; //if SCSCatalog.ItemType in [itSCSConnector, itSCSLine] then //begin // OpenNoExistsListInCAD(SCSCatalog.GetListOwner); // TF_Main(GForm).DefineConnectorObjectNodeName(SCSCatalog); // DefineObjectSignature(SCSCatalog); //end; end; end; procedure TF_ChoiceConnectSide.DefineObjectTrunkAfterChange(AObject: TSCSCatalog); var FirstComponent: TSCSComponent; ListOwner: TSCSList; CurrCadCrossObject: TCadCrossObject; begin FirstComponent := AObject.GetFirstComponent; if FirstComponent <> nil then begin ListOwner := AObject.GetListOwner; if ListOwner <> nil then begin CurrCadCrossObject := GetComponentTrunk(FirstComponent); ChangeCADCrossObject(ListOwner, AObject.ID, CurrCadCrossObject); if FirstComponent.ComponentType.SysName = ctsnCrossATS then ChangeCrossATSInterf(AObject.ListID, AObject.SCSID, CurrCadCrossObject); if FirstComponent.ComponentType.SysName = ctsnDistributionCabinet then ChangeDistribCabInterf(AObject.ListID, AObject.SCSID, CurrCadCrossObject); end; end; end; procedure TF_ChoiceConnectSide.DefineChildComponsMarksByTop(ATopComponent: TSCSComponent; ANoDefineCompons: TSCSComponents); var ListOwner: TSCSList; ObjectOwner: TSCSCatalog; SprCompTypeFromList: TNBComponentType; ChildCompon: TSCSComponent; i: Integer; begin if ATopComponent.IsTop then begin ListOwner := ATopComponent.GetListOwner; ObjectOwner := ATopComponent.GetFirstParentCatalog; if (ListOwner <> nil) and (ObjectOwner <> nil) then for i := 0 to ATopComponent.ChildReferences.Count - 1 do begin ChildCompon := ATopComponent.ChildReferences[i]; //*** Если компонент есть всписке не определяемых if (ANoDefineCompons <> nil) and (ANoDefineCompons.IndexOf(ChildCompon) <> -1) then Continue; //// CONTINUE //// SprCompTypeFromList := ListOwner.Spravochnik.GetComponentTypeByGUID(ChildCompon.GUIDComponentType); if SprCompTypeFromList <> nil then if Pos(mteTopCompon, SprCompTypeFromList.ComponentType.MarkMask) <> 0 then begin ChildCompon.NameMark := TF_Main(GForm).MakeNameMarkComponent(ChildCompon, ObjectOwner, true, SprCompTypeFromList.ComponentType.MarkMask); if Assigned(ChildCompon.TreeViewNode) then ChildCompon.TreeViewNode.Text := TF_Main(GForm).GetNameNode(ChildCompon.TreeViewNode, ChildCompon, true, true); end; end; end; end; procedure TF_ChoiceConnectSide.DefineComponTrunkInFuture(AComponent: TSCSComponent); var ObjectOwner: TSCSCatalog; begin if IsTrunkComponent(AComponent) then begin ObjectOwner := AComponent.GetFirstParentCatalog; if ObjectOwner <> nil then //if ObjectOwner.ComponentReferences.IndexOf(AComponent) = 0 then begin ObjectOwner.ServToDefineObjParams := ObjectOwner.ServToDefineObjParams + [dopJoinedTrunk]; //if ARestartTimer then RestartTimer(Timer_DefineObjetsParamsInCAD); end; end; end; procedure TF_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(AComponent: TSCSComponent; ARestartTimer: Boolean); var ObjectOwner: TSCSCatalog; begin if IsTrunkComponent(AComponent) then begin ObjectOwner := AComponent.GetFirstParentCatalog; if ObjectOwner <> nil then //if ObjectOwner.ComponentReferences.IndexOf(AComponent) = 0 then begin ObjectOwner.ServToDefineObjParams := ObjectOwner.ServToDefineObjParams + [dopTrunkChanged]; if ARestartTimer then RestartTimer(Timer_DefineObjetsParamsInCAD); end; end; end; procedure TF_ChoiceConnectSide.DefineJoinedTrunkAfterChangeInFuture(AComponent: TSCSComponent); var JoinedTrunk: TSCSComponent; begin JoinedTrunk := GetJoinedTrunkComponent(AComponent); if JoinedTrunk <> nil then DefineComponTrunkAfterChangeInFuture(JoinedTrunk, false); end; // Tolik 03/04/2020 -- procedure TF_ChoiceConnectSide.RefreshApproachInCAD(AAproachCompon: TSCSComponent); var ParentComponent: TSCSComponent; SprComponentType: TNBComponentType; SCSCatalog: TSCSCatalog; s : String; begin s := ''; if Assigned(AAproachCompon) then begin if Assigned(AAproachCompon.ProjectOwner) then begin if Assigned(AAproachCompon.ProjectOwner.Spravochnik) then begin SprComponentType := AAproachCompon.ProjectOwner.Spravochnik.GetComponentTypeByGUID(AAproachCompon.GUIDComponentType); if SprComponentType <> nil then if SprComponentType.ComponentType.SysName = ctsnApproach then begin ParentComponent := GetParentComponByCompTypeSysName(AAproachCompon, ctsnHouse); if ParentComponent <> nil then begin SCSCatalog := AAproachCompon.GetFirstParentCatalog; SetApproachIndexInCAD(SCSCatalog.ListID, SCSCatalog.SCSID, AAproachCompon.ID, AAproachCompon.MarkID); end; end; end else begin {$IF Not Defined(FINAL_SCS)} s := 'TF_ChoiceConnectSide.RefreshApproachInCAD Error: AAproachCompon.ProjectOwner.Spravochnik = nil ' + #13#10 + 'AAproachCompon.ID = ' + inttostr(AAproachCompon.ID) + 'AAproachCompon.name = ' + AAproachCompon.Name; {$IFEND} end; end else begin {$IF Not Defined(FINAL_SCS)} s := 'TF_ChoiceConnectSide.RefreshApproachInCAD Error: AAproachCompon.ProjectOwner = nil ' + #13#10 + 'AAproachCompon.ID = ' + inttostr(AAproachCompon.ID) + 'AAproachCompon.name = ' + AAproachCompon.Name; {$IFEND} end; end else begin {$IF Not Defined(FINAL_SCS)} s := 'TF_ChoiceConnectSide.RefreshApproachInCAD Error: AAproachCompon = nil'; {$IFEND} end; {$IF Not Defined(FINAL_SCS)} try if s <> '' then begin AddExceptionToLog(s); end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.ConnectInterfaces: '+E.Message); end; {$IFEND} end; { procedure TF_ChoiceConnectSide.RefreshApproachInCAD(AAproachCompon: TSCSComponent); var ParentComponent: TSCSComponent; SprComponentType: TNBComponentType; SCSCatalog: TSCSCatalog; begin SprComponentType := AAproachCompon.ProjectOwner.Spravochnik.GetComponentTypeByGUID(AAproachCompon.GUIDComponentType); if SprComponentType <> nil then if SprComponentType.ComponentType.SysName = ctsnApproach then begin ParentComponent := GetParentComponByCompTypeSysName(AAproachCompon, ctsnHouse); if ParentComponent <> nil then begin SCSCatalog := AAproachCompon.GetFirstParentCatalog; SetApproachIndexInCAD(SCSCatalog.ListID, SCSCatalog.SCSID, AAproachCompon.ID, AAproachCompon.MarkID); end; end; end; } // // ############################################################################# // ##### Создание формы ##### procedure TF_ChoiceConnectSide.FormCreate(Sender: TObject); begin Panel_OKCancelResize(Panel_OKCancel); with TF_Main(GForm).DM do begin ListView_InterfComp1.SmallImages := ImageList_InterfType; ListView_InterfComp2.SmallImages := ImageList_InterfType; ListView_ConnComp1.SmallImages := ImageList_Dir; ListView_ConnComp2.SmallImages := ImageList_Dir; ListView_Compons1.SmallImages := ImageList_Dir; ListView_Compons2.SmallImages := ImageList_Dir; end; end; procedure TF_ChoiceConnectSide.FormClose(Sender: TObject; var Action: TCloseAction); //var ModRes: TModalResult; begin //try if ModalResult = mrOk then case GFormMode of fmChoiceConnSide: if ListView_ToConnect.Items.Count = 0 then begin MessageModal(ChoiceConnectSide_Msg5_1_1, ChoiceConnectSide_Msg5_1_2, MB_ICONINFORMATION or MB_OK); ModalResult := mrNone; end; fmChoiceLineObject: if ListView_ToConnect.Items.Count = 0 then begin MessageModal(ChoiceConnectSide_Msg5_2_1, ChoiceConnectSide_Msg5_2_2, MB_ICONINFORMATION or MB_OK); ModalResult := mrNone; end; end; {except ShowMessage(' Модуль U_ChoiceConnectSide: FormClose '); end; } end; procedure TF_ChoiceConnectSide.FormShow(Sender: TObject); begin GroupBox_ChoiceConnSide.Visible := false; GroupBox_ChoiceLineObject.Visible := false; case GFormMode of fmChoiceConnSide: begin Caption := ChoiceConnectSide_Msg6_1; GroupBox_ChoiceConnSide.Visible := true; GroupBox_ConnectingList.Caption := ChoiceConnectSide_Msg6_2; ListView_ToConnect.SmallImages := ListView_InterfComp1.SmallImages; end; fmChoiceLineObject: begin Caption := ChoiceConnectSide_Msg7_1; GroupBox_ChoiceLineObject.Visible := true; GroupBox_ConnectingList.Caption := ChoiceConnectSide_Msg7_2; ListView_ToConnect.SmallImages := ListView_Compons1.SmallImages; end; end; EnableAddDelInterfToConn; end; procedure TF_ChoiceConnectSide.FormHide(Sender: TObject); begin //FreeToConectListView(ListView_ToConnect); end; // ############### Режим выбора соединяемых сторон (интерфейсов) ############# // ############################################################################# // // ##### ##### function TF_ChoiceConnectSide.ChoiceSides(ACompData1, ACompData2: TSCSComponent; AConnectKind: TConnectkind): Boolean; var ModRes: TModalResult; i: Integer; ConnListData: PConnectListData; InterfData1: TSCSInterface; InterfData2: TSCSInterface; //IDCompRel: Integer; //IDFigure1: Integer; //IDFigure2: Integer; Compon1: TSCSComponent; Compon2: TSCSComponent; SCSObject1: TSCSCatalog; SCSObject2: TSCSCatalog; begin Result := false; GIDComp1 := ACompData1.ID; GIDComp2 := ACompData2.ID; GConnectKind := AConnectKind; Compon1 := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompData1.ID); Compon2 := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(ACompData2.ID); SCSObject1 := nil; SCSObject2 := nil; if Assigned(Compon1) then SCSObject1 := Compon1.GetFirstParentCatalog; if Assigned(Compon2) then SCSObject2 := Compon2.GetFirstParentCatalog; //IDFigure1 := TF_Main(GForm).DM.GetScsIDByIDCatalog(ACompData1.ObjectID); //IDFigure2 := TF_Main(GForm).DM.GetScsIDByIDCatalog(ACompData2.ObjectID); if Assigned(SCSObject1) and Assigned(SCSObject2) then if (SCSObject1 = SCSObject2) or CheckCanConnectInCAD(SCSObject1.ListID, SCSObject2.ListID, SCSObject1.SCSID, SCSObject2.SCSID) then begin GetSidesByConnectedFigures(SCSObject1.ListID, SCSObject2.ListID, SCSObject1.SCSID, SCSObject2.SCSID, FSideCompon1, FSideCompon2); SetGroupBoxCaption(GroupBox_Comp1, ACompData1.Name); SetGroupBoxCaption(GroupBox_Comp2, ACompData2.Name); ListView_ToConnect.Column[0].Caption := ChoiceConnectSide_Msg8+' '+ACompData1.Name; ListView_ToConnect.Column[1].Caption := ChoiceConnectSide_Msg8+' '+ACompData2.Name; if ACompData1.Interfaces.Count = 0 then ACompData1.LoadInterfaces; if ACompData2.Interfaces.Count = 0 then ACompData2.LoadInterfaces; LoadInterfaces(Compon1.Interfaces, FSideCompon1, ListView_InterfComp1); LoadInterfaces(Compon2.Interfaces, FSideCompon2, ListView_InterfComp2); GFormMode := fmChoiceConnSide; ModRes := ShowModal; if ModRes = mrOK then begin //IDCompRel := TF_Main(GForm).AppendToComponRel(ACompData1.ID,ACompData2.ID, 1, cntUnion ); //*** Соединение интерфейсами for i := 0 to ListView_ToConnect.Items.Count - 1 do begin ConnListData := ListView_ToConnect.Items[i].Data; InterfData1 := ConnListData.Data1; InterfData2 := ConnListData.Data2; TF_Main(GForm).UnionInterfaces(InterfData1, InterfData2, AConnectKind); end; //if Not(ACompData1.HaveMultipleInterface) and Not(ACompData2.HaveMultipleInterface) then OnAfterJoinCompons(Compon1, Compon2, FSideCompon1, FSideCompon2); Result := true; TF_Main(GForm).RefreshNode; end; ListView_InterfComp1.Items.Clear; ListView_InterfComp2.Items.Clear; ListView_ConnComp1.Items.Clear; ListView_ConnComp2.Items.Clear; ListView_ToConnect.Items.Clear; //FreeListView(ListView_InterfComp1); //FreeListView(ListView_InterfComp2); //FreeListView(ListView_ConnComp1); //FreeListView(ListView_ConnComp2); //FreeToConectListView(ListView_ToConnect); end else ShowMessageByType(Self.Handle, smtDisplay, ChoiceConnectSide_Msg9_1+' "'+ACompData1.Name+'", "'+ACompData2.Name+'" '+ChoiceConnectSide_Msg9_2, Application.Title, MB_OK or MB_ICONINFORMATION); end; function TF_ChoiceConnectSide.GetIDInterfRel(AListView: TListView): Integer; begin Result := -1; if AListView.Items.Count > 0 then Result := TSCSInterface(AListView.ItemFocused.Data).ID;; end; // ##### Загружает наименования компоненты в GroupBox ##### procedure TF_ChoiceConnectSide.SetGroupBoxCaption(AComboBox: TGroupBox; ACaption: String); begin AComboBox.Caption := ChoiceConnectSide_Msg10+' "'+ ACaption +'" '; end; // ##### Загружает соединения компоненты ##### procedure TF_ChoiceConnectSide.LoadInterfaces(AInterfaces: TSCSInterfaces; ASide: Integer; AListView: TListView); var ListItem: TlistItem; InterfRel: TSCSInterface; i: Integer; Spravochnik: TSpravochnik; SprInterface: TNBInterface; begin {with TF_Main(GForm).DM do begin SetSQLToQuery(scsQSelect, ' select id, id_interface, gender, isbusy, Multiple, side from interface_relation '+ ' where (id_component = '''+ IntToStr(AID_Component) +''') and '+ ' ((isbusy = ''0'') or (multiple = ''1'') )'+ ' order by id '); while not scsQSelect.Eof do begin New(InterfRel); InterfRel.ID := scsQSelect.GetFNAsInteger('id'); InterfRel.ID_INTERFACE := scsQSelect.GetFNAsInteger('id_interface'); InterfRel.Gender := scsQSelect.GetFNAsInteger('Gender'); InterfRel.Multiple := scsQSelect.GetFNAsInteger('Multiple'); InterfRel.IsBusy := scsQSelect.GetFNAsInteger('IsBusy'); InterfRel.Side := scsQSelect.GetFNAsInteger('Side'); ListItem := AListView.Items.Add; ListItem.ImageIndex := 0; ListItem.Data := InterfRel; scsQSelect.Next; end; end; } if Not Assigned(AInterfaces) then Exit; //// EXIT //// for i := 0 to AInterfaces.Count - 1 do if AInterfaces[i].TypeI = itFunctional then if (AInterfaces[i].Side = Aside) or (AInterfaces[i].Side = 0) then if (AInterfaces[i].IsBusy = biFalse) or (AInterfaces[i].Multiple = biTrue) then begin ListItem := AListView.Items.Add; ListItem.ImageIndex := 0; ListItem.Data := AInterfaces[i]; end; {with F_NormBase.DM do for i := 0 to AListView.Items.Count - 1 do begin ListItem := AListView.Items[i]; InterfRel := ListItem.Data; SetSQLToQuery(scsQSelect, ' select name from interface where id = '''+ IntToStr(InterfRel.ID_INTERFACE) +''' '); ListItem.Caption := scsQSelect.GetFNAsString('Name'); LoadInterfDataToListView(ListItem); end; } Spravochnik := TF_Main(GForm).GetSpravochnik; if Spravochnik <> nil then begin for i := 0 to AListView.Items.Count - 1 do begin ListItem := AListView.Items[i]; InterfRel := ListItem.Data; SprInterface := nil; if InterfRel.GUIDInterface <> '' then SprInterface := Spravochnik.GetInterfaceByGUID(InterfRel.GUIDInterface) else if InterfRel.ID_Interface > 0 then SprInterface := Spravochnik.GetInterfaceByID(InterfRel.ID_Interface); if SprInterface <> nil then ListItem.Caption := SprInterface.Name; LoadInterfDataToListView(ListItem); end; end; if AListView.Items.Count > 0 then AListView.Selected := AListView.TopItem; end; // ##### Загружат инфу о интерфейсе в ListView ##### procedure TF_ChoiceConnectSide.LoadInterfDataToListView( AListItem: TListItem); var Interf: TSCSInterface; strProp: String; function GetYesNo(AIntBool: Integer): String; begin Result := ''; if AIntBool = 1 then Result := ChoiceConnectSide_Msg11_1 else Result := ChoiceConnectSide_Msg11_2; end; begin Interf := AListItem.Data; if Interf <> nil then begin //*** Npp AListItem.SubItems.Add(IntTostr(Interf.Npp)); //*** Многокрвтный StrProp := GetYesNo(Interf.Multiple); AListItem.SubItems.Add(strProp); //*** Занят StrProp := GetYesNo(Interf.IsBusy); AListItem.SubItems.Add(strProp); //*** Сторона StrProp := ''; if Interf.Side = 0 then StrProp := ChoiceConnectSide_Msg11_2 else StrProp := IntToStr(Interf.Side); AListItem.SubItems.Add(strProp); //*** Тип StrProp := ''; if Interf.Gender = gtFemale then StrProp := ChoiceConnectSide_Msg12_1; if Interf.Gender = gtMale then StrProp := ChoiceConnectSide_Msg12_2; AListItem.SubItems.Add(strProp); end; end; // ##### Загружает в лист компоненты, кот-е соединены с интерфейсом ##### procedure TF_ChoiceConnectSide.LoadComponsByInterf(ACurrCompon: Integer; AInterfListItem: TListItem; AListView_Compons: TListView); var ListItem: TListItem; IDInterfRel: Integer; //ConnectedInterfacesID: TList; ConnectedInterf: TSCSInterface; ConnectedCompon: TSCSComponent; i: Integer; //IDInterfStr: String; begin IDInterfRel := TSCSInterface(AInterfListItem.Data).ID; //*** Очистить список компонентов FreeListView(AListView_Compons); with TF_Main(GForm) do begin //ConnectedInterfacesID := DM.GetConnectedIDInterfRels(IDInterfRel); //if Assigned(ConnectedInterfacesID) then begin for i := 0 to TSCSInterface(AInterfListItem.Data).ConnectedInterfaces.Count - 1 do begin ConnectedInterf := TSCSInterface(AInterfListItem.Data).ConnectedInterfaces[i]; if ConnectedInterf <> nil then begin ConnectedCompon := nil; ConnectedCompon := GSCSBase.CurrProject.GetComponentFromReferences(ConnectedInterf.ID_Component); if Assigned(ConnectedCompon) then begin ListItem := AListView_Compons.Items.Add; ListItem.Caption := GetComponNameForVisible(ConnectedCompon.Name, ConnectedCompon.NameMark); ListItem.ImageIndex := TF_Main(GForm).GetSCSComponType(ConnectedCompon.IsLine); end; end; end; //FreeList(ConnectedInterfacesID); end; { IDInterfStr := IntToStr(IDInterfRel); SetSQLToQuery(scsQSelect, ' select name, isLine from component '+ ' where (id in (select id_component from interface_relation '+ ' where (id in (select id_interf_rel from interfofinterf_relation '+ ' where id_interf_to = '''+IDInterfStr+''' )) or '+ ' (id in (select id_interf_to from interfofinterf_relation '+ ' where id_interf_rel = '''+IDInterfStr+''' )) ) ) and '+ ' Not(id = '''+ IntToStr(ACurrCompon) +''') '); while Not scsQSelect.Eof do begin ListItem := AListView_Compons.Items.Add; ListItem.Caption := scsQSelect.GetFNAsString('Name'); ListItem.ImageIndex := TF_Main(GForm).GetSCSComponType(scsQSelect.GetFNAsInteger('isline')); scsQSelect.Next; end; } end; end; // ##### Полностью очищает ListView ##### procedure TF_ChoiceConnectSide.FreeListView(AListView: TListView); var i: Integer; begin for i := 0 to AListView.Items.Count - 1 do if AListView.Items[i] <> nil then FreeMem(AListView.Items[i].Data); AListView.Items.Clear; end; // ##### Разрешить/запретить кнопки для добавления и удаления соединямых интерфейсов ##### procedure TF_ChoiceConnectSide.EnableAddDelInterfToConn; var ListView1: TlistView; ListView2: TlistView; begin ListView1 := nil; ListView2 := nil; case GFormMode of fmChoiceConnSide: begin ListView1 := ListView_InterfComp1; ListView2 := ListView_InterfComp2; end; fmChoiceLineObject: begin ListView1 := ListView_Compons1; ListView2 := ListView_Compons2; end; end; if (ListView1 <> nil) and (ListView1 <> nil) then if (ListView1.Items.Count > 0 ) and (ListView2.Items.Count > 0 ) then Act_AddToConnList.Enabled := true else Act_AddToConnList.Enabled := false; if ListView_ToConnect.Items.Count > 0 then Act_DelFromConnList.Enabled := true else Act_DelFromConnList.Enabled := false; end; // ############################################################################# // ##### Изменение текущей позиции интерфейса компоненты1 ##### procedure TF_ChoiceConnectSide.ListView_InterfComp1Change(Sender: TObject; Item: TListItem; Change: TItemChange); begin LoadComponsByInterf(GIDComp1, Item, ListView_ConnComp1); end; // ##### Изменение текущей позиции интерфейса компоненты2 ##### procedure TF_ChoiceConnectSide.ListView_InterfComp2Change(Sender: TObject; Item: TListItem; Change: TItemChange); begin LoadComponsByInterf(GIDComp2, Item, ListView_ConnComp2); end; // ##### Добавить интерфейсы в список соединяемых ##### procedure TF_ChoiceConnectSide.Act_AddToConnListExecute(Sender: TObject); var LItem1: TlistItem; LItem2: TlistItem; //CanConnect: Boolean; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; CheckRes: TCheckInterfForUnionResult; ConnectInterfRes: TConnectInterfRes; begin CheckRes := chrFail; case GFormMode of fmChoiceConnSide: begin LItem1 := ListView_InterfComp1.Selected; LItem2 := ListView_InterfComp2.Selected; if (LItem1 = nil) or (LItem2 = nil) then MessageModal(ChoiceConnectSide_Msg13_1, ChoiceConnectSide_Msg13_2, MB_ICONINFORMATION or MB_OK) else CheckRes := CanConnectInterfaces(TSCSInterface(LItem1.Data), TSCSInterface(LItem2.Data), GForm, GForm, GConnectKind); if CheckRes = chrSuccess then begin MoveItemsToConnectList(LItem1, LItem2, ListView_ToConnect); EnableAddDelInterfToConn; end else TF_Main(GForm).ShowCheckInterfForUnionResult(CheckRes); end; fmChoiceLineObject: begin LItem1 := ListView_Compons1.Selected; LItem2 := ListView_Compons2.Selected; if (LItem1 = nil) or (LItem2 = nil) then MessageModal(ChoiceConnectSide_Msg14_1, ChoiceConnectSide_Msg14_2, MB_ICONINFORMATION or MB_OK) else begin SCSComponent1 := LItem1.Data; SCSComponent2 := LItem2.Data; //CanConnect := TF_Main(GForm).CanConnCompon(ptrSCSComponent1^, ptrSCSComponent2^, cntUnion); //if CanConnect then // begin // ConnectInterfRes := ConnectInterfaces(SCSComponent1, SCSComponent2, // -1, -1, // GConnectKind, true, smtDisplay, true); // if Not CanConnect then // MessageModal(Self.Handle, 'Нет необходимых интерфейсов', 'Соединение', MB_ICONINFORMATION or MB_OK); // end; if ConnectInterfRes.CanConnect then begin MoveItemsToConnectList(LItem1, LItem2, ListView_ToConnect); EnableAddDelInterfToConn; end; end; end; end; end; // ##### Удалить интерфейс из списка соединяемых ##### procedure TF_ChoiceConnectSide.Act_DelFromConnListExecute( Sender: TObject); var MoveLItem: TListItem; begin MoveLItem := ListView_ToConnect.Selected; case GFormMode of fmChoiceConnSide: begin if MoveLItem = nil then MessageModal(ChoiceConnectSide_Msg15_1, ChoiceConnectSide_Msg15_2, MB_ICONINFORMATION or MB_OK) else begin ListView_InterfComp1.OnChange := nil; ListView_InterfComp2.OnChange := nil; MoveItemsFromConnectList(MoveLItem, ListView_InterfComp1, ListView_InterfComp2); ListView_InterfComp1.OnChange := ListView_InterfComp1Change; ListView_InterfComp2.OnChange := ListView_InterfComp2Change; EnableAddDelInterfToConn; end; end; fmChoiceLineObject: begin if MoveLItem = nil then MessageModal(ChoiceConnectSide_Msg16_1, ChoiceConnectSide_Msg16_2, MB_ICONINFORMATION or MB_OK) else begin MoveItemsFromConnectList(MoveLItem, ListView_Compons1, ListView_Compons2); EnableAddDelInterfToConn; end; end; end; end; // ###################### Режим выбора соединямых "кабелей" ################## // ############################################################################# // // ##### Разбивает список объектов на каталоги ##### function TF_ChoiceConnectSide.GetCatalogList(AConnectObjectParams: Tlist; var AComponCount: Integer): TSCSCatalogs; var ResList: TSCSCatalogs; i: Integer; ptrConnectObjectParam: PConnectObjectParam; SCSCatalog: TSCSCatalog; { function LoadCatalogInterfaces(var ACatalog: TSCSCatalog; ASide: Integer): Boolean; var SCSComponent: TSCSComponent; Interfac: TSCSInterface; i, j: Integer; CanTakeInterf: Boolean; CurrInterCanConn: Integer; TotalInterCanConn: Integer; begin //ACatalog.LoadAllComponentsByObjectID(ACatalog.ID, [fiMarkID, fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiWholeID, fiObjectID]); //ACatalog.LoadAllComponentsByObjectID(ACatalog.ID, [fiAll]); //ACatalog.LoadComponents(ACatalog.ID, false); //ChangeSQLQuery(scsQSelect, ' selecet * from '); Result := false; TotalInterCanConn := 0; for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin CurrInterCanConn := 0; SCSComponent := ACatalog.ComponentReferences.Items[i]; for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces.Items[j]; CanTakeInterf := false; case SCSComponent.IsLine of biTrue: if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then if ((Interfac.Side > 0) and (Interfac.Side = ASide)) or (Interfac.Side = 0) then CanTakeInterf := true; biFalse: if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then CanTakeInterf := true; end; if CanTakeInterf then begin Interfac.ServCanConnect := true; Inc(CurrInterCanConn); end else Interfac.ServCanConnect := false; end; if CurrInterCanConn > 0 then begin SCSComponent.ServCanConnect := true; Inc(AComponCount); SCSComponent.ServInterfCntToConnect := CurrInterCanConn; end else SCSComponent.ServCanConnect := false; TotalInterCanConn := TotalInterCanConn + CurrInterCanConn; end; if TotalInterCanConn > 0 then begin ACatalog.ServCanConnect := true; Result := true; end else ACatalog.ServCanConnect := false; end; } function LoadCatalogInterfaces(var ACatalog: TSCSCatalog; ASide: Integer): Boolean; var SCSComponent: TSCSComponent; //Interfac: TSCSInterface; i, j: Integer; //CanTakeInterf: Boolean; CurrInterCanConn: Integer; TotalInterCanConn: Integer; begin //ACatalog.LoadAllComponentsByObjectID(ACatalog.ID, [fiMarkID, fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiWholeID, fiObjectID]); //ACatalog.LoadAllComponentsByObjectID(ACatalog.ID, [fiAll]); //ACatalog.LoadComponents(ACatalog.ID, false); //ChangeSQLQuery(scsQSelect, ' selecet * from '); Result := false; TotalInterCanConn := 0; for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin CurrInterCanConn := 0; SCSComponent := ACatalog.ComponentReferences.Items[i]; if Assigned(SCSComponent) then begin CurrInterCanConn := SCSComponent.GetInterfaceCountToConnect(ASide); if CurrInterCanConn > 0 then begin SCSComponent.ServCanConnect := true; Inc(AComponCount); SCSComponent.ServInterfCntToConnect := CurrInterCanConn; end else SCSComponent.ServCanConnect := false; TotalInterCanConn := TotalInterCanConn + CurrInterCanConn; end; end; if TotalInterCanConn > 0 then begin ACatalog.ServCanConnect := true; Result := true; end else ACatalog.ServCanConnect := false; end; begin Result := nil; ResList := TSCSCatalogs.Create(False); AComponCount := 0; for i := 0 to AConnectObjectParams.Count - 1 do begin ptrConnectObjectParam := AConnectObjectParams.Items[i]; if ptrConnectObjectParam.Side = -1 then ptrConnectObjectParam.Side := 0; //SCSCatalog := TSCSCatalog.Create(TForm(F_ProjMan)); //SCSCatalog.ID := TF_Main(GForm).DM.GetIDCatalogByIDFigure(ptrConnectObjectParam.IDObject); //SCSCatalog.LoadCatalogByID(SCSCatalog.ID, false); //LoadCatalogInterfaces(SCSCatalog, ptrConnectObjectParam.Side); SCSCatalog := nil; SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ptrConnectObjectParam.IDObject); if Assigned(SCSCatalog) then begin if LoadCatalogInterfaces(SCSCatalog, ptrConnectObjectParam.Side) then ResList.Add(SCSCatalog); end; end; if ResList.Count = 0 then ResList.Free else Result := ResList; end; { function TF_ChoiceConnectSide.GetCatalogList(AConnectObjectParams: Tlist; var AComponCount: Integer): TList; var ResList: Tlist; i: Integer; ptrConnectObjectParam: PConnectObjectParam; SCSCatalog: TSCSCatalog; procedure LoadCatalogInterfaces(var ACatalog: TSCSCatalog; ASide: Integer); var SCSComponent: TSCSComponent; Interfac: TSCSInterface; i, j: Integer; CanTakeInterf: Boolean; begin //ACatalog.LoadAllComponentsByObjectID(ACatalog.ID, [fiMarkID, fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiWholeID, fiObjectID]); ACatalog.LoadAllComponentsByObjectID(ACatalog.ID, [fiAll]); //ACatalog.LoadComponents(ACatalog.ID, false); //ChangeSQLQuery(scsQSelect, ' selecet * from '); for i := 0 to ACatalog.SCSComponents.Count - 1 do begin SCSComponent := ACatalog.SCSComponents.Items[i]; //ptrSCSComponent.LoadInterfaces(-1, false); SCSComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, fiGender, fiIsBusy, fiMultiple, fiSide]); for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces.Items[j]; CanTakeInterf := false; case SCSComponent.IsLine of biTrue: if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then if (Interfac.Side > 0) and (Interfac.Side = ASide) then CanTakeInterf := true; biFalse: if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then CanTakeInterf := true; end; if Not CanTakeInterf then begin FreeMem(Interfac); SCSComponent.Interfaces.Items[j] := nil; end; end; SCSComponent.Interfaces.Pack; if SCSComponent.Interfaces.Count = 0 then begin SCSComponent.Free; ACatalog.SCSComponents.Items[i] := nil; end; end; ACatalog.SCSComponents.Pack; end; begin Result := nil; ResList := Tlist.Create; AComponCount := 0; for i := 0 to AConnectObjectParams.Count - 1 do begin ptrConnectObjectParam := AConnectObjectParams.Items[i]; SCSCatalog := TSCSCatalog.Create(TForm(F_ProjMan)); SCSCatalog.ID := TF_Main(GForm).DM.GetIDCatalogByIDFigure(ptrConnectObjectParam.IDObject); SCSCatalog.LoadCatalogByID(SCSCatalog.ID, false); LoadCatalogInterfaces(SCSCatalog, ptrConnectObjectParam.Side); if SCSCatalog.SCSComponents.Count = 0 then begin SCSCatalog.Free; SCSCatalog := nil; end else begin ResList.Add(SCSCatalog); AComponCount := AComponCount + SCSCatalog.SCSComponents.Count; end; end; if ResList.Count = 0 then ResList.Free else Result := ResList; end; } // ##### Разобрать интерфейсы стороны трассы на интерфейсы компонентов ##### {function TF_ChoiceConnectSide.GetComponList(AInterfList: TList): TSCSComponents; type TPosIDinList = record ID: Integer; Index: Integer; end; PPosIDinList = ^TPosIDinList; var ResList: TSCSComponents; PosIDCompList: TList; PosID: PPosIDinList; SCSComponent: TSCSComponent; i: Integer; IDInterf: Integer; procedure AddIDInterfToComponsInterfList(AID_Interface: Integer); var //IDComponent: Integer; InterfaceData: TSCSInterface; i: integer; FindedIndex: Integer; begin with TF_Main(GForm).DM do begin SetSQLToQuery(scsQSelect, ' select * from interface_relation where id = '''+IntToStr(AID_Interface)+''' '); if (scsQSelect.GetFNAsInteger('isBusy') = 0) or (scsQSelect.GetFNAsInteger('Multiple') = 1) then begin //New(InterfaceData); InterfaceData := TSCSInterface.Create(GForm); InterfaceData.ID := AID_Interface; InterfaceData.ID_Component := scsQSelect.GetFNAsInteger('ID_Component'); InterfaceData.ID_Interface := scsQSelect.GetFNAsInteger('ID_Interface'); InterfaceData.TypeI := scsQSelect.GetFNAsInteger('TypeI'); InterfaceData.Gender := scsQSelect.GetFNAsInteger('Gender'); InterfaceData.IsBusy := scsQSelect.GetFNAsInteger('isBusy'); InterfaceData.Multiple := scsQSelect.GetFNAsInteger('Multiple'); //InterfaceData.IOfIRelOut := nil; FindedIndex := -1; for i := 0 to PosIDCompList.Count - 1 do if PPosIDinList(PosIDCompList.Items[i]).ID = InterfaceData.ID_Component then begin FindedIndex := PPosIDinList(PosIDCompList.Items[i]).Index; Break; end; if FindedIndex = -1 then begin SCSComponent := TSCSComponent.Create(GForm); SCSComponent.LoadComponentByID(InterfaceData.ID_Component, false); SCSComponent.Interfaces.Add(InterfaceData); ResList.Add(SCSComponent); //*** Запомнить индекс гового списка New(PosID); PosID.ID := InterfaceData.ID_Component; PosIDCompList.Add(PosID); if PosIDCompList.Count = 0 then PosID.Index := 0 else PosID.Index := PosIDCompList.Count - 1; end else begin SCSComponent := ResList.Items[FindedIndex]; SCSComponent.Interfaces.Add(InterfaceData); end; end; end; end; begin Result := nil; ResList := TSCSComponents.Create(true); PosIDCompList := TList.Create; for i := 0 to AInterfList.Count - 1 do begin IDInterf := Integer(AInterfList.Items[i]^); AddIDInterfToComponsInterfList(IDInterf); end; FreeList(PosIDCompList); if ResList.Count > 0 then Result := ResList else ResList.Free; end; } procedure TF_ChoiceConnectSide.FreeComponList(AComponList: TList); var i: Integer; SCSComponent: TSCSComponent; begin if AComponList = nil then Exit; ///// EXIT ///// for i := 0 to AComponList.Count - 1 do begin SCSComponent := AComponList.Items[i]; SCSComponent.Free; end; AComponList.Free; //FreeList(AComponList); end; procedure TF_ChoiceConnectSide.FreeCatalogList(ACatalogList: TList); var i: Integer; SCSCatalog: TSCSCatalog; begin if ACatalogList = nil then Exit; ///// EXIT ////// for i := 0 to ACatalogList.Count - 1 do begin SCSCatalog := ACatalogList.Items[i]; SCSCatalog.Free; end; ACatalogList.Free; //FreeList(ACatalogList); end; procedure TF_ChoiceConnectSide.JoinCrossConnections(ASCSComponent: TSCSComponent); var ComponentFrom: TSCSComponent; ComponentTo: TSCSComponent; ComponentWith: TSCSComponent; i: Integer; ptrCrossConnection: TSCSCrossConnection; begin if Assigned(ASCSComponent) then with TF_Main(GForm) do begin BeginProgress; try //*** Простое внутрикомпонентное подключение for i := 0 to ASCSComponent.CrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(ASCSComponent.CrossConnections[i]); ComponentFrom := GSCSBase.CurrProject.GetComponentFromReferences(ptrCrossConnection.IDComponFrom); ComponentTo := GSCSBase.CurrProject.GetComponentFromReferences(ptrCrossConnection.IDComponTo); ComponentWith := GSCSBase.CurrProject.GetComponentFromReferences(ptrCrossConnection.IDComponWith); //*** если простое внутрикомпонентное подключения if Assigned(ComponentFrom) and Assigned(ComponentTo) and Not Assigned(ComponentWith) then //ComponentFrom.JoinTo(ComponentTo, -1, -1); ComponentFrom.JoinTo(ComponentTo, -1, -1, false, nil, nil, -1, true, false, true); end; //*** Подключения кроссов for i := 0 to ASCSComponent.CrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(ASCSComponent.CrossConnections[i]); ComponentFrom := GSCSBase.CurrProject.GetComponentFromReferences(ptrCrossConnection.IDComponFrom); ComponentTo := GSCSBase.CurrProject.GetComponentFromReferences(ptrCrossConnection.IDComponTo); ComponentWith := GSCSBase.CurrProject.GetComponentFromReferences(ptrCrossConnection.IDComponWith); //*** для подключения кроссов if Assigned(ComponentFrom) and Assigned(ComponentTo) and Assigned(ComponentWith) then ConnectCrossWithModules(ComponentWith, ComponentFrom, ComponentTo, true); end; finally EndProgress; end; end; end; function TF_ChoiceConnectSide.GetNumSideByObject(AObject: TSCSCatalog; AConnectObjectParams: TList): Integer; var i: Integer; ptrConnectObjectParam: PConnectObjectParam; begin Result := 0; if Assigned(AConnectObjectParams) then for i := 0 to AConnectObjectParams.Count - 1 do begin ptrConnectObjectParam := AConnectObjectParams[i]; if ptrConnectObjectParam.IDObject = AObject.SCSID then begin Result := ptrConnectObjectParam.Side; Break; //// BREAK //// end; end; end; // ##### Проверяет, есть ли с чем соединится линейному компоненту в ##### function TF_ChoiceConnectSide.CanConnectLineComponWithConObjects(AIDNBLineCompon, AIDPointFigure, AIDFinalFigure: Integer; aConsiderBoxAndRack: Boolean=false): Boolean; var SCSPointObject: TSCSCatalog; SCSFinalObject: TSCSCatalog; SCSLineComponent: TSCSComponent; Interfac: TSCSInterface; CanConWithPointObj: Boolean; CanConWithFinalObj: Boolean; ConnectInterfPointObj: TConnectInterfRes; ConnectInterfFinalObj: TConnectInterfRes; SCSComponPointObj: TSCSComponent; SCSComponFinalObj: TSCSComponent; i, j: Integer; {function CanConnectWithObject(ASCSObject: TSCSCatalog): Boolean; var i: Integer; SCSComponent: TSCSComponent; ConnectInterfRes: TConnectInterfRes; CurrComponIsTrunk: Boolean; begin Result := false; //ASCSObject.LoadAllComponentsByObjectID(ASCSObject.ID, [fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); for i := 0 to ASCSObject.ComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.ComponentReferences[i]; //ptrSCSComponent.LoadInterfaces(-1, false); //SCSComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, // fiGender, fiIsBusy, fiMultiple, fiSide]); SCSComponent.DefineInterfCountToConnect; CurrComponIsTrunk := IsTrunkComponent(SCSComponent); //if SCSComponent.HaveInterfaceByType(itFunctional) then if (SCSComponent.ServInterfCntToConnect > 0) or CurrComponIsTrunk then begin ConnectInterfRes := SCSComponent.CheckJoinTo(SCSLineComponent, -1, -1); //ConnectInterfaces(SCSComponent, SCSLineComponent, -1, -1, cnkVarious, true, smtNone, true); if ConnectInterfRes.CanConnect then begin Result := true; Break; ///// EXIT //// end; //*** Если в магистрале не может подкл. к нужной поз-и, то выйти //if CurrComponIsTrunk then // Break; //// BREAK //// end; end; end;} {//02.07.2013 - не используется function CanConnectWithObject(ASCSObject: TSCSCatalog): Boolean; var i: Integer; SCSComponent: TSCSComponent; SCSComponentInterfaces: TSCSInterfaces; ConnectInterfRes: TConnectInterfRes; CurrComponIsTrunk: Boolean; begin Result := false; //ASCSObject.LoadAllComponentsByObjectID(ASCSObject.ID, [fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); for i := 0 to ASCSObject.ComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.ComponentReferences[i]; //ptrSCSComponent.LoadInterfaces(-1, false); //SCSComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, // fiGender, fiIsBusy, fiMultiple, fiSide]); SCSComponent.DefineInterfCountToConnect; CurrComponIsTrunk := IsTrunkComponent(SCSComponent); //if SCSComponent.HaveInterfaceByType(itFunctional) then if (SCSComponent.ServInterfCntToConnect > 0) or CurrComponIsTrunk then begin ZeroMemory(@ConnectInterfRes, SizeOf(TConnectInterfRes)); //if GAutoTraceOnePortToOne and TF_Main(GForm).GSCSBase.CurrProject.IsAutoTracing then if TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne then begin SCSComponentInterfaces := GetComponInterfacesThatPortNoHaveBusyInterfaces(SCSComponent); ConnectInterfRes := SCSComponent.CheckJoinTo(SCSLineComponent, -1, -1, false, SCSComponentInterfaces, nil); //ConnectInterfaces(SCSComponent, SCSLineComponent, -1, -1, cnkVarious, true, smtNone, true); FreeAndNil(SCSComponentInterfaces); end else ConnectInterfRes := SCSComponent.CheckJoinTo(SCSLineComponent, -1, -1); if ConnectInterfRes.CanConnect then begin Result := true; Break; ///// EXIT //// end; //*** Если в магистрале не может подкл. к нужной поз-и, то выйти //if CurrComponIsTrunk then // Break; //// BREAK //// end; end; end;} function CanConnWithPointComponent(APointComponent: TSCSComponent; aOtherCompon: TSCSComponent=nil): TConnectInterfRes; var SCSComponentInterfaces: TSCSInterfaces; CurrComponIsTrunk: Boolean; PointTopCompon, OtherTopCompon: TSCSComponent; begin ZeroMemory(@Result, SizeOf(TConnectInterfRes)); APointComponent.DefineInterfCountToConnect; //30.01.2009 CurrComponIsTrunk := IsTrunkComponent(APointComponent); //if SCSComponent.HaveInterfaceByType(itFunctional) then //30.01.2009 if (APointComponent.ServInterfCntToConnect > 0) or CurrComponIsTrunk then if (APointComponent.ServInterfCntToConnect > 0) or (GetParentComponByOneCompTypeSysName(APointComponent, GCompTypeSysNameComplexCompons) <> nil) then begin //02.07.2013 // //if GAutoTraceOnePortToOne and TF_Main(GForm).GSCSBase.CurrProject.IsAutoTracing then // if TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne then // begin // SCSComponentInterfaces := GetComponInterfacesThatPortNoHaveBusyInterfaces(APointComponent); // Result := APointComponent.CheckJoinTo(SCSLineComponent, -1, -1, false, SCSComponentInterfaces, nil); //ConnectInterfaces(SCSComponent, SCSLineComponent, -1, -1, cnkVarious, true, smtNone, true); // FreeAndNil(SCSComponentInterfaces); // end // else // Result := APointComponent.CheckJoinTo(SCSLineComponent, -1, -1); //02.07.2013 SCSComponentInterfaces := nil; //02.07.2013 - учитываем особый способ подключения, если среди объектов есть Бокс и Шкаф if aConsiderBoxAndRack and Assigned(aOtherCompon) then begin PointTopCompon := APointComponent.GetTopComponent; OtherTopCompon := aOtherCompon.GetTopComponent; if (PointTopCompon <> nil) and (OtherTopCompon <> nil) then begin if (PointTopCompon.ComponentType.SysName = ctsnCupboard) and (OtherTopCompon.ComponentType.SysName = ctsnBox) then SCSComponentInterfaces := APointComponent.GetInterfacesByIsPort(biFalse, false) // если шкаф (с боксом), то берем только интерфейсы для бокса, порты не трогаем else if (PointTopCompon.ComponentType.SysName = ctsnBox) then begin if (OtherTopCompon.ComponentType.SysName = ctsnCupboard) then SCSComponentInterfaces := APointComponent.GetInterfacesByIsPort(biFalse, false) // если шкаф (с боксом), то берем только интерфейсы для бокса, порты не трогаем else SCSComponentInterfaces := APointComponent.GetInterfacesByIsPort(biTrue, false); // если бокс с компонентом (не шкаф), то берем только интерфейсы (не порты) end; end; end else begin if TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne then SCSComponentInterfaces := GetComponInterfacesThatPortNoHaveBusyInterfaces(APointComponent); end; if SCSComponentInterfaces <> nil then begin Result := APointComponent.CheckJoinTo(SCSLineComponent, -1, -1, false, SCSComponentInterfaces, nil); FreeAndNil(SCSComponentInterfaces); end else Result := APointComponent.CheckJoinTo(SCSLineComponent, -1, -1); //*** Если в магистрале не может подкл. к нужной поз-и, то выйти //if CurrComponIsTrunk then // Break; //// BREAK //// end; end; begin Result := false; try SCSPointObject := nil; SCSFinalObject := nil; SCSLineComponent := TSCSComponent.Create(TForm(F_NormBase)); try CanConWithPointObj := false; CanConWithFinalObj := false; with TF_Main(GForm) do begin SCSPointObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AIDPointFigure); SCSFinalObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AIDFinalFigure); end; //11.11.2010 if (Not Assigned(SCSPointObject)) or (Not Assigned(SCSFinalObject)) then //11.11.2010 Exit; //// EXIT //// if (Not Assigned(SCSPointObject)) and (Not Assigned(SCSFinalObject)) then //11.11.2010 Exit; //// EXIT //// //11.11.2010 if SCSPointObject.ItemType <> itSCSConnector then Exit; //// EXIT //// if (SCSFinalObject <> nil) and (SCSFinalObject.ItemType <> itSCSConnector) then Exit; //// EXIT //// //SCSLineComponent.LoadComponentByID(AIDNBLineCompon, false); if F_NormBase.GSCSBase.SCSComponent.ID = AIDNBLineCompon then begin if Not F_NormBase.GSCSBase.SCSComponent.ServAllLoaded then begin F_NormBase.GSCSBase.SCSComponent.LoadComponentByID(AIDNBLineCompon, true); F_NormBase.GSCSBase.SCSComponent.ServAllLoaded := true; end; SCSLineComponent.Assign(F_NormBase.GSCSBase.SCSComponent, true, true); end else begin SCSLineComponent.ID := AIDNBLineCompon; SCSLineComponent.LoadComponentByFi([fiIsLine, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); end; if SCSLineComponent.IsLine = biFalse then Exit; //// EXIT ///// SetComponAsLite(SCSLineComponent); //SCSLineComponent.LoadInterfaces(-1, false); //*** Интерфейсы компоненты из НБ if SCSLineComponent.Interfaces.Count = 0 then //SCSLineComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, // fiGender, fiIsBusy, fiMultiple, fiSide]); SCSLineComponent.LoadInterfaces(-1, false); // Оставить интерфейсы для соединения for i := 0 to SCSLineComponent.Interfaces.Count - 1 do begin Interfac := SCSLineComponent.Interfaces[i]; if Interfac.TypeI = itFunctional then if Not((Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue)) then SCSLineComponent.Interfaces[i] := nil; end; SCSLineComponent.Interfaces.Pack; if SCSLineComponent.Interfaces.Count > 0 then begin if aConsiderBoxAndRack then begin for i := 0 to SCSPointObject.ComponentReferences.Count - 1 do begin SCSComponPointObj := SCSPointObject.ComponentReferences[i]; ConnectInterfPointObj := CanConnWithPointComponent(SCSComponPointObj); if SCSFinalObject = nil then begin Result := ConnectInterfPointObj.CanConnect; end else if ConnectInterfPointObj.CanConnect then begin for j := 0 to SCSFinalObject.ComponentReferences.Count - 1 do begin SCSComponFinalObj := SCSFinalObject.ComponentReferences[j]; ConnectInterfPointObj := CanConnWithPointComponent(SCSComponPointObj, SCSComponFinalObj); if ConnectInterfPointObj.CanConnect then begin ConnectInterfFinalObj := CanConnWithPointComponent(SCSComponFinalObj, SCSComponPointObj); if ConnectInterfFinalObj.CanConnect then begin //*** Можно ли подключать точ-е компоненты по свойствам для конечных точечных компонент if TF_Main(GForm).CheckCanJoinEndComponsByProps(TSCSComponent(ConnectInterfPointObj.ComponObj1), TSCSComponent(ConnectInterfFinalObj.ComponObj1), nil) then begin Result := true; Break; //// BREAK //// end; end; end; end; if Result then Break; //// BREAK //// end; end; end else begin for i := 0 to SCSPointObject.ComponentReferences.Count - 1 do begin SCSComponPointObj := SCSPointObject.ComponentReferences[i]; ConnectInterfPointObj := CanConnWithPointComponent(SCSComponPointObj); if ConnectInterfPointObj.CanConnect and (SCSFinalObject = nil) then Result := true else if ConnectInterfPointObj.CanConnect and (SCSFinalObject <> nil) then begin if SCSFinalObject.SCSComponents.Count = 0 then Result := true else for j := 0 to SCSFinalObject.ComponentReferences.Count - 1 do begin SCSComponFinalObj := SCSFinalObject.ComponentReferences[j]; ConnectInterfFinalObj := CanConnWithPointComponent(SCSComponFinalObj); if ConnectInterfFinalObj.CanConnect then begin //*** Можно ли подключать точ-е компоненты по свойствам для конечных точечных компонент if TF_Main(GForm).CheckCanJoinEndComponsByProps(TSCSComponent(ConnectInterfPointObj.ComponObj1), TSCSComponent(ConnectInterfFinalObj.ComponObj1), nil) then begin Result := true; Break; //// BREAK //// end; end; end; end; if Result then Break; //// BREAK //// end; end; {CanConWithPointObj := CanConnectWithObject(SCSPointObject); if (CanConWithPointObj = true) and (SCSFinalObject <> nil) then begin CanConWithFinalObj := CanConnectWithObject(SCSFinalObject); if CanConWithFinalObj = true then Result := true else if SCSFinalObject.SCSComponents.Count = 0 then Result := true; end else if CanConWithPointObj then Result := true;} end; finally SCSLineComponent.Free; end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.CanConnectLineComponWithObjects: '+E.Message); end; end; (* // ##### Проверяет, есть ли с чем соединится линейному компоненту в ##### function TF_ChoiceConnectSide.CanConnectLineComponWithConObjects(AIDNBLineCompon, AIDPointFigure, AIDFinalFigure: Integer): Boolean; var SCSPointObject: TSCSCatalog; SCSFinalObject: TSCSCatalog; SCSLineComponent: TSCSComponent; Interfac: TSCSInterface; CanConWithPointObj: Boolean; CanConWithFinalObj: Boolean; i: Integer; {function CanConnectWithObject(ASCSObject: TSCSCatalog): Boolean; var i: Integer; SCSComponent: TSCSComponent; ConnectInterfRes: TConnectInterfRes; CurrComponIsTrunk: Boolean; begin Result := false; //ASCSObject.LoadAllComponentsByObjectID(ASCSObject.ID, [fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); for i := 0 to ASCSObject.ComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.ComponentReferences[i]; //ptrSCSComponent.LoadInterfaces(-1, false); //SCSComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, // fiGender, fiIsBusy, fiMultiple, fiSide]); SCSComponent.DefineInterfCountToConnect; CurrComponIsTrunk := IsTrunkComponent(SCSComponent); //if SCSComponent.HaveInterfaceByType(itFunctional) then if (SCSComponent.ServInterfCntToConnect > 0) or CurrComponIsTrunk then begin ConnectInterfRes := SCSComponent.CheckJoinTo(SCSLineComponent, -1, -1); //ConnectInterfaces(SCSComponent, SCSLineComponent, -1, -1, cnkVarious, true, smtNone, true); if ConnectInterfRes.CanConnect then begin Result := true; Break; ///// EXIT //// end; //*** Если в магистрале не может подкл. к нужной поз-и, то выйти //if CurrComponIsTrunk then // Break; //// BREAK //// end; end; end;} function CanConnectWithObject(ASCSObject: TSCSCatalog): Boolean; var i: Integer; SCSComponent: TSCSComponent; SCSComponentInterfaces: TSCSInterfaces; ConnectInterfRes: TConnectInterfRes; CurrComponIsTrunk: Boolean; begin Result := false; //ASCSObject.LoadAllComponentsByObjectID(ASCSObject.ID, [fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); for i := 0 to ASCSObject.ComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.ComponentReferences[i]; //ptrSCSComponent.LoadInterfaces(-1, false); //SCSComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, // fiGender, fiIsBusy, fiMultiple, fiSide]); SCSComponent.DefineInterfCountToConnect; CurrComponIsTrunk := IsTrunkComponent(SCSComponent); //if SCSComponent.HaveInterfaceByType(itFunctional) then if (SCSComponent.ServInterfCntToConnect > 0) or CurrComponIsTrunk then begin ZeroMemory(@ConnectInterfRes, SizeOf(TConnectInterfRes)); //if GAutoTraceOnePortToOne and TF_Main(GForm).GSCSBase.CurrProject.IsAutoTracing then if TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne then begin SCSComponentInterfaces := GetComponInterfacesThatPortNoHaveBusyInterfaces(SCSComponent); ConnectInterfRes := SCSComponent.CheckJoinTo(SCSLineComponent, -1, -1, false, SCSComponentInterfaces, nil); //ConnectInterfaces(SCSComponent, SCSLineComponent, -1, -1, cnkVarious, true, smtNone, true); FreeAndNil(SCSComponentInterfaces); end else ConnectInterfRes := SCSComponent.CheckJoinTo(SCSLineComponent, -1, -1); if ConnectInterfRes.CanConnect then begin Result := true; Break; ///// EXIT //// end; //*** Если в магистрале не может подкл. к нужной поз-и, то выйти //if CurrComponIsTrunk then // Break; //// BREAK //// end; end; end; begin Result := false; try SCSPointObject := nil; SCSFinalObject := nil; SCSLineComponent := TSCSComponent.Create(TForm(F_NormBase)); try CanConWithPointObj := false; CanConWithFinalObj := false; with TF_Main(GForm) do begin SCSPointObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AIDPointFigure); SCSFinalObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AIDFinalFigure); end; if (Not Assigned(SCSPointObject)) and (Not Assigned(SCSFinalObject)) then Exit; //// EXIT //// if SCSPointObject.ItemType <> itSCSConnector then Exit; //// EXIT //// if (SCSFinalObject <> nil) and (SCSFinalObject.ItemType <> itSCSConnector) then Exit; //// EXIT //// //SCSLineComponent.LoadComponentByID(AIDNBLineCompon, false); if F_NormBase.GSCSBase.SCSComponent.ID = AIDNBLineCompon then begin if Not F_NormBase.GSCSBase.SCSComponent.ServAllLoaded then begin F_NormBase.GSCSBase.SCSComponent.LoadComponentByID(AIDNBLineCompon, true); F_NormBase.GSCSBase.SCSComponent.ServAllLoaded := true; end; SCSLineComponent.Assign(F_NormBase.GSCSBase.SCSComponent, true, true); end else begin SCSLineComponent.ID := AIDNBLineCompon; SCSLineComponent.LoadComponentByFi([fiIsLine, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); end; if SCSLineComponent.IsLine = biFalse then Exit; //// EXIT ///// //SCSLineComponent.LoadInterfaces(-1, false); //*** Интерфейсы компоненты из НБ if SCSLineComponent.Interfaces.Count = 0 then SCSLineComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, fiGender, fiIsBusy, fiMultiple, fiSide]); // Оставить интерфейсы для соединения for i := 0 to SCSLineComponent.Interfaces.Count - 1 do begin Interfac := SCSLineComponent.Interfaces[i]; if Interfac.TypeI = itFunctional then if Not((Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue)) then SCSLineComponent.Interfaces[i] := nil; end; SCSLineComponent.Interfaces.Pack; if SCSLineComponent.Interfaces.Count > 0 then begin //if Not SCSLineComponent.HaveInterfaceByType(itFunctional) then // Exit; ///// EXIT ///// CanConWithPointObj := CanConnectWithObject(SCSPointObject); if (CanConWithPointObj = true) and (SCSFinalObject <> nil) then begin CanConWithFinalObj := CanConnectWithObject(SCSFinalObject); if CanConWithFinalObj = true then Result := true else if SCSFinalObject.SCSComponents.Count = 0 then Result := true; end else if CanConWithPointObj then Result := true; end; finally SCSLineComponent.Free; end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.CanConnectLineComponWithObjects: '+E.Message); end; { try SCSObject1 := TSCSCatalog.Create(GForm); SCSObject2 := TSCSCatalog.Create(GForm); SCSLineComponent := TSCSComponent.Create(TForm(F_NormBase)); try CanConWithObj1 := false; CanConWithObj2 := false; SCSObject1.ID := TF_Main(GForm).DM.GetIDCatalogByIDFigure(AIDFigure1); //SCSObject1.LoadCatalogByIDFigure(AIDFigure1, false, false); //if SCSObject1.ItemType <> itSCSConnector then // Exit; //// EXIT //// SCSObject2.ID := TF_Main(GForm).DM.GetIDCatalogByIDFigure(AIDFigure2); //SCSObject2.LoadCatalogByIDFigure(AIDFigure2, false, false); //if SCSObject2.ItemType <> itSCSConnector then // Exit; //// EXIT //// //SCSLineComponent.LoadComponentByID(AIDNBLineCompon, false); SCSLineComponent.ID := AIDNBLineCompon; SCSLineComponent.LoadComponentByFi([fiIsLine, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); if SCSLineComponent.IsLine = biFalse then Exit; //// EXIT ///// //SCSLineComponent.LoadInterfaces(-1, false); SCSLineComponent.LoadInterfacesByFi([fiID, fiIDInterface, fiTypeI, fiGender, fiIsBusy, fiMultiple, fiSide]); if Not SCSLineComponent.HaveInterfaceByType(itFunctional) then Exit; ///// EXIT ///// CanConWithObj1 := CanConnectWithObject(SCSObject1); if CanConWithObj1 = true then begin CanConWithObj2 := CanConnectWithObject(SCSObject2); if CanConWithObj2 = true then Result := true; end; finally SCSObject1.Free; SCSObject2.Free; SCSLineComponent.Free; end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.CanConnectLineComponWithObjects: '+E.Message); end; } end; *) function TF_ChoiceConnectSide.CanJoinComponsByCAD(ACompon1, ACompon2: TSCSComponent): Boolean; var SCSObject1: TSCSCatalog; SCSObject2: TSCSCatalog; begin Result := false; SCSObject1 := ACompon1.GetFirstParentCatalog; SCSObject2 := ACompon2.GetFirstParentCatalog; if (SCSObject1 <> nil) and (SCSObject1 <> nil) then Result := CheckCanConnectInCAD(SCSObject1.ListID, SCSObject2.ListID, SCSObject1.SCSID, SCSObject2.SCSID); end; function TF_ChoiceConnectSide.ConnectCrossWithModules(ACrossComponent, AComponFrom, AComponTo: TSCSComponent; ANoCopyCrossAsFirst: Boolean): TCrossConnectRes; var ComponListFrom: TSCSComponents; ComponListTo: TSCSComponents; ParentCompon: TSCSComponent; ObjectOwner: TSCSCatalog; ObjectOwnerNode: TTreeNode; CrossComponentTemplate: TSCSComponent; CrossComponentForConnect: TSCSComponent; SCSComponFrom: TSCSComponent; SCSComponTo: TSCSComponent; i, j, k: Integer; ConnectInterfRes: TConnectInterfRes; ptrComplect: PComplect; Interfac: TSCSInterface; ImportFromNBCount: Integer; NewIDCompon: Integer; WasCoping: Boolean; CanTryJoinWithBothCompons: Boolean; CanJoinToSeveralCompons: Boolean; begin Result.Successful := false; Result.ConnectCount := 0; CanTryJoinWithBothCompons := true; if Not (Assigned(ACrossComponent) and Assigned(AComponFrom) and Assigned(AComponTo)) then Exit; ///// EXIT ///// ImportFromNBCount := 0; CrossComponentForConnect := nil; CrossComponentTemplate := TSCSComponent.Create(ACrossComponent.ActiveForm); CrossComponentTemplate.Assign(ACrossComponent, true, true); ComponListFrom := TSCSComponents.Create(false); ComponListTo := TSCSComponents.Create(false); //ParentCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ParentNode.Data).ObjectID); ParentCompon := TSCSComponent(AComponFrom.Parent); ObjectOwnerNode := nil; ObjectOwner := AComponFrom.GetFirstParentCatalog; if ObjectOwner <> nil then ObjectOwnerNode := ObjectOwner.TreeViewNode; if Assigned(ParentCompon) and Assigned(ObjectOwner) then try //ParentComponNode := ParentCompon.TreeViewNode; ComponListFrom.Add(AComponFrom); ComponListFrom.Assign(AComponFrom.ChildReferences, laOr); ComponListTo.Add(AComponTo); ComponListTo.Assign(AComponTo.ChildReferences, laOr); ComponListFrom.Pack; ComponListTo.Pack; for i := 0 to ComponListFrom.Count - 1 do ComponListFrom[i].ServCanConnect := true; for i := 0 to ComponListTo.Count - 1 do ComponListTo[i].ServCanConnect := true; if CrossComponentTemplate.Interfaces.Count = 0 then CrossComponentTemplate.LoadInterfaces(-1, false); if ObjectOwnerNode <> nil then while CanTryJoinWithBothCompons do begin CanTryJoinWithBothCompons := false; AComponFrom.ServCanConnect := true; AComponTo.ServCanConnect := true; for i := 0 to ComponListFrom.Count - 1 do begin SCSComponFrom := ComponListFrom[i]; if CrossComponentTemplate.CheckJoinToSeveralCompons(SCSComponFrom, nil, false, true).CanConnect then //if CrossComponentTemplate.EmConnectTo(SCSComponFrom) then begin for j := 0 to ComponListTo.Count - 1 do begin SCSComponTo := ComponListTo[j]; //(SCSComponTo.ServCanConnect) and //Tolik 30/08/2021 -- // CrossComponentTemplate.CheckJoinToSeveralCompons(SCSComponFrom, SCSComponTo, false, true).CanConnect then CanJoinToSeveralCompons := CrossComponentTemplate.CheckJoinToSeveralCompons(SCSComponFrom, SCSComponTo, false, true).CanConnect; if CanJoinToSeveralCompons then //if (SCSComponTo.ServCanConnect) and (CrossComponentTemplate.EmConnectTo(SCSComponTo)) then begin CrossComponentForConnect := nil; WasCoping := false; if (Result.ConnectCount > 0) or (Not ANoCopyCrossAsFirst) then begin NewIDCompon := TF_MAIN(GForm).CopyComponentFromNbToPm(CrossComponentTemplate.ActiveForm, GForm, nil, ObjectOwnerNode, CrossComponentTemplate.ID, ckCompon, false); CrossComponentForConnect := TF_MAIN(GForm).GSCSBase.CurrProject.GetComponentFromReferences(NewIDCompon); WasCoping := true; Inc(ImportFromNBCount); end else if (CrossComponentTemplate.ActiveForm = AComponFrom.ActiveForm) and (CrossComponentTemplate.ActiveForm = AComponTo.ActiveForm) then CrossComponentForConnect := ACrossComponent; if Assigned(CrossComponentForConnect) then begin if WasCoping then begin //NewComponNode := TF_Main(GForm).FindComponOrDirInTree(NewIDCompon, true); //if Assigned(NewComponNode) then // PObjectData(NewComponNode).ID_CompRel := ptrComplect.ID; //ptrComplect := ParentCompon.ComplectWithOnlyObject(CrossComponentForConnect); //ptrComplect.ID := TF_Main(GForm).AppendToComponRel(ParentCompon.ID, CrossComponentForConnect.ID, 1, cntComplect); //if Assigned(CrossComponentForConnect.TreeViewNode) then // PObjectData(CrossComponentForConnect.TreeViewNode.Data).ID_CompRel := ptrComplect.ID; CrossComponentForConnect.DisConnectFromParent; ptrComplect := ParentCompon.ComplectWith(CrossComponentForConnect); //31.01.2013 если маркировать не со всеми компонентами, то генерим маркировку if TF_Main(GForm).GSCSBase.CurrProject.Setting.PointComplIndexingMode <> pcimInProject then begin CrossComponentForConnect.MarkID := 0; //31.01.2013 CrossComponentForConnect.MarkID := TF_Main(GForm).GenComponentMarkID(CrossComponentForConnect); CrossComponentForConnect.NameMark := TF_Main(GForm).MakeNameMarkComponent(CrossComponentForConnect, ObjectOwner, false); end; end; //CrossComponentTemplate.EmDisconnect(SCSComponFrom); //CrossComponentTemplate.EmDisconnect(SCSComponTo); ConnectInterfRes := CrossComponentForConnect.JoinTo(SCSComponFrom, -1, -1, false, nil, nil, -1, true, false, true); if ConnectInterfRes.CanConnect then begin ConnectInterfRes := CrossComponentForConnect.JoinTo(SCSComponTo, -1, -1, false, nil, nil, -1, true, false, true); if ConnectInterfRes.CanConnect then begin Inc(Result.ConnectCount); CanTryJoinWithBothCompons := true; end; CrossComponentTemplate.Interfaces.Clear; //ClearList(CrossComponentTemplate.Interfaces); //CrossComponentTemplate.LoadInterfaces(-1, false); CrossComponentTemplate.AssignInterfaces(ACrossComponent.Interfaces, true, true); if CrossComponentTemplate.Interfaces.Count = 0 then CrossComponentTemplate.LoadInterfaces(-1, false); //*** подготовить функциональные интерфейсы как не занятые for k := 0 to CrossComponentTemplate.Interfaces.Count - 1 do begin Interfac := CrossComponentTemplate.Interfaces[k]; if Interfac.TypeI = itFunctional then if Interfac.KolvoBusy > 0 then begin Interfac.IsBusy := biFalse; Interfac.KolvoBusy := 0; Interfac.IOfIRelOut.Clear; end; end; //SCSComponFrom.ServCanConnect := false; //SCSComponTo.ServCanConnect := false; Break; //// BREAK //// end; //else //TF_Main(GForm).DelCompon(NewCompon, true, true, true); end; //CrossComponentTemplate.EmDisconnect(SCSComponTo); end; end; //CrossComponentTemplate.EmDisconnect(SCSComponFrom); end; end; end; if ImportFromNBCount > 0 then TF_Main(GForm).F_ChoiceConnectSide.OnAfterConnectCompons(ParentCompon, CrossComponentForConnect); if Result.ConnectCount > 0 then Result.Successful := true; finally ComponListFrom.Free; ComponListTo.Free; CrossComponentTemplate.Free; end; end; function TF_ChoiceConnectSide.ConnectObjectCompons(AObject1, AObject2: TSCSCatalog; ASideObject1, ASideObject2: Integer; AOnlyNewLineCompon: Boolean): Boolean; var i, j: Integer; ConnectInterfRes: TConnectInterfRes; InterfCount1, InterfCount2: Integer; InterfCountToConnect: Integer; MaxConnectInterfaces: Integer; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; ConnCompon1: TSCSComponent; ConnCompon2: TSCSComponent; WasBreak: Boolean; Catalog1, Catalog2: TSCSCatalog; // Tolik { function GetInterfCountBySide(ACompon: TSCSComponent; ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interfac := ACompon.Interfaces[i]; if ((Interfac.Side = ASide) and (Interfac.TypeI = itFunctional)) then begin if Interfac.Kolvo = 1 then begin if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then ResCount := ResCount + 1; end else if Interfac.Kolvo > 1 then begin if Interfac.Multiple = biTrue then ResCount := ResCount + Interfac.Kolvo else ResCount := ResCount + (Interfac.Kolvo - Interfac.KolvoBusy); end; end; end; Result := ResCount; end;} // function GetInterfCountBySide(ACompon: TSCSComponent; ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interfac := ACompon.Interfaces[i]; if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then if Interfac.Side = ASide then ResCount := ResCount + 1; end; Result := ResCount; end; function ConnectComponents(ACompon1, ACompon2: TSCSComponent; AObjSide1, AObjSide2: Integer): Boolean; var ConnectInterfRes: TConnectInterfRes; CanJoin: Boolean; begin Result := false; CanJoin := True; if (ACompon1 <> nil) and (ACompon2 <> nil) then begin //Tolik if F_PEAutoTraceDialog.FromAutoTraceDialog then begin if (F_PEAutoTraceDialog.IgnoreExistingCable.Checked and F_PEAutoTraceDialog.IgnoreExistingCable.Visible) then begin if ACompon1.IsLine = biTrue then begin if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(ACompon1.ID) = -1 then CanJoin := False; end; if ACompon2.IsLine = biTrue then begin if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(ACompon2.ID) = -1 then CanJoin := False; end; end else begin if ACompon1.IsLine = biTrue then begin if ACompon1.Cypher <> F_PEAutoTraceDialog.Cypher then CanJoin := False; end; if ACompon2.IsLine = biTrue then begin if ACompon2.Cypher <> F_PEAutoTraceDialog.Cypher then CanJoin := False; end; end; end; if CanJoin then begin if ACompon1.isLine = biTrue then ConnectInterfRes := ACompon1.JoinTo(ACompon2, AObjSide1, AObjSide2); if ConnectInterfRes.CanConnect then begin Result := true; (* ACompon1.ServInterfCntToConnect := ACompon1.ServInterfCntToConnect - ConnectInterfRes.ConnectInterfCount; ACompon2.ServInterfCntToConnect := ACompon2.ServInterfCntToConnect - ConnectInterfRes.ConnectInterfCount; if (ACompon1.ServInterfCntToConnect <= 0) {and Not(ACompon1.HaveMultipleInterface)} then ACompon1.ServCanConnect := false; if (ACompon2.ServInterfCntToConnect <= 0) {and Not(ACompon2.HaveMultipleInterface)} then ACompon2.ServCanConnect := false; *) end; {if ACompon1.Interfaces.Count = 0 then ACompon1.Clear; if ACompon2.Interfaces.Count = 0 then ACompon2.Clear; } end; end; end; function CheckJoinToJoinedObjectIfMultiple(AComponToJoin: TSCSComponent; AObjectToJoin: TSCSCatalog): Boolean; var i: Integer; JoinedCompon: TSCSComponent; begin Result := false; if AComponToJoin.HaveMultipleInterface then for i := 0 to AComponToJoin.JoinedComponents.Count - 1 do begin JoinedCompon := AComponToJoin.JoinedComponents[i]; if JoinedCompon.GetFirstParentCatalog = AObjectToJoin then begin Result := true; Break; ///// BREAK ///// end; end; end; function CheckComponForCanConnect(AComponent: TSCSComponent; AComponObject: TSCSCatalog): Boolean; begin Result := false; if AComponent.ServCanConnect then case AComponent.IsLine of biTrue: if (Not AOnlyNewLineCompon) or (AComponObject.LastAddedComponent = AComponent) then Result := true; biFalse: Result := true; end else //30.01.2009 if IsTrunkComponent(AComponent) then //30.01.2009 Result := true; if GetParentComponByOneCompTypeSysName(AComponent, GCompTypeSysNameComplexCompons) <> nil then Result := true; end; begin Result := false; Catalog1 := AObject1; //TSCSCatalog.Create(GForm); Catalog2 := AObject2; //TSCSCatalog.Create(GForm); if (Catalog1.ItemType = itSCSConnector) and (Catalog2.ItemType = itSCSLine) then begin ExchangeObjects(Catalog1, Catalog2); ExchangeIntegers(ASideObject1, ASideObject2); end; // Tolik if F_PEAutoTraceDialog.FromAutoTraceDialog then begin if F_PEAutoTraceDialog.NewRaspredBox then begin // !!!! Сюды оно вообще по идеи никогда и не заходит //Catalog1.Assign(AObj1); //Catalog2.Assign(AObj2); //FiltreInterfaces(Catalog1, AObjSide1); //FiltreInterfaces(Catalog2, AObjSide2); ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; { for i := 0 to Catalog1.ComponentReferences.Count - 1 do if Assigned(Catalog1.ComponentReferences[i]) then begin} SCSComponent1 := Catalog1.LastAddedComponent; if (SCSComponent1 <> nil) and (F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(SCSComponent1.ID) <> -1) then begin ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; WasBreak := false; {IGOR} //D0000006292 if CheckComponForCanConnect(SCSComponent1, Catalog1) or (AObject1.IsLine <> AObject2.isLine) then begin //*** Если у компоненты есть многократные инетрфейсы (не дать кабелю 220в подключится два раза к одному и томуже компоненту/объекту) if CheckJoinToJoinedObjectIfMultiple(SCSComponent1, Catalog2) then SCSComponent1.ServCanConnect := false else for j := 0 to Catalog2.ComponentReferences.Count - 1 do if Assigned(Catalog2.ComponentReferences[j]) then begin SCSComponent2 := Catalog2.ComponentReferences.Items[j]; {IGOR} //D0000006292 if CheckComponForCanConnect(SCSComponent2, Catalog2) or (AObject1.IsLine <> AObject2.isLine) then begin //if CheckJoinToJoinedObjectIfMultiple(SCSComponent2, Catalog1) then // SCSComponent2.ServCanConnect := false //else begin //*** Определить количество интерфейсов для соединения InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount1 else InterfCountToConnect := InterfCount2; ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2); if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin //ConnCompon1 := SCSComponent1; //ConnCompon2 := SCSComponent2; if ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2) then if Result = false then Result := true; {IGOR} //D0000006311 if Result and (SCSComponent1.ServInterfCntToConnect > 0) and Not SCSComponent1.ProjectOwner.Setting.TraceOnePortToOne and ((SCSComponent1.ComponentType.SysName = ctsnOFCable) or (SCSComponent1.ComponentType.SysName = ctsnCable) or (SCSComponent2.ComponentType.SysName = ctsnOFCable) or (SCSComponent2.ComponentType.SysName = ctsnCable)) and (SCSComponent1.IsLine <> SCSComponent2.IsLine) then begin Result := true; end else begin WasBreak := true; Break; ///// BREAK ///// end; end else begin {IGOR} //D0000006311 //if F_AutoTraceConnectOrder.rbOnePortOrMoreToOne.Checked then if Not SCSComponent1.ProjectOwner.Setting.TraceOnePortToOne then if (SCSComponent1.ComponentType.SysName = ctsnOFCable) or (SCSComponent1.ComponentType.SysName = ctsnCable) or (SCSComponent2.ComponentType.SysName = ctsnOFCable) or (SCSComponent2.ComponentType.SysName = ctsnCable) then if SCSComponent1.IsLine <> SCSComponent2.IsLine then if ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2) then if Result = false then Result := true; end; if ConnectInterfRes.ConnectInterfCount > MaxConnectInterfaces then begin MaxConnectInterfaces := ConnectInterfRes.ConnectInterfCount; ConnCompon1 := SCSComponent1; ConnCompon2 := SCSComponent2; end; end; end; end; if WasBreak then Break; ///// BREAK ///// end; //if WasBreak then // Break; ///// BREAK ///// end; //if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then {IGOR} //D0000006311 if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) and Not Result then begin if ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2) then if Result = false then Result := true; ConnCompon1 := nil; ConnCompon2 := nil; end; end; end else begin Catalog1 := AObject1; if Catalog1.IsLine = biTrue then Catalog2 := AObject2 else begin Catalog1 := AObject2; if Catalog1.IsLine = biTrue then Catalog2 := AObject1 else Exit; end; if (Catalog1.ItemType = itSCSConnector) and (Catalog2.ItemType = itSCSLine) then begin ExchangeObjects(Catalog1, Catalog2); ExchangeIntegers(ASideObject1, ASideObject2); end; //Catalog1.Assign(AObj1); //Catalog2.Assign(AObj2); //FiltreInterfaces(Catalog1, AObjSide1); //FiltreInterfaces(Catalog2, AObjSide2); ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; for i := 0 to Catalog1.ComponentReferences.Count - 1 do begin if Assigned(Catalog1.ComponentReferences[i]) then begin SCSComponent1 := Catalog1.ComponentReferences.Items[i]; ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; WasBreak := false; {IGOR} //D0000006292 if CheckComponForCanConnect(SCSComponent1, Catalog1) or (AObject1.IsLine <> AObject2.isLine) then begin //*** Если у компоненты есть многократные инетрфейсы (не дать кабелю 220в подключится два раза к одному и томуже компоненту/объекту) if CheckJoinToJoinedObjectIfMultiple(SCSComponent1, Catalog2) then SCSComponent1.ServCanConnect := false else begin if Assigned(Catalog2.ComponentReferences[Catalog2.ComponentReferences.Count - 1]) then begin SCSComponent2 := Catalog2.ComponentReferences.Items[Catalog2.ComponentReferences.Count - 1]; {IGOR} //D0000006292 if CheckComponForCanConnect(SCSComponent2, Catalog2) or (AObject1.IsLine <> AObject2.isLine) then begin //if CheckJoinToJoinedObjectIfMultiple(SCSComponent2, Catalog1) then // SCSComponent2.ServCanConnect := false //else begin //*** Определить количество интерфейсов для соединения InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount1 else InterfCountToConnect := InterfCount2; ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2); if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin //ConnCompon1 := SCSComponent1; //ConnCompon2 := SCSComponent2; if ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2) then if Result = false then Result := true; {IGOR} //D0000006311 if Result and (SCSComponent1.ServInterfCntToConnect > 0) and Not SCSComponent1.ProjectOwner.Setting.TraceOnePortToOne and ((SCSComponent1.ComponentType.SysName = ctsnOFCable) or (SCSComponent1.ComponentType.SysName = ctsnCable) or (SCSComponent2.ComponentType.SysName = ctsnOFCable) or (SCSComponent2.ComponentType.SysName = ctsnCable)) and (SCSComponent1.IsLine <> SCSComponent2.IsLine) then begin Result := true; end else begin WasBreak := true; Break; ///// BREAK ///// end; end else begin {IGOR} //D0000006311 //if F_AutoTraceConnectOrder.rbOnePortOrMoreToOne.Checked then if Not SCSComponent1.ProjectOwner.Setting.TraceOnePortToOne then if (SCSComponent1.ComponentType.SysName = ctsnOFCable) or (SCSComponent1.ComponentType.SysName = ctsnCable) or (SCSComponent2.ComponentType.SysName = ctsnOFCable) or (SCSComponent2.ComponentType.SysName = ctsnCable) then if SCSComponent1.IsLine <> SCSComponent2.IsLine then if ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2) then if Result = false then Result := true; end; if ConnectInterfRes.ConnectInterfCount > MaxConnectInterfaces then begin MaxConnectInterfaces := ConnectInterfRes.ConnectInterfCount; ConnCompon1 := SCSComponent1; ConnCompon2 := SCSComponent2; end; end; end; end; if WasBreak then Break; ///// BREAK ///// end; end; //if WasBreak then // Break; ///// BREAK ///// end; //if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then {IGOR} //D0000006311 if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) and Not Result then begin if ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2) then if Result = false then Result := true; ConnCompon1 := nil; ConnCompon2 := nil; end; end; // баг если по 2 одинаковых - то что-то и ложит, но хрень происходит - // в логе - Не удается подключить компонент "Короб 40x40 К40 8" к "Соединитель 40x40". // потому подключаем только к одной Catalog1.ComponentReferences если с установки ЭКК // для случая if F_PEAutoTraceDialog.FromAutoTraceDialog then возможно тоже потом пригодится if result and GConnecntOnlyOneLineCompon then break; end; end; end else begin //Catalog1.Assign(AObj1); //Catalog2.Assign(AObj2); //FiltreInterfaces(Catalog1, AObjSide1); //FiltreInterfaces(Catalog2, AObjSide2); ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; for i := 0 to Catalog1.ComponentReferences.Count - 1 do if Assigned(Catalog1.ComponentReferences[i]) then begin SCSComponent1 := Catalog1.ComponentReferences.Items[i]; ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; WasBreak := false; {IGOR} //D0000006292 if CheckComponForCanConnect(SCSComponent1, Catalog1) or (AObject1.IsLine <> AObject2.isLine) then begin //*** Если у компоненты есть многократные инетрфейсы (не дать кабелю 220в подключится два раза к одному и томуже компоненту/объекту) if CheckJoinToJoinedObjectIfMultiple(SCSComponent1, Catalog2) then SCSComponent1.ServCanConnect := false else for j := 0 to Catalog2.ComponentReferences.Count - 1 do if Assigned(Catalog2.ComponentReferences[j]) then begin SCSComponent2 := Catalog2.ComponentReferences.Items[j]; {IGOR} //D0000006292 if CheckComponForCanConnect(SCSComponent2, Catalog2) or (AObject1.IsLine <> AObject2.isLine) then begin //if CheckJoinToJoinedObjectIfMultiple(SCSComponent2, Catalog1) then // SCSComponent2.ServCanConnect := false //else begin //*** Определить количество интерфейсов для соединения InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount1 else InterfCountToConnect := InterfCount2; ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2); if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin //ConnCompon1 := SCSComponent1; //ConnCompon2 := SCSComponent2; if ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2) then if Result = false then Result := true; {IGOR} //D0000006311 if Result and (SCSComponent1.ServInterfCntToConnect > 0) and Not SCSComponent1.ProjectOwner.Setting.TraceOnePortToOne and ((SCSComponent1.ComponentType.SysName = ctsnOFCable) or (SCSComponent1.ComponentType.SysName = ctsnCable) or (SCSComponent2.ComponentType.SysName = ctsnOFCable) or (SCSComponent2.ComponentType.SysName = ctsnCable)) and (SCSComponent1.IsLine <> SCSComponent2.IsLine) then begin Result := true; end else begin WasBreak := true; Break; ///// BREAK ///// end; end else begin {IGOR} //D0000006311 //if F_AutoTraceConnectOrder.rbOnePortOrMoreToOne.Checked then if Not SCSComponent1.ProjectOwner.Setting.TraceOnePortToOne then if (SCSComponent1.ComponentType.SysName = ctsnOFCable) or (SCSComponent1.ComponentType.SysName = ctsnCable) or (SCSComponent2.ComponentType.SysName = ctsnOFCable) or (SCSComponent2.ComponentType.SysName = ctsnCable) then if SCSComponent1.IsLine <> SCSComponent2.IsLine then if ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2) then if Result = false then Result := true; end; if ConnectInterfRes.ConnectInterfCount > MaxConnectInterfaces then begin MaxConnectInterfaces := ConnectInterfRes.ConnectInterfCount; ConnCompon1 := SCSComponent1; ConnCompon2 := SCSComponent2; end; end; end; end; if WasBreak then Break; ///// BREAK ///// end; //if WasBreak then // Break; ///// BREAK ///// end; //if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then {IGOR} //D0000006311 if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) and Not Result then begin if ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2) then if Result = false then Result := true; ConnCompon1 := nil; ConnCompon2 := nil; end; // баг если по 2 одинаковых - то что-то и ложит, но хрень происходит - // в логе - Не удается подключить компонент "Короб 40x40 К40 8" к "Соединитель 40x40". // потому подключаем только к одной Catalog1.ComponentReferences если с установки ЭКК // для случая if F_PEAutoTraceDialog.FromAutoTraceDialog then возможно тоже потом пригодится if result and GConnecntOnlyOneLineCompon then break; end; end; //if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then //begin // Result := ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2); //end; end; function TF_ChoiceConnectSide.ConnectObjects(AConnectObjectParams1, AConnectObjectParams2: Tlist): Boolean; var CatalogList1: TSCSCatalogs; CatalogList2: TSCSCatalogs; //ptrConnectObjectParam1: PConnectObjectParam; //ptrConnectObjectParam2: PConnectObjectParam; //OnlyTraces1: Boolean; //OnlyTraces2: Boolean; //CanMakeCabling: Boolean; //ObjectIDList: TList; //SCSComponent1: TSCSComponent; //SCSComponent2: TSCSComponent; ComponCount1: Integer; ComponCount2: Integer; //ConnectListData: PConnectListData; //ModRes: TModalResult; //ConnectKind: TConnectKind; //i, j, k, l: Integer; //ConnectInterfRes: TConnectInterfRes; { procedure LoadCatalogInterfaces(var ACatalog: TSCSCatalog; ASide: Integer); var ptrSCSComponent: PSCSComponent; Interfac: TSCSInterface; i, j: Integer; CanTakeInterf: Boolean; begin ACatalog.LoadAllComponents(ACatalog.ID, false); //ACatalog.LoadComponents(ACatalog.ID, false); //ChangeSQLQuery(scsQSelect, ' selecet * from '); for i := 0 to ACatalog.SCSComponents.Count - 1 do begin ptrSCSComponent := ACatalog.SCSComponents.Items[i]; ptrSCSComponent.LoadInterfaces(-1, false); for j := 0 to ptrSCSComponent.Interfaces.Count - 1 do begin Interfac := ptrSCSComponent.Interfaces.Items[j]; CanTakeInterf := false; case ptrSCSComponent.IsLine of biTrue: if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then if (Interfac.Side > 0) and (Interfac.Side = ASide) then CanTakeInterf := true; biFalse: if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then CanTakeInterf := true; end; if Not CanTakeInterf then begin FreeMem(Interfac); ptrSCSComponent.Interfaces.Items[j] := nil; end; end; ptrSCSComponent.Interfaces.Pack; if ptrSCSComponent.Interfaces.Count = 0 then begin ptrSCSComponent.Free; ACatalog.SCSComponents.Items[i] := nil; end; end; ACatalog.SCSComponents.Pack; end; } (* function ConnectComponents: Boolean; var i, j, k, l: Integer; MaxConnectInterfaces: Integer; ptrConnCompon1: PSCSComponent; ptrConnCompon2: PSCSComponent; begin Result := false; for i := 0 to CatalogList1.Count - 1 do begin ptrCatalog1 := CatalogList1.Items[i]; for j := 0 to ptrCatalog1.SCSComponents.Count - 1 do begin ptrSCSComponent1 := ptrCatalog1.SCSComponents.Items[j]; ptrConnCompon1 := nil; ptrConnCompon2 := nil; MaxConnectInterfaces := 0; for k := 0 to CatalogList2.Count - 1 do begin ptrCatalog2 := CatalogList2.Items[k]; for l := 0 to ptrCatalog2.SCSComponents.Count - 1 do begin ptrSCSComponent2 := ptrCatalog2.SCSComponents.Items[l]; ConnectInterfRes := ConnectInterfaces(ptrSCSComponent1^, ptrSCSComponent2^, ConnectKind, true); if ConnectInterfRes.CanConnect then if ConnectInterfRes.ConnectInterfCount > MaxConnectInterfaces then if TF_Main(GForm).CanConnCompon(ptrSCSComponent1^, ptrSCSComponent2^, cntUnion) then begin MaxConnectInterfaces := ConnectInterfRes.ConnectInterfCount; ptrConnCompon1 := ptrSCSComponent1; ptrConnCompon2 := ptrSCSComponent2; end; {if ConnectInterfRes.ConnectInterfCount = MaxConnectInterfaces then begin if (ptrConnCompon1 <> nil) and (ptrConnCompon2 <> nil) then begin ConnectInterfRes := ConnectInterfaces(ptrConnCompon1.Interfaces, ptrConnCompon2.Interfaces, ConnectKind); if ConnectInterfRes.CanConnect then Result := true; end; MaxConnectInterfaces := ConnectInterfRes.ConnectInterfCount; ptrConnCompon1 := ptrSCSComponent1; ptrConnCompon2 := ptrSCSComponent2; end; } //end; end; end; if (ptrConnCompon1 <> nil) and (ptrConnCompon2 <> nil) then begin ConnectInterfRes := ConnectInterfaces(ptrConnCompon1^, ptrConnCompon2^, ConnectKind); if ConnectInterfRes.CanConnect then begin DefineObjectFullness(ptrCatalog1^.ID); DefineObjectFullness(ptrCatalog2^.ID); Result := true; end; end; end; end; end; *) { function GetNumSideByObject(AObject: TSCSCatalog; AConnectObjectParams: TList): Integer; var i: Integer; ptrConnectObjectParam: PConnectObjectParam; begin Result := -1; for i := 0 to AConnectObjectParams.Count - 1 do begin ptrConnectObjectParam := AConnectObjectParams[i]; if ptrConnectObjectParam.IDObject = AObject.SCSID then begin Result := ptrConnectObjectParam.Side; Break; //// BREAK //// end; end; end; } (* function ConnectComponents(ACatalogList1, ACatalogList2: TSCSCatalogs; AObjParams1, AObjParams2: TList): Boolean; var i, j, k, l: Integer; InterfCountToConnect: Integer; MaxConnectInterfaces: Integer; ConnCompon1: TSCSComponent; ConnCompon2: TSCSComponent; WasBreak: Boolean; Side1: Integer; Side2: Integer; begin Side1 := -1; Side2 := -1; Result := false; for i := 0 to ACatalogList1.Count - 1 do begin SCSCatalog1 := ACatalogList1.Items[i]; Side1 := GetNumSideByObject(SCSCatalog1, AObjParams1); for j := 0 to SCSCatalog1.ComponentReferences.Count - 1 do begin SCSComponent1 := SCSCatalog1.ComponentReferences.Items[j]; ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := 0; WasBreak := false; if SCSComponent1.ServCanConnect then for k := 0 to ACatalogList2.Count - 1 do begin SCSCatalog2 := ACatalogList2.Items[k]; Side2 := GetNumSideByObject(SCSCatalog2, AObjParams2); for l := 0 to SCSCatalog2.ComponentReferences.Count - 1 do begin SCSComponent2 := SCSCatalog2.ComponentReferences.Items[l]; if SCSComponent2.ServCanConnect then begin //*** Определить количество интерфейсов для соединения {if SCSComponent1.Interfaces.Count < SCSComponent2.Interfaces.Count then InterfCountToConnect := SCSComponent1.Interfaces.Count else InterfCountToConnect := SCSComponent2.Interfaces.Count; } if SCSComponent1.ServInterfCntToConnect > SCSComponent2.ServInterfCntToConnect then InterfCountToConnect := SCSComponent1.ServInterfCntToConnect else InterfCountToConnect := SCSComponent2.ServInterfCntToConnect; //ConnectInterfRes := ConnectInterfaces(SCSComponent1, SCSComponent2, Side1, Side2, ConnectKind, false, smtNone, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2); if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if ConnectInterfRes.ConnectInterfCount = InterfCountToConnect then begin ConnCompon1 := SCSComponent1; ConnCompon2 := SCSComponent2; WasBreak := true; Break; ///// BREAK ///// end; if ConnectInterfRes.ConnectInterfCount > MaxConnectInterfaces then begin MaxConnectInterfaces := ConnectInterfRes.ConnectInterfCount; ConnCompon1 := SCSComponent1; ConnCompon2 := SCSComponent2; end; end; end; end; if WasBreak then Break; ///// BREAK ///// end; //*** Собственно соединение if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then begin //ConnectInterfRes := ConnectInterfaces(ConnCompon1, ConnCompon2, Side1, Side2, ConnectKind, false, smtProtocol); ConnectInterfRes := ConnCompon1.JoinTo(ConnCompon2, Side1, Side2); if ConnectInterfRes.CanConnect then Result := true; ConnCompon1.ServInterfCntToConnect := ConnCompon1.ServInterfCntToConnect - ConnectInterfRes.ConnectInterfCount; ConnCompon2.ServInterfCntToConnect := ConnCompon2.ServInterfCntToConnect - ConnectInterfRes.ConnectInterfCount; if ConnCompon1.ServInterfCntToConnect = 0 then ConnCompon1.ServCanConnect := false; if ConnCompon2.ServInterfCntToConnect = 0 then ConnCompon2.ServCanConnect := false; { if ConnCompon1.Interfaces.Count = 0 then ConnCompon1.Clear; if ConnCompon2.Interfaces.Count = 0 then ConnCompon2.Clear; } end; end; end; end; *) {function GetIsOnlyTraces(var ACatalogList: TList): Boolean; var i: Integer; SCSCatalog: TSCSCatalog; ItemType: Integer; begin Result := true; for i := 0 to ACatalogList.Count - 1 do begin SCSCatalog := ACatalogList.Items[i]; //if ptrCatalog.ItemType = 0 then // ptrCatalog.LoadCatalogByID(ptrCatalog.ID, false); ItemType := TF_Main(GForm).DM.GetCatalogIDItemType(SCSCatalog.ID, qmMemory); if ItemType <> itSCSLine then Result := false; end; end; } { function ConnectComponents(ACatalogList1, ACatalogList2: TSCSCatalogs; AObjParams1, AObjParams2: TList): Boolean; var i, j: Integer; Side1: Integer; Side2: Integer; SCSCatalog1: TSCSCatalog; SCSCatalog2: TSCSCatalog; begin Side1 := -1; Side2 := -1; Result := false; for i := 0 to ACatalogList1.Count - 1 do begin SCSCatalog1 := ACatalogList1.Items[i]; Side1 := GetNumSideByObject(SCSCatalog1, AObjParams1); for j := 0 to ACatalogList2.Count - 1 do begin SCSCatalog2 := ACatalogList2.Items[j]; Side2 := GetNumSideByObject(SCSCatalog2, AObjParams2); if ConnectObjectCompons(SCSCatalog1, SCSCatalog2, Side1, Side2, false) then Result := true; end; end; end;} function ConnectComponents(ACatalogList1, ACatalogList2: TSCSCatalogs; AObjParams1, AObjParams2: TList): Boolean; var i, j, k, l, m, n, q: Integer; Side1: Integer; Side2: Integer; SCSCatalog1: TSCSCatalog; SCSCatalog2: TSCSCatalog; ObjectList: TSCSCatalogs; ObjectSides: TIntList; SCSObject: TSCSCatalog; ObjectSide: Integer; WasDel: Boolean; CorrectPointObj: Boolean; begin Side1 := -1; Side2 := -1; Result := false; CorrectPointObj := false; ObjectList := TSCSCatalogs.Create(false); ObjectSides := TIntList.Create; // Внести в общие списки объекты со сторонами for i := 0 to ACatalogList1.Count - 1 do begin SCSObject := ACatalogList1.Items[i]; ObjectSide := GetNumSideByObject(SCSObject, AObjParams1); ObjectList.Add(SCSObject); ObjectSides.Add(ObjectSide); end; for i := 0 to ACatalogList2.Count - 1 do begin SCSObject := ACatalogList2.Items[i]; ObjectSide := GetNumSideByObject(SCSObject, AObjParams2); ObjectList.Add(SCSObject); ObjectSides.Add(ObjectSide); end; // Подключение компонентов объектов for i := 0 to ACatalogList1.Count - 1 do begin SCSCatalog1 := ACatalogList1.Items[i]; Side1 := GetNumSideByObject(SCSCatalog1, AObjParams1); for j := 0 to ACatalogList2.Count - 1 do begin SCSCatalog2 := ACatalogList2.Items[j]; Side2 := GetNumSideByObject(SCSCatalog2, AObjParams2); if ConnectObjectCompons(SCSCatalog1, SCSCatalog2, Side1, Side2, false) then Result := true; end; end; // Подключить к точ-му компоненту все линейные из других трасс for i := 0 to ObjectList.Count - 1 do begin SCSCatalog1 := ObjectList[i]; if SCSCatalog1.ItemType = itSCSConnector then begin Side1 := ObjectSides[i]; for j := 0 to ObjectList.Count - 1 do begin SCSCatalog2 := ObjectList[j]; if SCSCatalog1 <> SCSCatalog2 then if SCSCatalog2.ItemType = itSCSLine then begin //Этот кусок нужен потому что если автоматом цеплять седенения //сначала кабель 1.5, а потом 2.5 делает не нужные нам соеденения //потому тут их обратно рассоеденяем for m := 0 to SCSCatalog1.SCSComponents.Count - 1 do begin //TODO Сделать проверку не только на TERMINAL_BOX а на либо-какой точечный объект с одинаковыми параметрами //if SCSCatalog1.SCSComponents[m].ComponentType.SysName = ctsnTerminalBox then for n := 0 to SCSCatalog1.SCSComponents[m].Interfaces.Count - 1 do begin if SCSCatalog1.SCSComponents[m].Interfaces[n].TypeI = itFunctional then if SCSCatalog1.SCSComponents[m].Interfaces[n].Gender = gtFeMale then begin CorrectPointObj := true; break; end; end; if CorrectPointObj then begin begin for n := 0 to SCSCatalog2.SCSComponents.Count - 1 do begin WasDel := True; WHile WasDel do begin WasDel := false; //Если нет подключения к нужно коробке for k := 0 to SCSCatalog2.SCSComponents[n].JoinedComponents.Count - 1 do begin if SCSCatalog2.SCSComponents[n].JoinedComponents[k] <> SCSCatalog1.SCSComponents[m] then begin for l := 0 to ObjectList.Count - 1 do begin for q := 0 to ObjectList[l].SCSComponents.Count - 1 do begin //находим соеденения трас if SCSCatalog2.SCSComponents[n].JoinedComponents[k] = ObjectList[l].SCSComponents[q] then begin //И если обе имею такие параметры,как выбранны в нормбейс if (CheckComponentsForSideSection(SCSCatalog2.SCSComponents[n].JoinedComponents[k]))and (CheckComponentsForSideSection(ObjectList[l].SCSComponents[q])) then begin //тогда только дисконект if ((SCSCatalog2.SCSComponents[n].IDNetType in [3,{4,}5,7])and (ObjectList[l].SCSComponents[q].IDNetType in [3,{4,}5,7])) then begin //Tolik if not F_PEAutoTraceDialog.FromAutoTraceDialog then begin SCSCatalog2.SCSComponents[n].DisJoinFrom(ObjectList[l].SCSComponents[q]); WasDel := true; Break; end else begin // Tolik if ( (TSCSComponent(SCSCatalog2.SCSComponents[n]).Cypher = F_PEAutoTraceDialog.Cypher) and (TSCSComponent(ObjectList[l].SCSComponents[q]).Cypher = F_PEAutoTraceDialog.Cypher) ) then begin if ((F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked)) or ((F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (SCSCatalog2.SCSComponents[n].id = SCSCatalog2.LastAddedComponent.ID) and (ObjectList[l].SCSComponents[q].ID = TSCSCatalog(ObjectList[l]).ID)) then begin // SCSCatalog2.SCSComponents[n].DisJoinFrom(ObjectList[l].SCSComponents[q]); WasDel := true; Break; end; end; end; end; end; end; end; if WasDel then Break; end; end; if WasDel then Break; end; end; (* k := 0; WHile k <= SCSCatalog2.SCSComponents[n].JoinedComponents.Count - 1 do begin WasDel := false; //Если нет подключения к нужно коробке if SCSCatalog2.SCSComponents[n].JoinedComponents[k] <> SCSCatalog1.SCSComponents[m] then begin for l := 0 to ObjectList.Count - 1 do for q := 0 to ObjectList[l].SCSComponents.Count - 1 do //находим соеденения трас if SCSCatalog2.SCSComponents[n].JoinedComponents[k] = ObjectList[l].SCSComponents[q] then begin //И если обе имею такие параметры,как выбранны в нормбейс if (CheckComponentsForSideSection(SCSCatalog2.SCSComponents[n].JoinedComponents[k]))and (CheckComponentsForSideSection(ObjectList[l].SCSComponents[q])) then begin //тогда только дисконект if ((SCSCatalog2.SCSComponents[n].IDNetType in [3,4,5,7])and (ObjectList[l].SCSComponents[q].IDNetType in [3,4,5,7])) then begin SCSCatalog2.SCSComponents[n].DisJoinFrom(ObjectList[l].SCSComponents[q]); WasDel := true; k := k - 1; end; end; end; end; if not WasDel then k := k+1; end; *) end; end; end; end; // Если компоненты из одного списка (подключение компонент из разных списов было выше) if ((ACatalogList1.IndexOf(SCSCatalog1) <> -1) and (ACatalogList1.IndexOf(SCSCatalog2) <> -1)) or ((ACatalogList2.IndexOf(SCSCatalog1) <> -1) and (ACatalogList2.IndexOf(SCSCatalog2) <> -1)) then begin Side2 := ObjectSides[j]; if ConnectObjectCompons(SCSCatalog1, SCSCatalog2, Side1, Side2, false) then Result := true; end; end; end; end; end; FreeAndNil(ObjectList); FreeAndNil(ObjectSides); end; begin Result := false; try //OnlyTraces1 := false; //OnlyTraces2 := false; //CanMakeCabling := false; //ObjectIDList := nil; CatalogList1 := GetCatalogList(AConnectObjectParams1, ComponCount1); CatalogList2 := GetCatalogList(AConnectObjectParams2, ComponCount2); try //Tolik 20/06/2018 -- if ((CatalogList1 = nil) or (CatalogList2 = nil)) then Exit else if (CatalogList1.Count = 0) or (CatalogList2.Count = 0) then Exit; ///// EXIT ///// //ConnectKind := cnkVarious or cnkMaleMale; //GConnectKind := ConnectKind; //*** В первом списке должно быть меньше компонентов, чем во втором if ComponCount1 <= ComponCount2 then Result := ConnectComponents(CatalogList1, CatalogList2, AConnectObjectParams1, AConnectObjectParams2) else Result := ConnectComponents(CatalogList2, CatalogList1, AConnectObjectParams2, AConnectObjectParams1); { while Result do begin if ComponCount1 <= ComponCount2 then Result := ConnectComponents(CatalogList1, CatalogList2, AConnectObjectParams1, AConnectObjectParams2) else Result := ConnectComponents(CatalogList2, CatalogList1, AConnectObjectParams2, AConnectObjectParams1); end; } { //*** Если больше двух трасс, то можна делать скрутку if (CatalogList1.Count > 1) or (CatalogList2.Count > 1) then begin OnlyTraces1 := GetIsOnlyTraces(CatalogList1); if OnlyTraces1 then OnlyTraces2 := GetIsOnlyTraces(CatalogList2); if OnlyTraces1 and OnlyTraces2 then CanMakeCabling := true; end; case CanMakeCabling of true: begin ObjectIDList := TList.Create; ObjectIDList.Assign(AConnectObjectParams1, laOr); ObjectIDList.Assign(AConnectObjectParams2, laOr); Result := MakeCabling(ObjectIDList); end; false: //*** В первом списке должно быть меньше компонентов, чем во втором if ComponCount1 <= ComponCount2 then Result := ConnectComponents(CatalogList1, CatalogList2) else Result := ConnectComponents(CatalogList2, CatalogList1); end; } finally //FreeCatalogList(CatalogList1); //FreeCatalogList(CatalogList2); if CatalogList1 <> nil then CatalogList1.Free; if CatalogList2 <> nil then CatalogList2.Free; //FreeList(ObjectIDList); //FreeList(AConnectObjectParams1); //FreeList(AConnectObjectParams2); //*** Списки ListView_Compons1, ListView_Compons2 указывают на только что очищенные данные //ListView_Compons1.Items.Clear; //ListView_Compons2.Items.Clear; //FreeToConectListView(ListView_ToConnect); end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.ConnectObjects: '+E.Message); end; end; function TF_ChoiceConnectSide.ConnectObjectsByWay(AWay: TIntList; AFigures, ASCSObjs: TList; APosList: TIntList = nil; aConsiderBoxAndRack: Boolean=false): Boolean; var WayObjects: TSCSCatalogs; SCSObject: TSCSCatalog; CADObject: TObject; CurrObj: TSCSCatalog; PrevObj: TSCSCatalog; PrevPrevObj: TSCSCatalog; SCSCompon: TSCSComponent; //SCSCompon1: TSCSComponent; //SCSCompon2: TSCSComponent; ConnectKind: TConnectKind; WasConnect: Boolean; i, j: Integer; ptrConnObjSides: PConnectedObjectsSides; ptrPrevConnObjSides: PConnectedObjectsSides; ObjectSidesList: TList; SCSList: TSCSList; FirstPointObject: TSCSCatalog; LastPointObject: TSCSCatalog; FirstPointPort: TSCSInterface; LastPointPort: TSCSInterface; FirstPointPortInterfCount: Integer; LastPointPortInterfCount: Integer; MaxInterfCountToConnect: Integer; SCSLineComponents: TSCSComponents; FirstLineComponent: TSCSComponent; LastLineComponent: TSCSComponent; FirstLineComponentPos: Integer; LastLineComponentPos: Integer; FirstLineComponentSide: Integer; LastLineComponentSide: Integer; WasJoinedToEndPoints: Boolean; FirstLineComponentInterfaces: TSCSInterfaces; LastLineComponentInterfaces: TSCSInterfaces; FirstPointInterface: TSCSInterface; LastPointInterface: TSCSInterface; //02.07.2013 - точечные комопненты, и их интерфейсы для специфического подключения FirstPointCompon, LastPointCompon, FirstPointTopCompon, LastPointTopCompon: TSCSComponent; FirstPointInterfaces, LastPointInterfaces: TSCSInterfaces; function FindConnObjSides(AIDObj1, AIDObj2: Integer): PConnectedObjectsSides; var i: Integer; ptrResConnObjSides: PConnectedObjectsSides; begin Result := nil; for i := 0 to ObjectSidesList.Count - 1 do begin ptrResConnObjSides := ObjectSidesList[i]; if ((ptrResConnObjSides.IDObj1 = AIDObj1) and (ptrResConnObjSides.IDObj2 = AIDObj2)) or ((ptrResConnObjSides.IDObj1 = AIDObj2) and (ptrResConnObjSides.IDObj2 = AIDObj1)) then begin Result := ptrResConnObjSides; Break; //// BREAK //// end; end; end; function GetLineComponInterfacesForJoinToPoint(ALineComponent: TSCSComponent; APointObject: TSCSCatalog; var AlineComponSide: Integer): TSCSInterfaces; var LineComponObject: TSCSCatalog; ptrConnectedObjSides: PConnectedObjectsSides; LineComponSide: Integer; begin Result := nil; ptrConnectedObjSides := nil; LineComponSide := -1; LineComponObject := ALineComponent.GetFirstParentCatalog; if LineComponObject <> nil then ptrConnectedObjSides := FindConnObjSides(APointObject.ID, LineComponObject.ID); if ptrConnectedObjSides <> nil then begin if ptrConnectedObjSides.IDObj1 = LineComponObject.ID then LineComponSide := ptrConnectedObjSides.Side1 else if ptrConnectedObjSides.IDObj2 = LineComponObject.ID then LineComponSide := ptrConnectedObjSides.Side2; if LineComponSide <> -1 then begin Result := GetComponInterfacesBySide(ALineComponent, LineComponSide, biFalse); AlineComponSide := LineComponSide; end; end; end; begin Result := true; try WayObjects := TSCSCatalogs.Create(false); ObjectSidesList := Tlist.Create; SCSLineComponents := TSCSComponents.Create(false); try SCSList := nil; SCSObject := nil; PrevObj := nil; FirstPointObject := nil; LastPointObject := nil; FirstLineComponent := nil; LastLineComponent := nil; FirstLineComponentPos := -1; LastLineComponentPos := -1; FirstPointInterface := nil; LastPointInterface := nil; for i := 0 to AWay.Count - 1 do begin PrevObj := SCSObject; SCSObject := nil; if ASCSObjs <> nil then SCSObject := TSCSCatalog(ASCSObjs[i]) //08.11.2011 else SCSObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AWay[i]); if SCSObject = nil then begin CADObject := nil; if AFigures <> nil then CADObject := TObject(AFigures[i]) //08.11.2011 else CADObject := GetFigureByIDProj(AWay[i]); if CADObject <> nil then begin if (CADObject is TConnectorObject) and (TConnectorObject(CADObject).FHouse <> nil) and (TConnectorObject(CADObject).FHouse is THouse) then SCSObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TConnectorObject(CADObject).FHouse.ID); end; end; if Assigned(SCSObject) then begin if SCSList = nil then SCSList := SCSObject.GetListOwner; if SCSObject.ItemType = itSCSConnector then begin if i = 0 then FirstPointObject := SCSObject; if i = AWay.Count - 1 then LastPointObject := SCSObject; SCSObject.ReloadComponentReferences; end else if SCSObject.ItemType = itSCSLine then if SCSObject.LastAddedComponent <> nil then begin SCSLineComponents.Add(SCSObject.LastAddedComponent); if APosList <> nil then begin if i = 1 then FirstLineComponentPos := APosList[i]; if i = AWay.Count - 2 then LastLineComponentPos := APosList[i]; end; end; WayObjects.Add(SCSObject); //*** Узнать соединяемые стороны if Prevobj <> nil then begin //New(ptrConnObjSides); GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := PrevObj.ID; ptrConnObjSides.IDObj2 := SCSObject.ID; GetSidesByConnectedFigures(PrevObj.ListID, SCSObject.ListID, PrevObj.SCSID, SCSObject.SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); ObjectSidesList.Add(ptrConnObjSides); end; //*** Разрешить соединение компонентам for j := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSObject.ComponentReferences[j]; SCSCompon.DefineInterfCountToConnect; end; end; end; // End for //if FirstPointObject <> nil then // FirstPointInterface := GetInterfaceFromConnObjectByTrunkPos(FirstPointObject.GetListOwner, FirstPointObject, FirstLineComponentPos); // if LastPointObject <> nil then // LastPointInterface := GetInterfaceFromConnObjectByTrunkPos(LastPointObject.GetListOwner, LastPointObject, LastLineComponentPos); if SCSLineComponents.Count > 0 then begin FirstLineComponent := SCSLineComponents[0]; LastLineComponent := SCSLineComponents[SCSLineComponents.Count - 1]; end; ConnectKind := cnkVarious or cnkMaleMale; GConnectKind := ConnectKind; if (GEndPoint <> nil) and (FirstPointObject <> nil) then try if GEndPoint.ID = FirstPointObject.SCSID then begin ExchangeObjects(FirstPointObject, LastPointObject); ExchangeObjects(FirstLineComponent, LastLineComponent); ExchangeIntegers(FirstLineComponentPos, LastLineComponentPos); end; except end; //*** Подключение к конечным объектам по одинаковым портам с одинаковыми интерфейсами WasJoinedToEndPoints := false; //if (SCSList <> nil) and (Not SCSList.Setting.ControlJoinByNetType) then if (FirstPointObject <> nil) and (LastPointObject <> nil) and (FirstLineComponent <> nil) and (LastLineComponent <> nil) and (FirstLineComponent.GuidNB = LastLineComponent.GuidNB) {and (FirstPointInterface = nil) and (LastPointInterface = nil)} then // Не определены интерфейсы для подключения begin FirstLineComponentSide := -1; LastLineComponentSide := -1; //*** Найти свободные интерфейсы лин. компонент для подключения к точ. компон-м FirstLineComponentInterfaces := GetLineComponInterfacesForJoinToPoint(FirstLineComponent, FirstPointObject, FirstLineComponentSide); LastLineComponentInterfaces := GetLineComponInterfacesForJoinToPoint(LastLineComponent, LastPointObject, LastLineComponentSide); if (FirstLineComponentInterfaces <> nil) and (LastLineComponentInterfaces <> nil) then if CheckEqualInterfaces(FirstLineComponentInterfaces, LastLineComponentInterfaces, nil, nil, true, true) then begin //02.07.2013 - учитываем особый способ подключения, если среди объектов есть Бокс и Шкаф if aConsiderBoxAndRack then begin FirstPointCompon := nil; LastPointCompon := nil; FirstPointInterfaces := TSCSInterfaces.Create(false); LastPointInterfaces := TSCSInterfaces.Create(false); for i := 0 to FirstPointObject.ComponentReferences.Count - 1 do begin FirstPointCompon := FirstPointObject.ComponentReferences[i]; FirstPointTopCompon := FirstPointCompon.GetTopComponent; for j := 0 to LastPointObject.ComponentReferences.Count - 1 do begin LastPointCompon := LastPointObject.ComponentReferences[j]; LastPointTopCompon := LastPointCompon.GetTopComponent; FirstPointInterfaces.Clear; LastPointInterfaces.Clear; if (FirstPointTopCompon.ComponentType.SysName = ctsnCupboard) and (LastPointTopCompon.ComponentType.SysName = ctsnBox) then begin FirstPointCompon.GetInterfacesByIsPort(biFalse, false, -1, FirstPointInterfaces); //FirstPointInterfaces.Assign(FirstPointCompon.Interfaces); LastPointCompon.GetInterfacesByIsPort(biFalse, false, -1, LastPointInterfaces); // если бокс со шкафом, то берем только интерфейсы по боксу, порты не трогаем end else if (FirstPointTopCompon.ComponentType.SysName = ctsnBox) and (LastPointTopCompon.ComponentType.SysName = ctsnCupboard) then begin FirstPointCompon.GetInterfacesByIsPort(biFalse, false, -1, FirstPointInterfaces); // если бокс со шкафом, то берем только интерфейсы по боксу, порты не трогаем LastPointCompon.GetInterfacesByIsPort(biFalse, false, -1, LastPointInterfaces); //LastPointInterfaces.Assign(LastPointCompon.Interfaces); end else if FirstPointTopCompon.ComponentType.SysName = ctsnBox then begin FirstPointCompon.GetInterfacesByIsPort(biTrue, false, -1, FirstPointInterfaces); // если бокс c компонентом (не ШК), то берем только порты по боксу, интерфейсы не трогаем LastPointInterfaces.Assign(LastPointCompon.Interfaces); end else if LastPointTopCompon.ComponentType.SysName = ctsnBox then begin LastPointCompon.GetInterfacesByIsPort(biTrue, false, -1, LastPointInterfaces); // если бокс c компонентом (не ШК), то берем только порты по боксу, интерфейсы не трогаем FirstPointInterfaces.Assign(FirstPointCompon.Interfaces); end else //05.08.2013 - Если нету через бокс, то берем только по интерфейсам begin FirstPointInterfaces.Assign(FirstPointCompon.Interfaces); LastPointInterfaces.Assign(LastPointCompon.Interfaces); end; if FirstPointInterfaces.Count > 0 then if LastPointInterfaces.Count > 0 then if FirstPointCompon.CheckJoinTo(FirstLineComponent, 0, FirstLineComponentSide, false, FirstPointInterfaces, FirstLineComponentInterfaces).CanConnect then if LastPointCompon.CheckJoinTo(LastLineComponent, 0, LastLineComponentSide, false, LastPointInterfaces, LastLineComponentInterfaces).CanConnect then begin MaxInterfCountToConnect := -1; FirstPointCompon.JoinTo(FirstLineComponent, 0, FirstLineComponentSide, false, FirstPointInterfaces, FirstLineComponentInterfaces, MaxInterfCountToConnect); LastPointCompon.JoinTo(LastLineComponent, 0, LastLineComponentSide, false, LastPointInterfaces, LastLineComponentInterfaces, MaxInterfCountToConnect); WasJoinedToEndPoints := true; Break; //// BREAK //// end; end; if WasJoinedToEndPoints then Break; //// BREAK //// end; FreeAndNil(FirstPointInterfaces); FreeAndNil(LastPointInterfaces); WasJoinedToEndPoints := true; //02.07.2013 - чтобы не пытались подключить к точечным end else begin FirstPointPort := nil; LastPointPort := nil; FirstPointPort := GetCatalogPortByAnalogInterfaces(FirstPointObject, nil, FirstLineComponentInterfaces, TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceConnectOrder, TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne); if FirstPointPort <> nil then LastPointPort := GetCatalogPortByAnalogInterfaces(LastPointObject, FirstPointPort, LastLineComponentInterfaces, TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceConnectOrder, TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne); //*** Если нет портов, чтобы интерфейсы совпадали точ в точ, ищем порты, интерфейсы которых совпадают по максимуму if (FirstPointPort = nil) or (LastPointPort = nil) then if TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne then GetCatalogsEqualPortsByAnalogInterfaces(FirstPointObject, LastPointObject, FirstLineComponentInterfaces, FirstPointPort, LastPointPort); //*** Подключение возможно по портам if (FirstPointPort <> nil) and (LastPointPort <> nil) then begin FirstPointPortInterfCount := GetEmptyInterfCountFromPort(FirstPointPort); LastPointPortInterfCount := GetEmptyInterfCountFromPort(LastPointPort); //*** Определить порт с большим количеством интерфейсов MaxInterfCountToConnect := -1; if TF_Main(GForm).GSCSBase.CurrProject.Setting.TraceOnePortToOne then begin if FirstPointPortInterfCount <> LastPointPortInterfCount then begin if CheckPortNoHaveBusyInterfaces(FirstPointPort) and CheckPortNoHaveBusyInterfaces(LastPointPort) then begin if FirstPointPortInterfCount < LastPointPortInterfCount then MaxInterfCountToConnect := FirstPointPortInterfCount else if FirstPointPortInterfCount > LastPointPortInterfCount then MaxInterfCountToConnect := LastPointPortInterfCount; end; end else MaxInterfCountToConnect := FirstPointPortInterfCount; end; if FirstPointPort.ComponentOwner.CheckJoinTo(FirstLineComponent, 0, FirstLineComponentSide, false, FirstPointPort.PortInterfaces, FirstLineComponentInterfaces).CanConnect and LastPointPort.ComponentOwner.CheckJoinTo(LastLineComponent, 0, LastLineComponentSide, false, LastPointPort.PortInterfaces, LastLineComponentInterfaces).CanConnect then begin FirstPointPort.ComponentOwner.JoinTo(FirstLineComponent, 0, FirstLineComponentSide, false, FirstPointPort.PortInterfaces, FirstLineComponentInterfaces, MaxInterfCountToConnect); LastPointPort.ComponentOwner.JoinTo(LastLineComponent, 0, LastLineComponentSide, false, LastPointPort.PortInterfaces, LastLineComponentInterfaces, MaxInterfCountToConnect); WasJoinedToEndPoints := true; end; end; end; end; if FirstLineComponentInterfaces <> nil then FreeAndNil(FirstLineComponentInterfaces); if LastLineComponentInterfaces <> nil then FreeAndNil(LastLineComponentInterfaces); end; //*** Соединять только линейные компоненты, или с первым/последним точечным CurrObj := nil; PrevObj := nil; PrevPrevObj := nil; for i := 0 to WayObjects.Count - 1 do begin PrevPrevObj := PrevObj; PrevObj := nil; PrevObj := CurrObj; CurrObj := nil; CurrObj := WayObjects[i]; if PrevObj <> nil then begin if ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) or // только две линии ((Not WasJoinedToEndPoints) and (PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) and (i=1)) or // первый точечный и линия ((Not WasJoinedToEndPoints) and (PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSConnector) and (i=WayObjects.Count-1)) // Последний точечный и линия then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); if ptrConnObjSides <> nil then begin //WasConnect := ConnectWayObjects(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2); WasConnect := ConnectObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true); if (Result = true) and Not(WasConnect) then Result := false; end; end; if PrevPrevObj <> nil then if (PrevPrevObj.ItemType = itSCSLine) and (PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) then begin ptrPrevConnObjSides := FindConnObjSides(PrevPrevObj.ID, PrevObj.ID); ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); if ptrConnObjSides <> nil then begin WasConnect := ConnectObjectCompons(PrevPrevObj, CurrObj, ptrPrevConnObjSides.Side1, ptrConnObjSides.Side2, true); if (Result = true) and Not(WasConnect) then Result := false; end; end; end; end; //*** Соединять остатки CurrObj := nil; PrevObj := nil; for i := 0 to WayObjects.Count - 1 do begin PrevObj := CurrObj; CurrObj := WayObjects[i]; if PrevObj <> nil then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); if ptrConnObjSides <> nil then begin if WasJoinedToEndPoints and ((i = 1) or (i=WayObjects.Count-1)) then Continue; //// CONTINUE //// WasConnect := ConnectObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true); if (Result = true) and Not(WasConnect) then Result := false; end; end; end; finally WayObjects.Free; Freelist(ObjectSidesList); //ClearList(AWay); SCSLineComponents.Free; end; TF_Main(GForm).GSCSBase.CurrProject.FinishMarkingCompons; { try SCSObject := nil; PrevObj := nil; for i := 0 to AWay.Count - 1 do begin PrevObj := SCSObject; SCSObject := nil; SCSObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(Integer(AWay[i]^)); if Assigned(SCSObject) then begin WayObjects.Add(SCSObject); //*** Узнать соединяемые стороны if Prevobj <> nil then begin //New(ptrConnObjSides); GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := PrevObj.ID; ptrConnObjSides.IDObj2 := SCSObject.ID; GetSidesByConnectedFigures(PrevObj.ListID, SCSObject.ListID, PrevObj.SCSID, SCSObject.SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); ObjectSidesList.Add(ptrConnObjSides); end; //*** Разрешить соединение компонентам for j := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSObject.ComponentReferences[j]; SCSCompon.DefineInterfCountToConnect; end; end; end; ConnectKind := cnkVarious or cnkMaleMale; GConnectKind := ConnectKind; //*** Соединять только линейные компоненты, или с первым/последним точечным CurrObj := nil; PrevObj := nil; PrevPrevObj := nil; for i := 0 to WayObjects.Count - 1 do begin PrevPrevObj := PrevObj; PrevObj := nil; PrevObj := CurrObj; CurrObj := nil; CurrObj := WayObjects[i]; if PrevObj <> nil then begin if ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) or // только две линии ((PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) and (i=1)) or // первый точечный и линия ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSConnector) and (i=WayObjects.Count-1)) // Последний точечн_й и линия then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); if ptrConnObjSides <> nil then begin //WasConnect := ConnectWayObjects(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2); WasConnect := ConnectObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2); if (Result = true) and Not(WasConnect) then Result := false; end; end; if PrevPrevObj <> nil then if (PrevPrevObj.ItemType = itSCSLine) and (PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) then begin ptrPrevConnObjSides := FindConnObjSides(PrevPrevObj.ID, PrevObj.ID); ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); if ptrConnObjSides <> nil then begin WasConnect := ConnectObjectCompons(PrevPrevObj, CurrObj, ptrPrevConnObjSides.Side1, ptrConnObjSides.Side2); if (Result = true) and Not(WasConnect) then Result := false; end; end; end; end; //*** Соединять остатки CurrObj := nil; PrevObj := nil; for i := 0 to WayObjects.Count - 1 do begin PrevObj := CurrObj; CurrObj := WayObjects[i]; if PrevObj <> nil then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); if ptrConnObjSides <> nil then begin WasConnect := ConnectObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2); if (Result = true) and Not(WasConnect) then Result := false; end; end; end; finally WayObjects.Free; Freelist(ObjectSidesList); ClearList(AWay); end; } except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.ConnectObjectsByWay: '+E.Message); end; end; function TF_ChoiceConnectSide.JoinWithDefineSides(AComponent1, AComponent2: TSCSComponent; ACheck: Boolean; ACompon1Interfaces: TSCSInterfaces = nil; ACompon2Interfaces: TSCSInterfaces = nil; ACanWithNoInterfaces: Boolean = false): TConnectInterfRes; var Side1: Integer; Side2: Integer; SCSObject1: TSCSCatalog; SCSObject2: TSCSCatalog; begin ZeroMemory(@Result, SizeOf(TConnectInterfRes)); Side1 := -1; Side2 := -1; SCSObject1 := AComponent1.GetFirstParentCatalog; SCSObject2 := AComponent2.GetFirstParentCatalog; if (SCSObject1 <> nil) and (SCSObject2 <> nil) then GetSidesByConnectedFigures(SCSObject1.ListID, SCSObject2.ListID, SCSObject1.SCSID, SCSObject2.SCSID, Side1, Side2); if (Side1 <> -1) and (Side2 <> -1) then begin if Not ACanWithNoInterfaces then begin if ACheck then Result := AComponent1.CheckJoinTo(AComponent2, Side1, Side2, true, ACompon1Interfaces, ACompon2Interfaces) else Result := AComponent1.JoinTo(AComponent2, Side1, Side2, true, ACompon1Interfaces, ACompon2Interfaces); end else begin if ACheck then Result := AComponent1.CheckJoinTo(AComponent2, Side1, Side2, true, ACompon1Interfaces, ACompon2Interfaces, ACanWithNoInterfaces) else Result := AComponent1.JoinTo(AComponent2, Side1, Side2, true, ACompon1Interfaces, ACompon2Interfaces, -1, true, ACanWithNoInterfaces); end; end; end; procedure TF_ChoiceConnectSide.JoinConnectorWithLines(AConnector: TSCSCatalog; AComponentFromConnector: TSCSComponent; ALineComponsFromTraces: TSCSComponents); var SCSComponent: TSCSComponent; LineFigureIDs: TIntList; LineObject: TSCSCatalog; i, j, k, l: Integer; Side1: Integer; Side2: Integer; // Tolik LineCatalogList: TList; currCatalog, nextCatalog: TSCSCatalog; currCompon, JoinedCompon: TSCSComponent; DisJoined: Boolean; Connected: Boolean; // tolik 29/10/2019 -- begin if AComponentFromConnector <> nil then begin AComponentFromConnector.ServCanConnect := true; for i := 0 to AComponentFromConnector.ChildReferences.Count - 1 do begin SCSComponent := AComponentFromConnector.ChildReferences[i]; SCSComponent.ServCanConnect := true; end; end else SetObjectComponAsCanToJoin(AConnector, true); if ALineComponsFromTraces <> nil then for i := 0 to ALineComponsFromTraces.Count - 1 do begin SCSComponent := ALineComponsFromTraces[i]; if SCSComponent.IsLine = biTrue then SCSComponent.ServCanConnect := true; end; LineFigureIDs := GetConnectedTracesToConnetorByID(AConnector.ListID, AConnector.SCSID); //Tolik if F_PEAutoTraceDialog.FromAutoTraceDialog and F_PEAutoTraceDialog.IgnoreExistingCable.Visible and F_PEAutoTraceDialog.IgnoreExistingCable.Checked then begin if LineFigureIDs.Count > 0 then begin LineCatalogList := TList.Create; for i := 0 to LineFigureIds.Count - 1 do begin currCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(LineFigureIDs[i]); if currCatalog <> nil then LineCatalogList.Add(currCatalog); end; if LineCatalogList.Count > 1 then begin for i := 0 to LineCatalogList.Count - 2 do begin currCatalog := TSCSCatalog(LineCatalogList[i]); for l := i to LineCatalogList.Count - 2 do begin nextCatalog := TSCSCatalog(LineCatalogList[l+1]); DisJoined := False; for j := 0 to currCatalog.ComponentReferences.Count - 1 do begin currCompon := currCatalog.ComponentReferences[j]; if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(currCompon.id) <> -1 then begin DisJoined := True; While DisJoined do begin DisJoined := False; for k := 0 to currCompon.JoinedComponents.Count - 1 do begin JoinedCompon := TSCSComponent(currCompon.JoinedComponents[k]); if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(JoinedCompon.ID) <> - 1 then begin if nextCatalog.ComponentReferences.IndexOf(JoinedCompon) <> - 1 then begin DisJoined := currCompon.DisJoinFrom(JoinedCompon); end; if DisJoined then break; end; end; end; end; end; end; end; end; end; end; for i := 0 to LineFigureIDs.Count - 1 do begin LineObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(LineFigureIDs[i]); if LineObject <> nil then begin GetSidesByConnectedFigures(AConnector.ListID, LineObject.ListID, AConnector.SCSID, LineObject.SCSID, Side1, Side2); if ALineComponsFromTraces = nil then SetObjectComponAsCanToJoin(LineObject, true); // Tolik 29/10/2019 -- //ConnectObjectCompons(AConnector, LineObject, Side1, Side2, false); Connected := ConnectObjectCompons(AConnector, LineObject, Side1, Side2, false); // end; end; LineFigureIDs.free; // Tolik 15/05/2018-- end; procedure TF_ChoiceConnectSide.JoinLineWithJoinedObjects(ALineObject: TSCSCatalog); var IDConnSide1: Integer; IDConnSide2: Integer; SCSConnObject: TSCSCatalog; begin IDConnSide1 := 0; IDConnSide2 := 0; GetConnObjectsByLine(ALineObject.ListID, ALineObject.SCSID, IDConnSide1, IDConnSide2); SetObjectComponAsCanToJoin(ALineObject, true); if IDConnSide1 > 0 then begin SCSConnObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(IDConnSide1); if SCSConnObject <> nil then begin SetObjectComponAsCanToJoin(SCSConnObject, true); ConnectObjectCompons(ALineObject, SCSConnObject, 1, 0, false); end; end; if IDConnSide2 > 0 then begin SCSConnObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(IDConnSide2); if SCSConnObject <> nil then begin SetObjectComponAsCanToJoin(SCSConnObject, true); ConnectObjectCompons(ALineObject, SCSConnObject, 2, 0, false); end; end; end; procedure TF_ChoiceConnectSide.SetObjectComponAsCanToJoin(ASCSObject: TSCSCatalog; ACanToJoin: Boolean); var i: Integer; begin for i := 0 to ASCSObject.ComponentReferences.Count - 1 do ASCSObject.ComponentReferences[i].ServCanConnect := ACanToJoin; end; // ##### Добавляет Лин. компонент на спуск/подъем и соединяет его #### //Tolik // а также используется при разделении линии для дублирования и подключения компонент // //Tolik 26/09/2018 -- { function TF_ChoiceConnectSide.AutoConnectOverRaiseLine(APointObjectID: Integer; ARaiseLineID: Integer; AJoinedBeforeRaise, AJoinedAfterRaise: TList; ALineType: TLineType): Boolean; } function TF_ChoiceConnectSide.AutoConnectOverRaiseLine(APointObjectID: Integer; ARaiseLineID: Integer; AJoinedBeforeRaise, AJoinedAfterRaise: TList; ALineType: TLineType; aNoCopyList: TList = nil): Boolean; // var {ConnectCatalogList: TSCSCatalogs; ConnectConponCount: Integer; ConnectCatalog: TSCSCatalog; RaizeLineObject: TSCSCatalog; ConnectCompon: TSCSComponent; //PointCompon: TSCSComponent; //IDPointObj: Integer; PointObject: TSCSCatalog; i, j: Integer; //ConnectInterfRes: TConnectInterfRes; LineObjNumSide: Integer;} JoinedBeforeRaise: TSCSCatalogs; JoinedAfterRaise: TSCSCatalogs; BeforeObject: TSCSCatalog; PointObject: TSCSCatalog; AfterObject: TSCSCatalog; RaiseObject: TSCSCatalog; BeforeObjectSide: Integer; AfterObjectSide: Integer; RaiseObjectFromBeforeSide: Integer; RaiseObjectFromAfterSide: Integer; BeforeComponent: TSCSComponent; AfterComponent: TSCSComponent; SrcComponentForCopyToRaise: TSCSComponent; IDRaiseComponent: Integer; RaiseComponent: TSCSComponent; HereCreatedRaiseComponent: Boolean; SrcComponents: TSCSComponents; SrcComponent: TSCSComponent; SrcParentComponent: TSCSComponent; NewComponents: TSCSComponents; NewComponent: TSCSComponent; NewParentComponent: TSCSComponent; NewComponObjectOwner: TSCSCatalog; ComponIndex: Integer; ParentCompon: TSCSComponent; ObjectsToConnect1: TList; ObjectsToConnect2: TList; ptrConnectObjectParam: PConnectObjectParam; PointObjectSide: Integer; RaiseObjectSide: Integer; i, j, k, l, m: Integer; ComponToDelete: Boolean; // Tolik BeforeComponentParent: TSCSCatalog; TmpComponent: TSCSComponent; CanNotCopyCompon: Boolean; // function GetObjectListByParams(AObjectListParams: TList): TSCSCatalogs; var i: Integer; SCSCatalog: TSCSCatalog; ptrObjectParam: PConnectObjectParam; begin Result := TSCSCatalogs.Create(false); for i := 0 to AObjectListParams.Count - 1 do begin ptrObjectParam := AObjectListParams[i]; SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ptrObjectParam.IDObject); if SCSCatalog <> nil then Result.Add(SCSCatalog); end; end; begin Result := false; try RaiseObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ARaiseLineID); if (RaiseObject = nil) or (RaiseObject.ItemType = itSCSConnector) then Exit; ///// EXIT ///// SrcComponents := TSCSComponents.Create(false); NewComponents := TSCSComponents.Create(false); JoinedBeforeRaise := GetObjectListByParams(AJoinedBeforeRaise); JoinedAfterRaise := GetObjectListByParams(AJoinedAfterRaise); try //13.11.2008 // Если идет раздиление линии, позаботится чтоб был первый цыкл в котором будут копироваться линейные компоненты в новую трассу //13.11.2008 if ALineType = ltTrace then //13.11.2008 if (JoinedAfterRaise.Count = 0) or Not CheckIsLineObjectInList(JoinedAfterRaise, true) then //13.11.2008 ExchangeObjects(JoinedAfterRaise, JoinedBeforeRaise); //*** добавить точ объект в список объектов перед сп PointObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(APointObjectID); BeforeObject := PointObject; if BeforeObject <> nil then JoinedBeforeRaise.Add(BeforeObject); for i := 0 to JoinedAfterRaise.Count - 1 do begin AfterObject := JoinedAfterRaise[i]; AfterObjectSide := -1; RaiseObjectFromBeforeSide := -1; RaiseObjectFromAfterSide := -1; AfterObject.ReloadComponentReferences; for j := 0 to AfterObject.ComponentReferences.Count - 1 do begin AfterComponent := AfterObject.ComponentReferences[j]; RaiseComponent := nil; // Tolik 26/09/2018 -- чтобы не скопировать ранее восстановленные кабельные соединения при разделении трасс ы на снапе, например... CanNotCopyCompon := False; if aNoCopyList <> nil then CanNotCopyCompon := (aNoCopyList.IndexOf(AfterComponent) <> -1); if CanNotCopyCompon then Continue; // ComponToDelete := AfterComponent.ServToDelete; if not ComponToDelete then begin if (AfterComponent.ComponentType.SysName = ctsnCableChannelAccessory) or (AfterComponent.ComponentType.SysName = ctsnAccessory) then begin parentCompon := AfterComponent.GetParentComponent; while parentCompon <> nil do begin if ParentCompon.ServToDelete then begin ComponToDelete := True; break; end; parentCompon := ParentCompon.GetParentComponent; end; end; end; if not ComponToDelete then begin if AfterComponent.JoinedComponents.Count > 0 then begin for k := 0 to JoinedBeforeRaise.Count - 1 do begin BeforeObject := JoinedBeforeRaise[k]; BeforeObjectSide := -1; for l := 0 to BeforeObject.ComponentReferences.Count - 1 do begin BeforeComponent := BeforeObject.ComponentReferences[l]; //*** Если компоненты, между которыми врезется СП, соединены, то вкинуть соединение if AfterComponent.JoinedComponents.IndexOf(BeforeComponent) <> -1 then begin HereCreatedRaiseComponent := false; //*** Вкинуть компонент на спуск/подъем if RaiseComponent = nil then begin SrcComponentForCopyToRaise := nil; if AfterComponent.Isline = biTrue then SrcComponentForCopyToRaise := AfterComponent else if BeforeComponent.IsLine = biTrue then SrcComponentForCopyToRaise := BeforeComponent; if (SrcComponentForCopyToRaise <> nil) {and (SrcComponentForCopyToRaise.ComponentType.SysName <> ctsnCableChannel)} then begin //RaiseComponent := CopyComponentToPMSCSObject(SrcComponentForCopyToRaise, RaiseObject, true); RaiseComponent := CopyComponentToPMSCSObject(SrcComponentForCopyToRaise, RaiseObject, false); if RaiseComponent <> nil then begin SrcComponents.Add(SrcComponentForCopyToRaise); NewComponents.Add(RaiseComponent); end; { Копирует из НБ - для теста if RaiseObject.TreeViewNode = nil then TF_Main(GForm).FindComponOrDirInTree(RaiseObject.ID, false); if RaiseObject.TreeViewNode <> nil then begin IDRaiseComponent := TF_Main(GForm).CopyComponentFromNbToPm(F_NormBase, GForm, RaiseObject.TreeViewNode, SrcComponentForCopyToRaise.IDNormBase, ckCompon); if IDRaiseComponent > 0 then RaiseComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(IDRaiseComponent); end;} {if RaiseObject.TreeViewNode = nil then TF_Main(GForm).FindComponOrDirInTree(RaiseObject.ID, false); if RaiseObject.TreeViewNode <> nil then begin IDRaiseComponent := TF_Main(GForm).CopyComponentFromNbToPm(GForm, GForm, RaiseObject.TreeViewNode, SrcComponentForCopyToRaise.id, ckCompon); if IDRaiseComponent > 0 then RaiseComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(IDRaiseComponent); end;} end; HereCreatedRaiseComponent := true; {//*** Подключить вкинутый компонент на новую трассу к линейн. компоненте от кот. идет новая трасса if RaiseComponent <> nil then begin if then if then end; } end; if RaiseComponent <> nil then begin if (BeforeObjectSide = -1) or (RaiseObjectFromBeforeSide = -1) or (RaiseObjectFromAfterSide = -1) or (AfterObjectSide = -1) then begin GetSidesByConnectedFigures(BeforeObject.ListID, RaiseObject.ListID, BeforeObject.SCSID, RaiseObject.SCSID, BeforeObjectSide, RaiseObjectFromBeforeSide); GetSidesByConnectedFigures(RaiseObject.ListID, AfterObject.ListID, RaiseObject.SCSID, AfterObject.SCSID, RaiseObjectFromAfterSide, AfterObjectSide); end; if (BeforeObjectSide <> -1) and (RaiseObjectFromBeforeSide <> -1) and (RaiseObjectFromAfterSide <> -1) and (AfterObjectSide <> -1) then begin // Tolik 21/03/2016 -- соединение может быть и не одно ... если не сбросить все соединения // всех компонент объекта от разделяемого кабеля, то не получим цельного соединения кабелей // в точке разделения BeforeComponentParent := BeforeComponent.GetFirstParentCatalog; for m := 0 to BeforeComponentParent.ComponentReferences.Count - 1 do begin TmpComponent := BeforeComponentParent.ComponentReferences[m]; if TmpComponent <> BeforeComponent then begin if TmpComponent.JoinedComponents.IndexOf(AfterComponent) <> -1 then TmpComponent.DisJoinFrom(AfterComponent); end; end; // if BeforeComponent.DisJoinFrom(AfterComponent) then begin RaiseComponent.JoinTo(BeforeComponent, RaiseObjectFromBeforeSide, BeforeObjectSide, true); if HereCreatedRaiseComponent then AfterComponent.JoinTo(RaiseComponent, AfterObjectSide, RaiseObjectFromAfterSide, true); Result := true; end; end; end; end; end; end; end; //*** Если идет разделение трассы (не создагие СП), докинуть компоненты в новую трассу if ALineType = ltTrace then begin if ((AfterComponent.IsLine = biTrue) or (AfterComponent.ComponentType.SysName = ctsnCableChannelAccessory) or (AfterComponent.ComponentType.SysName = ctsnAccessory) ) and (RaiseComponent = nil) then begin RaiseComponent := CopyComponentToPMSCSObject(AfterComponent, RaiseObject, false); //*** Попытаться подключить if RaiseComponent <> nil then begin SrcComponents.Add(AfterComponent); NewComponents.Add(RaiseComponent); GetSidesByConnectedFigures(RaiseObject.ListID, AfterObject.ListID, RaiseObject.SCSID, AfterObject.SCSID, RaiseObjectFromAfterSide, AfterObjectSide); if (RaiseObjectFromAfterSide <> -1) and (AfterObjectSide <> -1) then begin AfterComponent.JoinTo(RaiseComponent, AfterObjectSide, RaiseObjectFromAfterSide, true); Result := true; end; end; end; end; end; end; GCheckAccessory := True; // Восстанавливаем порядок комплектации if ALineType = ltTrace then if AfterObject.IsLine = biTrue then begin for j := 0 to AfterObject.ComponentReferences.Count - 1 do begin SrcComponent := AfterObject.ComponentReferences[j]; NewComponent := nil; ComponIndex := SrcComponents.IndexOf(SrcComponent); if ComponIndex <> -1 then NewComponent := NewComponents[ComponIndex]; if NewComponent <> nil then begin // Если новый компонент находится в компоненте, а должен быть в объекте if (SrcComponent.Parent is TSCSCatalog) and (NewComponent.Parent is TSCSComponent) then begin NewComponObjectOwner := NewComponent.GetFirstParentCatalog; if NewComponObjectOwner <> nil then begin NewComponent.DisConnectFromParent; NewComponObjectOwner.AddComponentToCatRel(NewComponent); end; end else // Если новый компонент находится в компоненте, то проверить, верна ли эта компонента if (SrcComponent.Parent is TSCSComponent){ and (NewComponent.Parent is TSCSComponent)} then begin SrcParentComponent := SrcComponent.GetParentComponent; NewParentComponent := nil; ComponIndex := SrcComponents.IndexOf(SrcParentComponent); if ComponIndex <> -1 then NewParentComponent := NewComponents[ComponIndex]; if (NewParentComponent <> nil) and (NewComponent <> NewParentComponent) then begin NewComponent.DisConnectFromParent; if NewParentComponent.ComplectWith(NewComponent, -1, true) = nil then begin NewComponObjectOwner := NewParentComponent.GetFirstParentCatalog; if NewComponObjectOwner <> nil then NewComponObjectOwner.AddComponentToCatRel(NewComponent); end; end; end; end; end; end; end; // Если идет раздиление линии коннетором - подключаем остальные компоненты объектов if ALineType = ltTrace then if (AJoinedBeforeRaise.Count > 0) {or (AJoinedAfterRaise.Count > 0)} then begin ObjectsToConnect1 := GetCopyConnectObjectParams(AJoinedBeforeRaise); //ObjectsToConnect2 := GetCopyConnectObjectParams(AJoinedAfterRaise); //ObjectsToConnect1.Assign(ObjectsToConnect2, laOr); //ObjectsToConnect2.Clear; ObjectsToConnect2 := TList.Create; GetSidesByConnectedFigures(PointObject.ListID, RaiseObject.ListID, PointObject.SCSID, RaiseObject.SCSID, PointObjectSide, RaiseObjectSide); GetZeroMem(ptrConnectObjectParam, SizeOf(TConnectObjectParam)); ptrConnectObjectParam.IDObject := PointObject.SCSID; ptrConnectObjectParam.Side := PointObjectSide; ObjectsToConnect2.Add(ptrConnectObjectParam); GetZeroMem(ptrConnectObjectParam, SizeOf(TConnectObjectParam)); ptrConnectObjectParam.IDObject := RaiseObject.SCSID; ptrConnectObjectParam.Side := RaiseObjectSide; ObjectsToConnect2.Add(ptrConnectObjectParam); ConnectObjects(ObjectsToConnect1, ObjectsToConnect2); FreeList(ObjectsToConnect1); FreeList(ObjectsToConnect2); end; //------------------------------- { for i := 0 to JoinedBeforeRaise.Count - 1 do begin BeforeObject := JoinedBeforeRaise[i]; //if BeforeObject.ItemType = itSCSLine then // BeforeObjectSide := /GetNumSideByObject(BeforeCatalog, AJoinedBeforeRaise) //else // BeforeObjectSide := 0; BeforeObjectSide := -1; for j := 0 to BeforeObject.ComponentReferences.Count - 1 do begin BeforeComponent := BeforeObject.ComponentReferences[j]; if BeforeComponent.JoinedComponents.Count > 0 then for k := 0 to JoinedAfterRaise.Count - 1 do begin AfterObject := JoinedAfterRaise[k]; AfterObjectSide := -1; //GetNumSideByObject(AfterObject, AJoinedAfterRaise); RaiseObjectFromBeforeSide := -1; RaiseObjectFromAfterSide := -1; for l := 0 to AfterObject.ComponentReferences.Count - 1 do begin AfterComponent := AfterObject.ComponentReferences[l]; //*** Если компоненты, между которыми врезется СП, соединены, то вкинуть соединение if BeforeComponent.JoinedComponents.IndexOf(AfterComponent) <> -1 then begin RaiseComponent := nil; //*** Вкинуть компонент на спуск/подъем SrcComponentForCopyToRaise := nil; if AfterComponent.Isline = biTrue then SrcComponentForCopyToRaise := AfterComponent else if BeforeComponent.IsLine = biTrue then SrcComponentForCopyToRaise := BeforeComponent; if SrcComponentForCopyToRaise <> nil then begin if RaiseObject.TreeViewNode = nil then TF_Main(GForm).FindComponOrDirInTree(RaiseObject.ID, false); if RaiseObject.TreeViewNode <> nil then begin IDRaiseComponent := TF_Main(GForm).CopyComponentFromNbToPm(GForm, GForm, RaiseObject.TreeViewNode, SrcComponentForCopyToRaise.id, ckCompon); if IDRaiseComponent > 0 then RaiseComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(IDRaiseComponent); end; end; //*** Разъединить компонент BeforeComponent с AfterComponent, и соединить их с RaiseComponent if RaiseComponent <> nil then begin if (BeforeObjectSide = -1) or (RaiseObjectFromBeforeSide = -1) or (RaiseObjectFromAfterSide = -1) or (AfterObjectSide = -1) then begin GetSidesByConnectedFigures(RaiseObject.ListID, AfterObject.ListID, RaiseObject.SCSID, AfterObject.SCSID, RaiseObjectFromAfterSide, AfterObjectSide); GetSidesByConnectedFigures(BeforeObject.ListID, RaiseObject.ListID, BeforeObject.SCSID, RaiseObject.SCSID, BeforeObjectSide, RaiseObjectFromBeforeSide); end; if (BeforeObjectSide <> -1) and (RaiseObjectFromBeforeSide <> -1) and (RaiseObjectFromAfterSide <> -1) and (AfterObjectSide <> -1) then begin if BeforeComponent.DisJoinFrom(AfterComponent) then begin AfterComponent.JoinTo(RaiseComponent, AfterObjectSide, RaiseObjectFromAfterSide); RaiseComponent.JoinTo(BeforeComponent, RaiseObjectFromBeforeSide, BeforeObjectSide); Result := true; end; end; end; end; end; end; end; end;} finally GCheckAccessory := False; FreeAndNil(JoinedBeforeRaise); FreeAndNil(JoinedAfterRaise); FreeAndNil(SrcComponents); FreeAndNil(NewComponents); end; (* PointObject := nil; RaizeLineObject := nil; ConnectCatalogList := nil; PointObject := nil; ConnectCatalogList := GetCatalogList(AConnectedLines, ConnectConponCount); if ConnectCatalogList = nil then Exit; ///// EXIT ////// PointObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(APointObjectID); RaizeLineObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ARaiseLineID); if Assigned(PointObject) then for i := 0 to ConnectCatalogList.Count - 1 do begin ConnectCatalog := ConnectCatalogList[i]; LineObjNumSide := GetNumSideByObject(ConnectCatalog, AConnectedLines); for j := 0 to ConnectCatalog.SCSComponents.Count - 1 do if Assigned(ConnectCatalog.SCSComponents[j]) then begin ConnectCompon := ConnectCatalog.SCSComponents[j]; if Assigned(RaizeLineObject) then if Assigned(RaizeLineObject.TreeViewNode) then TF_Main(GForm).CopyComponentFromNbToPm(GForm, GForm, RaizeLineObject.TreeViewNode, ConnectCompon.ID, ckCompon, false); //CopyComponentToSCSObject(ARaiseLineID, ConnectCompon.IDNormBase); { for k := 0 to PointObject.ComponentReferences.Count - 1 do if Assigned(PointObject.ComponentReferences[k]) then begin PointCompon := PointObject.ComponentReferences[k]; if (PointCompon.ID > 0) and (PointCompon.HaveInterfaceByType(itFunctional)) then begin ConnectInterfRes := ConnectInterfaces(ConnectCompon, PointCompon, LineObjNumSide, -1, cnkVarious or cnkMaleMale, false, smtNone, true); if ConnectInterfRes.CanConnect then begin CopyComponentToSCSObject(ARaiseLineID, ConnectCompon.IDNormBase); //ConnectCompon.Clear; //PointCompon.Clear; Break; ///// BREAK ///// end; end; end; // End for k/> } end; // End for j/> end; // End for i/> *) except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.AutoConnectOverRaiseLine: '+E.Message); end; end; function TF_ChoiceConnectSide.AutoDisconnectOverRaiseLine(ARaiseLineID: Integer; AJoinedBeforeRaise, AJoinedAfterRaise: TList): Boolean; var BeforeRaiseObjects: TSCSCatalogs; AfterRaiseObjects: TSCSCatalogs; BeforeObject: TSCSCatalog; AfterObject: TSCSCatalog; RaiseObject: TSCSCatalog; BeforeObjectSide: Integer; AfterObjectSide: Integer; RaiseObjectFromBeforeSide: Integer; RaiseObjectFromAfterSide: Integer; BeforeComponent: TSCSComponent; AfterComponent: TSCSComponent; SrcComponentForCopyToRaise: TSCSComponent; IDRaiseComponent: Integer; RaiseComponent: TSCSComponent; JoinedToBeforeComponent: TSCSComponent; JoinedToAfterComponent: TSCSComponent; JoinedRaiseComponent: TSCSComponent; JoinedToRaiseBeforeComponents: TSCSComponents; JoinedToRaiseAfterComponents: TSCSComponents; IsDeletedRaiseComponent: Boolean; i, j, k, l: Integer; function GetObjectListByParams(AObjectListParams: TList): TSCSCatalogs; var i: Integer; SCSCatalog: TSCSCatalog; ptrObjectParam: PConnectObjectParam; begin Result := TSCSCatalogs.Create(false); for i := 0 to AObjectListParams.Count - 1 do begin ptrObjectParam := AObjectListParams[i]; SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ptrObjectParam.IDObject); if SCSCatalog <> nil then Result.Add(SCSCatalog); end; end; procedure DefineJoinedComponentsByJoinedObjects(ATargetJoinedComponents: TSCSComponents; ASourceComponent: TSCSComponent; AJoinedObjects: TSCSCatalogs); var i: Integer; JoinedComponent: TSCSComponent; JoinedOwner: TSCSCatalog; begin ATargetJoinedComponents.Clear; for i := 0 to ASourceComponent.JoinedComponents.Count - 1 do begin JoinedComponent := ASourceComponent.JoinedComponents[i]; JoinedOwner := JoinedComponent.GetFirstParentCatalog; if (JoinedOwner <> nil) and (AJoinedObjects.IndexOf(JoinedOwner) <> -1) then ATargetJoinedComponents.Add(JoinedComponent); end; end; begin Result := false; RaiseObject := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ARaiseLineID); if (RaiseObject = nil) or (RaiseObject.ItemType = itSCSConnector) then Exit; ///// EXIT ///// BeforeRaiseObjects := GetObjectListByParams(AJoinedBeforeRaise); AfterRaiseObjects := GetObjectListByParams(AJoinedAfterRaise); JoinedToRaiseBeforeComponents := TSCSComponents.Create(false); JoinedToRaiseAfterComponents := TSCSComponents.Create(false); try i := 0; while i <= RaiseObject.ComponentReferences.Count - 1 do begin RaiseComponent := RaiseObject.ComponentReferences[i]; DefineJoinedComponentsByJoinedObjects(JoinedToRaiseBeforeComponents, RaiseComponent, BeforeRaiseObjects); DefineJoinedComponentsByJoinedObjects(JoinedToRaiseAfterComponents, RaiseComponent, AfterRaiseObjects); RaiseComponent.DisJoinFromAll(false).Free; //*** Если компонента была к чемуто подключена, то на это подключение будет идти другая компонента // а RaiseComponent можно удалять IsDeletedRaiseComponent := false; if (JoinedToRaiseBeforeComponents.Count > 0) or (JoinedToRaiseAfterComponents.Count > 0) then begin if RaiseComponent.IsLine = biTrue then TF_Main(GForm).MoveComponComplectsToUp(RaiseComponent, RaiseComponent.TreeViewNode); TF_Main(GForm).DelCompon(RaiseComponent, nil, false, true, true, false); IsDeletedRaiseComponent := true; end; //*** соединить BeforeComponents с AfterComponents for j := 0 to JoinedToRaiseBeforeComponents.Count - 1 do begin BeforeComponent := JoinedToRaiseBeforeComponents[j]; BeforeObject := BeforeComponent.GetFirstParentCatalog; BeforeObjectSide := -1; for k := 0 to JoinedToRaiseAfterComponents.Count - 1 do begin AfterComponent := JoinedToRaiseAfterComponents[k]; AfterObject := AfterComponent.GetFirstParentCatalog; AfterObjectSide := GetNumSideByObject(AfterObject, AJoinedAfterRaise); if BeforeObjectSide = -1 then BeforeObjectSide := GetNumSideByObject(BeforeObject, AJoinedBeforeRaise); if (BeforeObjectSide <> -1) and (AfterObjectSide <> -1) then if BeforeComponent.JoinTo(AfterComponent, BeforeObjectSide, AfterObjectSide, true).CanConnect then Result := true; end; end; if Not IsDeletedRaiseComponent then Inc(i); end; finally FreeAndNil(JoinedToRaiseBeforeComponents); FreeAndNil(JoinedToRaiseAfterComponents); FreeAndNil(BeforeRaiseObjects); FreeAndNil(AfterRaiseObjects); end; end; function TF_ChoiceConnectSide.MakeCabling(AIDObjectList: Tlist; ASaveForUndo: Boolean): Boolean; var CatalogList: TSCSCatalogs; ComponCount: Integer; Catalog1: TSCSCatalog; Catalog2: TSCSCatalog; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; i, j, k, l: Integer; Side1, Side2: Integer; WasUnion: Boolean; SavedForUndo: Boolean; ListOwner: TSCSList; {function UnionInterfaces(AInterfaces1, AInterfaces2: TList): Boolean; var i: Integer; ptrInterface1: TSCSInterface; ptrInterface2: TSCSInterface; InterfCount: Integer; WasUnionInterf: Boolean; begin Result := false; WasUnionInterf := false; if AInterfaces1.Count < AInterfaces2.Count then InterfCount := AInterfaces1.Count else InterfCount := AInterfaces2.Count; for i := 0 to InterfCount - 1 do begin ptrInterface1 := AInterfaces1.Items[i]; ptrInterface2 := AInterfaces2.Items[i]; WasUnionInterf := TF_Main(GForm).UnionInterfaces(ptrInterface1.ID, ptrInterface2.ID, cnkVarious or cnkMaleMale); end; Result := WasUnionInterf; end; } function UnionInterfaces(AInterfaces1, AInterfaces2: TSCSInterfaces): Boolean; var i, j: Integer; ptrInterface1: TSCSInterface; ptrInterface2: TSCSInterface; InterfCount: Integer; WasUnionInterf: Boolean; begin Result := false; WasUnionInterf := false; if AInterfaces1.Count < AInterfaces2.Count then InterfCount := AInterfaces1.Count else InterfCount := AInterfaces2.Count; {for i := 0 to AInterfaces1.Count - 1 do begin ptrInterface1 := AInterfaces1.Items[i]; for j := 0 to AInterfaces2.Count - 1 do begin ptrInterface2 := AInterfaces2.Items[j]; //if CanConnectInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale) = chrSuccess then if ptrInterface1.ID <> ptrInterface2.ID then WasUnionInterf := TF_Main(GForm).UnionInterfaces(ptrInterface1.ID, ptrInterface2.ID, cnkVarious or cnkMaleMale); end; end; } //for i := 0 to InterfCount - 1 do //begin // ptrInterface1 := AInterfaces1.Items[i]; // ptrInterface2 := AInterfaces2.Items[i]; // //if CanConnectInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale) = chrSuccess then // if ptrInterface1.ID <> ptrInterface2.ID then // if (ptrInterface1.Side = Side1) and (ptrInterface2.Side = Side2) then // WasUnionInterf := TF_Main(GForm).UnionInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale); //end; for i := 0 to AInterfaces1.Count - 1 do begin ptrInterface1 := AInterfaces1[i]; for j := 0 to AInterfaces2.Count - 1 do begin ptrInterface2 := AInterfaces2[j]; //if CanConnectInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale) = chrSuccess then if (ptrInterface1.ID <> ptrInterface2.ID) and (ptrInterface1.ID_Component <> ptrInterface2.ID_Component) and (ptrInterface1.TypeI = itFunctional) and (ptrInterface2.TypeI = itFunctional) and (ptrInterface1.Side = Side1) and (ptrInterface2.Side = Side2) then begin //*** Проверить, соединен ди интерфейс с интерфейсом соединяемой компоненты if Not(ptrInterface1.CheckJoinToComponent(ptrInterface2.ComponentOwner)) and Not(ptrInterface2.CheckJoinToComponent(ptrInterface1.ComponentOwner)) then WasUnionInterf := TF_Main(GForm).UnionInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale); end; end; end; Result := WasUnionInterf; end; begin Result := false; try SavedForUndo := false; WasUnion := false; GDragPrevTickCount := GetTickCount; CatalogList := GetCatalogList(AIDObjectList, ComponCount); if CatalogList = nil then Exit; ///// EXIT ///// Screen.Cursor := crHourGlass; try //*** Если компоненты SCSComponent1 и SCSComponent2 как цельный, то разъединить for i := 0 to CatalogList.Count - 1 do begin Catalog1 := CatalogList.Items[i]; for j := 0 to Catalog1.SCSComponents.Count - 1 do begin SCSComponent1 := Catalog1.SCSComponents.Items[j]; for k := 0 to CatalogList.Count - 1 do begin Catalog2 := CatalogList.Items[k]; if Catalog2.ID <> Catalog1.ID then begin for l := 0 to Catalog2.SCSComponents.Count - 1 do begin SCSComponent2 := Catalog2.SCSComponents.Items[l]; if SCSComponent1.ID <> SCSComponent2.ID then begin //*** Если компоненты SCSComponent1 и SCSComponent2 как цельный, то разъединить //Tolik // Но...только в том случае, если кабель - такой же // ибо нех скручивать провода, допустим, с разным количеством жил и т.п. if ((SCSComponent1.Cypher = SCSComponent2.Cypher) and (SCSComponent1.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher) and (SCSComponent2.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher)) then begin // if SCSComponent1.Whole_ID = SCSComponent2.Whole_ID then begin if SCSComponent1.JoinedComponents.IndexOf(SCSComponent2) <> -1 then begin //Tolik { if (not F_PEAutoTraceDialog.FromAutoTraceDialog) or (F_PEAutoTraceDialog.FromAutoTraceDialog and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked))) then begin} // UNDO if ASaveForUndo and Not SavedForUndo then begin ListOwner := SCSComponent1.GetListOwner; if ListOwner <> nil then begin SaveListToUndoStack(ListOwner.CurrID); SavedForUndo := true; end; end; if ((SCSComponent1.IDNetType in [3,{4,}5,7])and(SCSComponent2.IDNetType in [3,{4,}5,7])) then begin if (CheckComponentsForSideSection(SCSComponent1))and(CheckComponentsForSideSection(SCSComponent2)) then SCSComponent1.DisJoinFrom(SCSComponent2); end else SCSComponent1.DisJoinFrom(SCSComponent2); { end else begin if F_PEAutoTraceDialog.FromAutoTraceDialog and F_PEAutoTraceDialog.IgnoreExistingCable.Visible and F_PEAutoTraceDialog.IgnoreExistingCable.Checked then begin // UNDO if ASaveForUndo and Not SavedForUndo then begin ListOwner := SCSComponent1.GetListOwner; if ListOwner <> nil then begin SaveListToUndoStack(ListOwner.CurrID); SavedForUndo := true; end; end; if (Catalog1.LastAddedComponent <> nil) and (Catalog2.LastAddedComponent <> nil) and (SCSComponent1 = Catalog1.LastAddedComponent) and (SCSComponent2 = Catalog2.LastAddedComponent) then begin if ((SCSComponent1.IDNetType in [3,4,5,7])and(SCSComponent2.IDNetType in [3,4,5,7])) then begin if (CheckComponentsForSideSection(SCSComponent1))and(CheckComponentsForSideSection(SCSComponent2)) then SCSComponent1.DisJoinFrom(SCSComponent2); end else SCSComponent1.DisJoinFrom(SCSComponent2); end; end; end; } end; end; end; end; end; end; end; end; end; for i := 0 to CatalogList.Count - 1 do begin Catalog1 := CatalogList.Items[i]; for j := 0 to Catalog1.SCSComponents.Count - 1 do begin SCSComponent1 := Catalog1.SCSComponents.Items[j]; for k := 0 to CatalogList.Count - 1 do begin Catalog2 := CatalogList.Items[k]; if Catalog2.ID <> Catalog1.ID then begin for l := 0 to Catalog2.SCSComponents.Count - 1 do begin SCSComponent2 := Catalog2.SCSComponents.Items[l]; if SCSComponent1.ID <> SCSComponent2.ID then // Tolik // то же самое - скручивать только одинаковые // if ((SCSComponent1.Cypher <> SCSComponent2.Cypher) or (SCSComponent1.isLine = biFalse) or (SCSComponent2.isLine = biFalse)) then if ((SCSComponent1.Cypher = SCSComponent2.Cypher) and (SCSComponent1.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher) and (SCSComponent2.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher)) then // begin if TF_Main(GForm).CanConnCompon(SCSComponent1, SCSComponent2, cntUnion, smtNone) then begin GetSidesByConnectedFigures(SCSComponent1.ListID, SCSComponent2.ListID, Catalog1.SCSID, Catalog2.SCSID, Side1, Side2); if (Side1 <> -1) and (Side2 <> -1) then begin if ((SCSComponent1.IDNetType in [3,{4,}5,7])and(SCSComponent2.IDNetType in [3,{4,}5,7])) then begin //Проверка - чтобы не делало связей, если SideSection компонента не такой как выбранный в нормабейсе if (CheckComponentsForSideSection(SCSComponent1))and(CheckComponentsForSideSection(SCSComponent2)) then begin WasUnion := UnionInterfaces(SCSComponent1.Interfaces, SCSComponent2.Interfaces); if WasUnion then //теперь OnAfterJoinCompons выполняется только если интерфейсы реально завязались друг с другом OnAfterJoinCompons(SCSComponent1, SCSComponent2, Side1, Side2); end; end else begin WasUnion := UnionInterfaces(SCSComponent1.Interfaces, SCSComponent2.Interfaces); if WasUnion then OnAfterJoinCompons(SCSComponent1, SCSComponent2, Side1, Side2); end; end; end; end; end; end; end; end; end; Result := WasUnion; if WasUnion then TF_Main(GForm).RefreshNode; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; finally Screen.Cursor := crDefault; CatalogList.Free; //FreeCatalogList(CatalogList); end; except on E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.MakeCabling: '+E.Message); end; end; function TF_ChoiceConnectSide.DisconnectObjects(AIDObjectList1, AIDObjectList2: Tlist): Boolean; var CatalogList1: TSCSCatalogs; CatalogList2: TSCSCatalogs; Catalog1: TSCSCatalog; Catalog2: TSCSCatalog; i, j, k ,l: Integer; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; WasDisconnect: Boolean; WasBreak: Boolean; function GetCatalogList(AIDObjectList: Tlist): TSCSCatalogs; var Reslist: TSCSCatalogs; i: Integer; Catalog: TSCSCatalog; begin Result := nil; ResList := TSCSCatalogs.Create(false); for i := 0 to AIDObjectList.Count - 1 do begin Catalog := nil; Catalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(Integer(AIDObjectList.Items[i]^)); if Catalog <> nil then Reslist.Add(Catalog); //Catalog := TSCSCatalog.Create(TForm(F_ProjMan)); //Catalog.ID := F_ProjMan.DM.GetIDCatalogByIDFigure(Integer(AIDObjectList.Items[i]^)); //Catalog.LoadAllComponentsByObjectID(Catalog.ID, [fiMarkID, fiIsLine, fiIDComponentType, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID, fiWholeID]); //Reslist.Add(Catalog); end; Result := Reslist; //if Reslist.Count = 0 then // Reslist.Free //else // Result := Reslist; end; (* function DisconnectCompons(ACompon1, ACompon2: TSCSComponent): Boolean; var ConnectCompRelList: TList; IDCompRel: Integer; strIDCompon1, StrIDCompon2: String; i: Integer; begin try Result := false; //ConnectCompRelList := TList.Create; with F_ProjMan do begin { ChangeSQLQuery(DM.scsQ1, ' select id from component_relation '+ ' where ((id_Component = :id_component) and (id_child = :id_child)) or '+ ' ((id_Component = :id_child) and (id_child = :id_component)) and '+ ' (connect_type = '''+IntToStr(cntUnion)+''') '); DM.scsQ1.SetParamAsInteger('id_component', ACompon1.ID); DM.scsQ1.SetParamAsInteger('id_child', ACompon2.ID); DM.scsQ1.ExecQuery; DM.IntFieldToList(ConnectCompRelList, DM.scsQ1, 'id'); } strIDCompon1 := IntToStr(ACompon1.ID); StrIDCompon2 := IntToStr(ACompon2.ID); ConnectCompRelList := DM.GetCompRelFieldValueListByFilter(fnID, '((id_Component = '''+strIDCompon1+''') and (id_child = '''+strIDCompon2+''')) or '+ '((id_Component = '''+strIDCompon2+''') and (id_child = '''+strIDCompon1+''')) and '+ '(connect_type = '''+IntToStr(cntUnion)+''')'); for i := 0 to ConnectCompRelList.Count - 1 do begin IDCompRel := Integer(ConnectCompRelList.Items[i]^); FreeCompRel(IDCompRel); Result := true; //*** Определить подсоединенные объекты OnAfterDisJoinCompons(ACompon1, ACompon2); end; end; finally FreeList(ConnectCompRelList); end; end; *) // Tolik 18/05/2018 -- Procedure ClearLists; begin if CatalogList1 <> nil then CatalogList1.free; if CatalogList2 <> nil then CatalogList2.free; end; // begin Result := false; CatalogList1 := nil; // Tolik 18/05/2018 -- CatalogList2 := nil; // Tolik 18/05/2018 -- try WasDisconnect := false; //TF_Main(GForm).Tree_Catalog.Items.BeginUpdate; CatalogList1 := GetCatalogList(AIDObjectList1); CatalogList2 := GetCatalogList(AIDObjectList2); if (CatalogList1 = nil) or (CatalogList2 = nil) then begin ClearLists; // Tolik 18/05/2018 -- Exit; ///// EXIT ///// end; try for i := 0 to CatalogList1.Count - 1 do begin Catalog1 := CatalogList1.Items[i]; for j := 0 to Catalog1.ComponentReferences.Count - 1 do begin SCSComponent1 := Catalog1.ComponentReferences.Items[j]; WasBreak := false; for k := 0 to CatalogList2.Count - 1 do begin Catalog2 := CatalogList2.Items[k]; for l := 0 to Catalog2.ComponentReferences.Count - 1 do begin SCSComponent2 := Catalog2.ComponentReferences.Items[l]; if SCSComponent1.DisJoinFrom(SCSComponent2) then //if DisconnectCompons(SCSComponent1, SCSComponent2, cntUnion) then begin WasDisconnect := true; WasBreak := true; Break; end; end; if WasBreak then Break; end; end; end; Result := WasDisconnect; finally CatalogList1.Free; CatalogList2.Free; //FreeCatalogList(CatalogList1); //FreeCatalogList(CatalogList2); end; except On E: Exception do AddExceptionToLog('TF_ChoiceConnectSide.DisconnectObjects: '+E.Message); end; end; { function TF_ChoiceConnectSide.DisconnectObjects(AIDObject1, AIDObject2: Integer): Boolean; var Catalog1: TSCSCatalog; Catalog2: TSCSCatalog; i, j: Integer; ptrSCSComponent1: PSCSComponent; ptrSCSComponent2: PSCSComponent; WasDisconnect: Boolean; function DisconnectCompons(ACompon1, ACompon2: PSCSComponent): Boolean; var ConnectCompRelList: TList; IDCompRel: Integer; i: Integer; begin try Result := false; ConnectCompRelList := TList.Create; with F_ProjMan do begin DM.scsQSelect.Close; DM.scsQSelect.ParamByName('id_component').AsInteger := ACompon1.ID; DM.scsQSelect.ParamByName('id_child').AsInteger := ACompon2.ID; DM.scsQSelect.ExecQuery; DM.IntFieldToList(ConnectCompRelList, DM.scsQSelect, 'id'); for i := 0 to ConnectCompRelList.Count - 1 do begin IDCompRel := Integer(ConnectCompRelList.Items[i]^); FreeCompRel(IDCompRel); Result := true; end; end; finally FreeList(ConnectCompRelList); end; end; begin try try Result := false; WasDisconnect := false; with F_ProjMan.DM do begin Catalog1 := TSCSCatalog.Create(TForm(F_ProjMan)); Catalog2 := TSCSCatalog.Create(TForm(F_ProjMan)); Catalog1.ID := GetIDCatalogByIDFigure(AIDObject1); Catalog2.ID := GetIDCatalogByIDFigure(AIDObject2); Catalog1.LoadComponents(Catalog1.ID, false); Catalog2.LoadComponents(Catalog2.ID, false); ChangeSQLQuery(scsQSelect, ' select id from component_relation '+ ' where ((id_Component = :id_component) and (id_child = :id_child)) or '+ ' ((id_Component = :id_child) and (id_child = :id_component)) and '+ ' (connect_type = '''+IntToStr(cntUnion)+''') '); for i := 0 to Catalog1.SCSComponents.Count - 1 do begin ptrSCSComponent1 := Catalog1.SCSComponents.Items[i]; for j := 0 to Catalog2.SCSComponents.Count - 1 do begin ptrSCSComponent2 := Catalog2.SCSComponents.Items[j]; if DisconnectCompons(ptrSCSComponent1, ptrSCSComponent2) then WasDisconnect := true; end; end; Result := WasDisconnect; end; except On E: Exception do AddExceptionToLog('DisconnectObjectsInPM: '+E.Message); end; finally Catalog1.Free; Catalog2.Free; end; end; } // ##### Подгружает наименование трассы в которой находится компонент ##### procedure TF_ChoiceConnectSide.LoadTrassaName(AListItem: TListItem); var SCSComponentLV: TSCSComponent; SCSComponent: TSCSComponent; OwnerCatalog: TSCSCatalog; begin SCSComponentLV := AListItem.Data; if SCSComponentLV <> nil then with TF_Main(GForm) do begin OwnerCatalog := nil; SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(SCSComponentLV.ID); if SCSComponent <> nil then OwnerCatalog := SCSComponent.GetFirstParentCatalog; if OwnerCatalog <> nil then begin AListItem.SubItems.Add(OwnerCatalog.Name); AListItem.SubItemImages[0] := OwnerCatalog.ItemType; end; end; end; constructor TF_ChoiceConnectSide.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); end; destructor TF_ChoiceConnectSide.Destroy; begin inherited Destroy; end; // ############################################################################# // ############################################################################# // procedure TF_ChoiceConnectSide.Panel_OKCancelResize(Sender: TObject); begin SetMiddleControlChilds(TControl(Sender), TControl(Self)); end; procedure TF_ChoiceConnectSide.Timer_UpdateOnJoinTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; TF_Main(GForm).GSCSBase.CurrProject.UpdateComponsChangedFields; end; procedure TF_ChoiceConnectSide.Timer_UpdateOnDisJoinTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; TF_Main(GForm).GSCSBase.CurrProject.UpdateComponsChangedFields; end; procedure TF_ChoiceConnectSide.Timer_RefreshAllListsTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; RefreshAllLists; end; procedure TF_ChoiceConnectSide.Timer_DefineObjetsParamsInCADTimer( Sender: TObject); var i: Integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin // Tolik 27/10/2017 - - if GCanExecuteTimer_DefineObjectsParamsInCAD then begin TTimer(Sender).Enabled := false; //*** Определить новые справочные данные по добавленным гуидам TF_Main(GForm).GSCSBase.CurrProject.DefineSpravDataFromOtherSpravByNewGUIDs(F_NormBase.GSCSBase.NBSpravochnik); OldTick := GetTickCount; TF_Main(GForm).GSCSBase.CurrProject.DefineObjectsParamsInCADByServFld; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; end; end.