unit U_TrunkSCS; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, PCPanel, PCDrawBox, PCDrawing, DrawEngine, PowerCad, StdCtrls, pcMsbar, ComCtrls, ToolWin, PCTypesUtils, DrawObjects, Menus, DlgBase, ExtDlgs, PCLayerDlg, OleCtnrs, U_Common_Classes, buttons, PCgui, GuiStrings, Math, RichForm, Contnrs, U_ESCadClasess, FastStrings; Type TCADCrossObject = class(TMyObject) private FComponTypeSysName: String; FComponNameMark: String; FComponNameShort: String; FID: Integer; FObjectID: Integer; FListID: Integer; protected FElements: TObjectList; public property ComponTypeSysName: String read FComponTypeSysName write FComponTypeSysName; property ComponNameMark: String read FComponNameMark write FComponNameMark; property ComponNameShort: String read FComponNameShort write FComponNameShort; property Elements: TObjectList read FElements write FElements; property ID: Integer read FID write FID; property ObjectID: Integer read FObjectID write FObjectID; property ListID: Integer read FListID write FListID; procedure Assign(ACADCrossObject: TCADCrossObject); procedure AssignOnlyCADCrossObject(ACADCrossObject: TCADCrossObject); procedure AssignElements(AElements: TObjectList); constructor Create; destructor Destroy; override; end; TCADCrossObjectElement = class(TMyObject) private FNpp: String; FCableCapacity: Integer; // Емкость кабеля FCableNameMark: String; FCableDiameter: Double; FID: Integer; FIDCADCrossObject: Integer; //FIDInterface: Integer; FIDComponent: Integer; FSignType: Integer; FConnectingTraceID: Integer; // for CAD FAngle: Double; FInPointX: Double; FInPointY: Double; public property Npp: String read FNpp write FNpp; property CableCapacity: Integer read FCableCapacity write FCableCapacity; property CableNameMark: String read FCableNameMark write FCableNameMark; property CableDiameter: Double read FCableDiameter write FCableDiameter; property ID: Integer read FID write FID; property IDCADCrossObject: Integer read FIDCADCrossObject write FIDCADCrossObject; //property IDInterface: Integer read FIDInterface write FIDInterface; property IDComponent: Integer read FIDComponent write FIDComponent; property SignType: Integer read FSignType write FSignType; property ConnectingTraceID: Integer read FConnectingTraceID write FConnectingTraceID; // for CAD property Angle: Double read FAngle write FAngle; property InPointX: Double read FInPointX write FInPointX; property InPointY: Double read FInPointY write FInPointY; procedure Assign(ACADCrossObjectElement: TCADCrossObjectElement); constructor Create; destructor destroy; override; end; procedure CreateCadCrossATS(aObject: TConnectorObject; aCadCrossObject: TCADCrossObject); procedure ReCreateCadCrossATS(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); function CheckCadCrossATSTextFields(aCadCrossObject: TCADCrossObject): Double; procedure CreateCadDistribCab(aObject: TConnectorObject; aCadCrossObject: TCADCrossObject); procedure ReCreateCadDistribCab(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); function CheckCadDistribCabTextFields(aCadCrossObject: TCADCrossObject): Double; function DrawTextToField(aFieldBnd: TDoubleRect; aText: TStringList; aCrossType: string; aTextColor: Integer; aTextWidth: Integer): TRichText; // вращение procedure RotateTrunkObject(aObject: TConnectorObject; aAngleDegree: Double); // перемещение procedure AfterMoveTrunkObject(aObject: TConnectorObject; adeltax, adeltay: Double); // удаление procedure DeleteTrunkObject(aObject: TConnectorObject); // трассировка Function TracingTrunkToEndPoint(ACurrentWS, AEndPoint: TConnectorObject; AID_Cable: Integer): Boolean; // определить какуюб позицию имеет данная трасса Function GetPosOfConnectingTrace(aListID, aObjectID: Integer): Integer; // удалить связующие трассы procedure DeleteConnectingTraces(aObject: TConnectorObject); // можно ли удалять function CheckCannotDelete(aFigure: TFigure): Boolean; // получить связующую трассу по позиции Function GetConnectingTraceByPos(aObject: TConnectorObject; aPos: Integer): TOrthoLine; // переконнектить связующие после зеркального отображения procedure AfterMirrorTrunkObject(aObject: TConnectorObject); // переместить связующие трассы после зеркального отображения procedure MoveMirrorLineForCrossATS(aLine: TLine; aAngle: Double); procedure MoveMirrorLineForDistribCab(aLine: TLine; aAngle: Double); // получить список всех связующих трасс от объекта function GetAllConnectingTraces(aObject: TConnectorObject): TList; // Редактирование интерфейсов procedure ChangeCrossATSInterf(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); procedure ChangeDistribCabInterf(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); // есть ли эта связующая в новой структуре function ExistInNewTrunkStruct(aTrace: TOrthoLine; aElements: TObjectList): Boolean; implementation uses U_Common, U_CAD, USCS_Main, U_Main, Types, U_BaseCommon, U_SCSComponent, U_SCSLists, U_Constants; procedure CreateCadCrossATS(aObject: TConnectorObject; aCadCrossObject: TCADCrossObject); var i, j: integer; LHandle: Integer; FigGroup: TFigureGrpMod; MarkSize: Double; ColSize: Double; RowSize: Double; ColCount: Integer; RowCount: Integer; Mark: string; w, h: Double; BeginPoint: TDoublePoint; Bnd: TDoubleRect; FieldBnd: TDoubleRect; StrFields: TStringList; TextField: TRichText; CadCrossObjectElement: TCADCrossObjectElement; PointTo: TDoublePoint; ConnectedLine: TOrthoLine; ConnectedConn1, ConnectedConn2: TConnectorObject; ObjParams: TObjectParams; ObjectRect: TRectangle; InterfRect: TRectangle; Line: TLine; PenStyle: TpenStyle; PenColor: Integer; PenWidth: Integer; SendTextColor: Integer; OldTick, NewTick, ResTime: Cardinal; begin try aObject.ActualZOrder[1] := 0; if aObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenStyle := psDash; PenColor := clBlack; PenWidth := 2; SendTextColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenStyle := psDash; PenColor := clRed; PenWidth := 1; SendTextColor := clRed; end; end else begin PenWidth := 1; PenStyle := psSolid; PenColor := clBlack; SendTextColor := clBlack; end; LHandle := GCadForm.PCad.GetLayerHandle(2); FigGroup := TFigureGrpMod.create(LHandle, GCadForm.PCad); BeginPoint := DoublePoint(-100, -100); // Check Textes Widths ColSize := CheckCadCrossATSTextFields(aCadCrossObject); RowSize := 4; Mark := aCadCrossObject.ComponNameMark; ColCount := 4; RowCount := aCadCrossObject.Elements.Count + 2; w := ColSize * ColCount; h := RowSize * RowCount; // начертить таблицу ObjectRect := TRectangle.create(BeginPoint.x, BeginPoint.y, BeginPoint.x + w, BeginPoint.y + h, 1, ord(psClear), clNone, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(ObjectRect); // вертикали for i := 1 to ColCount - 1 do begin Line := TLine.create(BeginPoint.x + ColSize * i, BeginPoint.y + RowSize, BeginPoint.x + ColSize * i, BeginPoint.y + h, PenWidth, ord(PenStyle), PenColor, 0, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(Line); end; // горизонтали for i := 0 to RowCount - 1 do begin InterfRect := TRectangle.create(BeginPoint.x, BeginPoint.y + RowSize * i, BeginPoint.x + w, BeginPoint.y + RowSize * (i + 1), PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(InterfRect); end; // закинуть текстовые поля // маркировка Bnd := FigGroup.GetBoundRect; StrFields := TStringList.Create; StrFields.Add(aCadCrossObject.ComponNameMark); StrFields.Add(aCadCrossObject.ComponNameShort); FieldBnd.Top := Bnd.Top - RowSize; FieldBnd.Bottom := FieldBnd.Top + RowSize * 2; FieldBnd.Left := Bnd.Left; FieldBnd.Right := FieldBnd.Left + w; TextField := DrawTextToField(FieldBnd, StrFields, ctsnCrossATS, SendTextColor, PenWidth); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); // шапка for i := 0 to ColCount - 1 do begin StrFields := TStringList.Create; if i = 0 then begin StrFields.Add(cTrunkSCS_Mes1); StrFields.Add(cTrunkSCS_Mes2); end; if i = 1 then begin StrFields.Add(cTrunkSCS_Mes3); StrFields.Add(cTrunkSCS_Mes4); end; if i = 2 then begin StrFields.Add(cTrunkSCS_Mes5); StrFields.Add(cTrunkSCS_Mes6); end; if i = 3 then begin StrFields.Add(cTrunkSCS_Mes7); StrFields.Add(cTrunkSCS_Mes8); end; FieldBnd.Top := Bnd.Top + RowSize; FieldBnd.Bottom := FieldBnd.Top + RowSize; FieldBnd.Left := Bnd.Left + ColSize * i; FieldBnd.Right := FieldBnd.Left + ColSize; TextField := DrawTextToField(FieldBnd, StrFields, ctsnCrossATS, SendTextColor, PenWidth); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); end; // основные поля for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); if aObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; SendTextColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; SendTextColor := clRed; end; end else begin if CadCrossObjectElement.FSignType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; SendTextColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; SendTextColor := clRed; end; end else begin PenWidth := 1; SendTextColor := clBlack; end; end; for j := 0 to ColCount - 1 do begin StrFields := TStringList.Create; if j = 0 then StrFields.Add(CadCrossObjectElement.Npp); if j = 1 then StrFields.Add(IntToStr(CadCrossObjectElement.CableCapacity)); if j = 2 then StrFields.Add(CadCrossObjectElement.CableNameMark); if j = 3 then StrFields.Add(FormatFloat(ffMask, CadCrossObjectElement.CableDiameter)); FieldBnd.Top := Bnd.Top + RowSize * (i + 2); FieldBnd.Bottom := FieldBnd.Top + RowSize; FieldBnd.Left := Bnd.Left + ColSize * j; FieldBnd.Right := FieldBnd.Left + ColSize; TextField := DrawTextToField(FieldBnd, StrFields, ctsnCrossATS, SendTextColor, PenWidth); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); end; end; // Создать сам объект aObject.DrawFigure := FigGroup; Bnd := aObject.DrawFigure.GetBoundRect; aObject.GrpSizeX := Bnd.Right - Bnd.Left; aObject.GrpSizeY := Bnd.Bottom - Bnd.Top; Bnd := ObjectRect.GetBoundRect; RefreshCAD(GCadForm.PCad); // создать отрезки трасс к нему PointTo.x := Bnd.Left; for i := 0 to aCadCrossObject.Elements.Count - 1 do begin // OldTick := GetTickCount; PointTo.y := Bnd.Top + (RowSize * 2) + RowSize / 2; PointTo.y := PointTo.y + RowSize * i; // создать присоединенный коннектор ConnectedConn1 := TConnectorObject.Create(PointTo.x - 5, PointTo.y, 0, LHandle, mydsNormal, GCadForm.PCad); ConnectedConn1.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (2, ConnectedConn1, False); ConnectedConn1.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn1.ID, ConnectedConn1.Name); ObjParams := GetFigureParams(ConnectedConn1.ID); ConnectedConn1.Name := ObjParams.Name; ConnectedConn1.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn1.ID, ConnectedConn1.ActualZOrder[1]); ConnectedConn2 := TConnectorObject.Create(PointTo.x, PointTo.y, 0, LHandle, mydsNormal, GCadForm.PCad); ConnectedConn2.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (2, ConnectedConn2, False); ConnectedConn2.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn2.ID, ConnectedConn2.Name); ObjParams := GetFigureParams(ConnectedConn2.ID); ConnectedConn2.Name := ObjParams.Name; ConnectedConn2.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn2.ID, ConnectedConn2.ActualZOrder[1]); ConnectedLine := TOrthoLine.create(ConnectedConn1.ActualPoints[1].x, ConnectedConn1.ActualPoints[1].y, 0, ConnectedConn2.ActualPoints[1].x, ConnectedConn2.ActualPoints[1].y, 0, 1, ord(PenStyle), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure(2, ConnectedLine, False); SetConFigureCoordZInPM(ConnectedLine.ID, ConnectedLine.ActualZOrder[1]); ConnectedLine.SetJConnector1(TConnectorObject(ConnectedConn1)); ConnectedLine.SetJConnector2(TConnectorObject(ConnectedConn2)); // SnapConnectorToPointObject(ConnectedConn2, aObject, False); ConnectedConn2.JoinedConnectorsList.Add(aObject); aObject.JoinedConnectorsList.Add(ConnectedConn2); DeleteObjectFromPM(ConnectedConn2.ID, ConnectedConn2.Name); // Locks ConnectedConn2.LockSelect := True; ConnectedConn2.LockMove := True; ConnectedConn2.LockModify := True; ConnectedLine.FConnectingLine := True; ConnectedLine.FConnectingPos := i; TCADCrossObjectElement(aCadCrossObject.Elements[i]).ConnectingTraceID := ConnectedLine.ID; // ResTime := GetTickCount - OldTick; // ShowMessage(FloatToStr(ResTime)); end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.CreateCadCrossATS', E.Message); end; end; procedure CreateCadDistribCab(aObject: TConnectorObject; aCadCrossObject: TCADCrossObject); var i, j: integer; LHandle: Integer; FigGroup: TFigureGrpMod; ColSize: Double; TopSize: Double; BottomSize: Double; ColCount: Integer; Mark: string; w, h: Double; BeginPoint: TDoublePoint; Bnd: TDoubleRect; TextField: TRichText; StrFields: TStringList; FieldBnd: TDoubleRect; CadCrossObjectElement: TCADCrossObjectElement; PointTo: TDoublePoint; ConnectedLine: TOrthoLine; ConnectedConn1, ConnectedConn2: TConnectorObject; ObjParams: TObjectParams; ObjectRect: TRectangle; InterfRect: TRectangle; Line: TLine; PenStyle: TPenStyle; PenColor: Integer; PenWidth: Integer; begin try if aObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; end; end else begin PenWidth := 1; PenStyle := psSolid; PenColor := clBlack; end; LHandle := GCadForm.PCad.GetLayerHandle(2); FigGroup := TFigureGrpMod.create(LHandle, GCadForm.PCad); BeginPoint := DoublePoint(-100, -100); ColSize := CheckCadDistribCabTextFields(aCadCrossObject); TopSize := 8; BottomSize := 3; Mark := aCadCrossObject.ComponNameMark; ColCount := aCadCrossObject.Elements.Count; w := ColCount * ColSize; h := TopSize + BottomSize; ObjectRect := TRectangle.create(BeginPoint.x, BeginPoint.y, BeginPoint.x + w, BeginPoint.y + h, 1, ord(psClear), clNone, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(ObjectRect); // горизонтали InterfRect := TRectangle.create(BeginPoint.x, BeginPoint.y + TopSize, BeginPoint.x + w, BeginPoint.y + h, PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(InterfRect); // вертикали for i := 0 to ColCount - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); if aObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; end; end else begin if CadCrossObjectElement.FSignType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; end; end else begin PenWidth := 1; PenStyle := psSolid; PenColor := clBlack; end; end; InterfRect := TRectangle.create(BeginPoint.x + ColSize * i, BeginPoint.y, BeginPoint.x + ColSize * (i + 1), BeginPoint.y + TopSize, PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(InterfRect); end; // закинуть текстовые поля // маркировка Bnd := FigGroup.GetBoundRect; StrFields := TStringList.Create; StrFields.Add(aCadCrossObject.ComponNameMark); StrFields.Add(aCadCrossObject.ComponNameShort); FieldBnd.Top := Bnd.Top + TopSize; FieldBnd.Bottom := FieldBnd.Top + BottomSize * 2; FieldBnd.Left := Bnd.Left; FieldBnd.Right := FieldBnd.Left + w; TextField := DrawTextToField(FieldBnd, StrFields, ctsnDistributionCabinet, clBlack, 1); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); // создать сам объект aObject.DrawFigure := FigGroup; Bnd := aObject.DrawFigure.GetBoundRect; aObject.GrpSizeX := Bnd.Right - Bnd.Left; aObject.GrpSizeY := Bnd.Bottom - Bnd.Top; Bnd := ObjectRect.GetBoundRect; RefreshCAD(GCadForm.PCad); // создать отрезки трасс к нему PointTo.y := Bnd.Top; for i := 0 to aCadCrossObject.Elements.Count - 1 do begin PointTo.x := Bnd.Left + ColSize / 2; PointTo.x := PointTo.x + ColSize * i; // создать присоединенный коннектор ConnectedConn1 := TConnectorObject.Create(PointTo.x, PointTo.y - 5, 0, LHandle, mydsNormal, GCadForm.PCad); ConnectedConn1.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (2, ConnectedConn1, False); ConnectedConn1.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn1.ID, ConnectedConn1.Name); ObjParams := GetFigureParams(ConnectedConn1.ID); ConnectedConn1.Name := ObjParams.Name; ConnectedConn1.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn1.ID, ConnectedConn1.ActualZOrder[1]); ConnectedConn2 := TConnectorObject.Create(PointTo.x, PointTo.y, 0, LHandle, mydsNormal, GCadForm.PCad); ConnectedConn2.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (2, ConnectedConn2, False); ConnectedConn2.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn2.ID, ConnectedConn2.Name); ObjParams := GetFigureParams(ConnectedConn2.ID); ConnectedConn2.Name := ObjParams.Name; ConnectedConn2.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn2.ID, ConnectedConn2.ActualZOrder[1]); ConnectedLine := TOrthoLine.create(ConnectedConn1.ActualPoints[1].x, ConnectedConn1.ActualPoints[1].y, 0, ConnectedConn2.ActualPoints[1].x, ConnectedConn2.ActualPoints[1].y, 0, 1, ord(PenStyle), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure(2, ConnectedLine, False); SetConFigureCoordZInPM(ConnectedLine.ID, ConnectedLine.ActualZOrder[1]); ConnectedLine.SetJConnector1(TConnectorObject(ConnectedConn1)); ConnectedLine.SetJConnector2(TConnectorObject(ConnectedConn2)); // SnapConnectorToPointObject(ConnectedConn2, aObject, False); ConnectedConn2.JoinedConnectorsList.Add(aObject); aObject.JoinedConnectorsList.Add(ConnectedConn2); DeleteObjectFromPM(ConnectedConn2.ID, ConnectedConn2.Name); // Locks ConnectedConn2.LockSelect := True; ConnectedConn2.LockMove := True; ConnectedConn2.LockModify := True; ConnectedLine.FConnectingLine := True; ConnectedLine.FConnectingPos := i; // сохранить ИД связующей трассы TCADCrossObjectElement(aCadCrossObject.Elements[i]).ConnectingTraceID := ConnectedLine.ID; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.CreateCadDistribCab', E.Message); end; end; procedure ReCreateCadCrossATS(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); var i, j: integer; LHandle: Integer; FigGroup: TFigureGrpMod; MarkSize: Double; ColSize: Double; RowSize: Double; ColCount: Integer; RowCount: Integer; Mark: string; w, h: Double; BeginPoint, CP: TDoublePoint; Bnd: TDoubleRect; FieldBnd: TDoubleRect; StrFields: TStringList; TextField: TRichText; CadCrossObjectElement: TCADCrossObjectElement; vList: TF_CAD; vObject: TConnectorObject; vMirrored: Boolean; ElementsRects: TList; getAngle: Double; ObjectRect: TRectangle; InterfRect: TRectangle; Line, Line1, Line2: TLine; PenStyle: TpenStyle; PenColor: Integer; PenWidth: Integer; SendTextColor: Integer; begin try vList := GetListByID(aListID); if vList = nil then Exit; vObject := TConnectorObject(GetFigureByID(vList, aObjectID)); if vObject = nil then Exit; ElementsRects := TList.Create; vMirrored := vObject.FMirrored; if vObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; SendTextColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; SendTextColor := clRed; end; end else begin PenWidth := 1; PenStyle := psSolid; PenColor := clBlack; SendTextColor := clBlack; end; LHandle := vList.PCad.GetLayerHandle(2); FigGroup := TFigureGrpMod.create(LHandle, vList.PCad); BeginPoint := DoublePoint(-100, -100); // Check Textes Widths ColSize := CheckCadCrossATSTextFields(aCadCrossObject); RowSize := 4; Mark := aCadCrossObject.ComponNameMark; ColCount := 4; RowCount := aCadCrossObject.Elements.Count + 2; w := ColSize * ColCount; h := RowSize * RowCount; // начертить таблицу ObjectRect := TRectangle.create(BeginPoint.x, BeginPoint.y, BeginPoint.x + w, BeginPoint.y + h, 1, ord(psClear), clNone, ord(bsClear), clNone, LHandle, mydsNormal, vList.PCad); FigGroup.AddFigure(ObjectRect); // вертикали for i := 1 to ColCount - 1 do begin Line := TLine.create(BeginPoint.x + ColSize * i, BeginPoint.y + RowSize, BeginPoint.x + ColSize * i, BeginPoint.y + h, PenWidth, ord(PenStyle), PenColor, 0, LHandle, mydsNormal, vList.PCad); FigGroup.AddFigure(Line); end; // горизонтали for i := 0 to RowCount - 1 do begin InterfRect := TRectangle.create(BeginPoint.x, BeginPoint.y + RowSize * i, BeginPoint.x + w, BeginPoint.y + RowSize * (i + 1), PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); FigGroup.AddFigure(InterfRect); if i >= 2 then ElementsRects.Add(InterfRect); end; Line := TLine.create(BeginPoint.x, BeginPoint.y + RowSize * RowCount, BeginPoint.x + w, BeginPoint.y + RowSize * RowCount, PenWidth, ord(PenStyle), clBlack, 0, LHandle, mydsNormal, vList.PCad); FigGroup.AddFigure(Line); ElementsRects.Add(Line); // закинуть текстовые поля // маркировка Bnd := FigGroup.GetBoundRect; StrFields := TStringList.Create; StrFields.Add(aCadCrossObject.ComponNameMark); StrFields.Add(aCadCrossObject.ComponNameShort); FieldBnd.Top := Bnd.Top - RowSize; FieldBnd.Bottom := FieldBnd.Top + RowSize * 2; FieldBnd.Left := Bnd.Left; FieldBnd.Right := FieldBnd.Left + w; TextField := DrawTextToField(FieldBnd, StrFields, ctsnCrossATS, SendTextColor, PenWidth); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); // шапка for i := 0 to ColCount - 1 do begin StrFields := TStringList.Create; if vMirrored then begin if i = 3 then begin StrFields.Add(cTrunkSCS_Mes1); StrFields.Add(cTrunkSCS_Mes2); end; if i = 2 then begin StrFields.Add(cTrunkSCS_Mes3); StrFields.Add(cTrunkSCS_Mes4); end; if i = 1 then begin StrFields.Add(cTrunkSCS_Mes5); StrFields.Add(cTrunkSCS_Mes6); end; if i = 0 then begin StrFields.Add(cTrunkSCS_Mes7); StrFields.Add(cTrunkSCS_Mes8); end; end else begin if i = 0 then begin StrFields.Add(cTrunkSCS_Mes1); StrFields.Add(cTrunkSCS_Mes2); end; if i = 1 then begin StrFields.Add(cTrunkSCS_Mes3); StrFields.Add(cTrunkSCS_Mes4); end; if i = 2 then begin StrFields.Add(cTrunkSCS_Mes5); StrFields.Add(cTrunkSCS_Mes6); end; if i = 3 then begin StrFields.Add(cTrunkSCS_Mes7); StrFields.Add(cTrunkSCS_Mes8); end; end; FieldBnd.Top := Bnd.Top + RowSize; FieldBnd.Bottom := FieldBnd.Top + RowSize; FieldBnd.Left := Bnd.Left + ColSize * i; FieldBnd.Right := FieldBnd.Left + ColSize; TextField := DrawTextToField(FieldBnd, StrFields, ctsnCrossATS, SendTextColor, PenWidth); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); end; // основные поля for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); if vObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; SendTextColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; SendTextColor := clRed; end; end else begin if CadCrossObjectElement.FSignType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; SendTextColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; SendTextColor := clRed; end; end else begin PenWidth := 1; SendTextColor := clBlack; end; end; for j := 0 to ColCount - 1 do begin StrFields := TStringList.Create; if vMirrored then begin if j = 3 then StrFields.Add(CadCrossObjectElement.Npp); if j = 2 then StrFields.Add(IntToStr(CadCrossObjectElement.CableCapacity)); if j = 1 then StrFields.Add(CadCrossObjectElement.CableNameMark); if j = 0 then StrFields.Add(FormatFloat(ffMask, CadCrossObjectElement.CableDiameter)); end else begin if j = 0 then StrFields.Add(CadCrossObjectElement.Npp); if j = 1 then StrFields.Add(IntToStr(CadCrossObjectElement.CableCapacity)); if j = 2 then StrFields.Add(CadCrossObjectElement.CableNameMark); if j = 3 then StrFields.Add(FormatFloat(ffMask, CadCrossObjectElement.CableDiameter)); end; FieldBnd.Top := Bnd.Top + RowSize * (i + 2); FieldBnd.Bottom := FieldBnd.Top + RowSize; FieldBnd.Left := Bnd.Left + ColSize * j; FieldBnd.Right := FieldBnd.Left + ColSize; TextField := DrawTextToField(FieldBnd, StrFields, ctsnCrossATS, SendTextColor, PenWidth); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); end; end; // Создать сам объект FigGroup.Rotate(vObject.FDrawFigureAngle, vObject.ActualPoints[1]); RemoveInFigureGrp(vObject.DrawFigure); vObject.DrawFigure := FigGroup; Bnd := vObject.DrawFigure.GetBoundRect; vObject.GrpSizeX := Bnd.Right - Bnd.Left; vObject.GrpSizeY := Bnd.Bottom - Bnd.Top; RefreshCAD(vList.PCad); // заполнить структуру for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); InterfRect := TRectangle(ElementsRects[i]); if vMirrored then begin CP.x := (InterfRect.ap2.x + InterfRect.ap3.x) / 2; CP.y := (InterfRect.ap2.y + InterfRect.ap3.y) / 2; getAngle := GetLineAngle(InterfRect.ap2, InterfRect.ap1); getAngle := getAngle * pi / 180; end else begin CP.x := (InterfRect.ap1.x + InterfRect.ap4.x) / 2; CP.y := (InterfRect.ap1.y + InterfRect.ap4.y) / 2; getAngle := GetLineAngle(InterfRect.ap1, InterfRect.ap2); getAngle := getAngle * pi / 180; end; CadCrossObjectElement.InPointX := CP.x; CadCrossObjectElement.InPointY := CP.y; CadCrossObjectElement.Angle := getAngle; end; FreeAndNil(ElementsRects); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.ReCreateCadCrossATS', E.Message); end; end; procedure ReCreateCadDistribCab(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); var i, j: integer; LHandle: Integer; FigGroup: TFigureGrpMod; ColSize: Double; TopSize: Double; BottomSize: Double; ColCount: Integer; Mark: string; w, h: Double; BeginPoint, CP: TDoublePoint; Bnd: TDoubleRect; TextField: TRichText; StrFields: TStringList; FieldBnd: TDoubleRect; CadCrossObjectElement: TCADCrossObjectElement; vList: TF_CAD; vObject: TConnectorObject; vMirrored: Boolean; ElementsRects: TList; getAngle: Double; ObjectRect: TRectangle; InterfRect: TRectangle; Line, Line1, Line2: TLine; PenWidth: Integer; PenStyle: TPenStyle; PenColor: Integer; begin try vList := GetListByID(aListID); if vList = nil then Exit; vObject := TConnectorObject(GetFigureByID(vList, aObjectID)); if vObject = nil then Exit; ElementsRects := TList.Create; vMirrored := vObject.FMirrored; if vObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; end; end else begin PenWidth := 1; PenStyle := psSolid; PenColor := clBlack; end; LHandle := vList.PCad.GetLayerHandle(2); FigGroup := TFigureGrpMod.create(LHandle, vList.PCad); BeginPoint := DoublePoint(-100, -100); ColSize := CheckCadDistribCabTextFields(aCadCrossObject); TopSize := 8; BottomSize := 3; Mark := aCadCrossObject.ComponNameMark; ColCount := aCadCrossObject.Elements.Count; w := ColCount * ColSize; h := TopSize + BottomSize; ObjectRect := TRectangle.create(BeginPoint.x, BeginPoint.y, BeginPoint.x + w, BeginPoint.y + h, 1, ord(psClear), clNone, ord(bsClear), clNone, LHandle, mydsNormal, vList.PCad); FigGroup.AddFigure(ObjectRect); // горизонтали if vMirrored then begin InterfRect := TRectangle.create(BeginPoint.x, BeginPoint.y, BeginPoint.x + w, BeginPoint.y + BottomSize, PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); end else begin InterfRect := TRectangle.create(BeginPoint.x, BeginPoint.y + TopSize, BeginPoint.x + w, BeginPoint.y + h, PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); end; FigGroup.AddFigure(InterfRect); // вертикали for i := 0 to ColCount - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); if vObject.FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; end; end else begin if CadCrossObjectElement.FSignType = 1 then begin if GCadForm.FPrintType = pt_Black then begin PenWidth := 2; PenStyle := psDash; PenColor := clBlack; end; if GCadForm.FPrintType = pt_Color then begin PenWidth := 1; PenStyle := psDash; PenColor := clRed; end; end else begin PenWidth := 1; PenStyle := psSolid; PenColor := clBlack; end; end; if vMirrored then begin InterfRect := TRectangle.create(BeginPoint.x + ColSize * i, BeginPoint.y + BottomSize, BeginPoint.x + ColSize * (i + 1), BeginPoint.y + h, PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); end else begin InterfRect := TRectangle.create(BeginPoint.x + ColSize * i, BeginPoint.y, BeginPoint.x + ColSize * (i + 1), BeginPoint.y + TopSize, PenWidth, ord(PenStyle), PenColor, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); end; FigGroup.AddFigure(InterfRect); ElementsRects.Add(InterfRect); end; // закинуть текстовые поля // маркировка Bnd := FigGroup.GetBoundRect; StrFields := TStringList.Create; if vMirrored then begin StrFields.Add(aCadCrossObject.ComponNameShort); StrFields.Add(aCadCrossObject.ComponNameMark); FieldBnd.Top := Bnd.Top - BottomSize; FieldBnd.Bottom := FieldBnd.Top + BottomSize * 2; end else begin StrFields.Add(aCadCrossObject.ComponNameMark); StrFields.Add(aCadCrossObject.ComponNameShort); FieldBnd.Top := Bnd.Top + TopSize; FieldBnd.Bottom := FieldBnd.Top + BottomSize * 2; end; FieldBnd.Left := Bnd.Left; FieldBnd.Right := FieldBnd.Left + w; TextField := DrawTextToField(FieldBnd, StrFields, ctsnDistributionCabinet, clBlack, 1); FigGroup.AddFigure(TextField); FreeAndNil(StrFields); FigGroup.Rotate(vObject.FDrawFigureAngle, vObject.ActualPoints[1]); // создать сам объект RemoveInFigureGrp(vObject.DrawFigure); vObject.DrawFigure := FigGroup; Bnd := vObject.DrawFigure.GetBoundRect; vObject.GrpSizeX := Bnd.Right - Bnd.Left; vObject.GrpSizeY := Bnd.Bottom - Bnd.Top; RefreshCAD(vList.PCad); // заполнить структуру for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); InterfRect := TRectangle(ElementsRects[i]); if vMirrored then begin CP.x := (InterfRect.ap4.x + InterfRect.ap3.x) / 2; CP.y := (InterfRect.ap4.y + InterfRect.ap3.y) / 2; getAngle := GetLineAngle(InterfRect.ap4, InterfRect.ap1); getAngle := getAngle * pi / 180; end else begin CP.x := (InterfRect.ap1.x + InterfRect.ap2.x) / 2; CP.y := (InterfRect.ap1.y + InterfRect.ap2.y) / 2; getAngle := GetLineAngle(InterfRect.ap1, InterfRect.ap4); getAngle := getAngle * pi / 180; end; CadCrossObjectElement.InPointX := CP.x; CadCrossObjectElement.InPointY := CP.y; CadCrossObjectElement.Angle := getAngle; end; FreeAndNil(ElementsRects); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.ReCreateCadDistribCab', E.Message); end; end; function DrawTextToField(aFieldBnd: TDoubleRect; aText: TStringList; aCrossType: string; aTextColor: Integer; aTextWidth: Integer): TRichText; var i: integer; LHandle: Integer; TextField: TRichText; FieldCP: TDoublePoint; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; HalfField: double; HalfText: double; ModCount: Integer; TextSize: Integer; TextStyle: TFontStyles; TextColor: Integer; delta: double; begin try Result := nil; if aText.Count > 1 then delta := 0.5 else delta := 0; if aCrossType = ctsnCrossATS then begin TextSize := GCadForm.FCrossATSFontSize; if aTextWidth > 1 then begin TextStyle := [fsBold]; end else begin if GCadForm.FCrossATSFontBold then TextStyle := [fsBold] else TextStyle := []; end; end; if aCrossType = ctsnDistributionCabinet then begin TextSize := GCadForm.FDistribCabFontSize; if GCadForm.FDistribCabFontBold then TextStyle := [fsBold] else TextStyle := []; end; TextColor := aTextColor; LHandle := GCadForm.PCad.GetLayerHandle(2); FieldCP.x := (aFieldBnd.Left + aFieldBnd.Right) / 2; FieldCP.y := (aFieldBnd.Top + aFieldBnd.Bottom) / 2; TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := TextSize; TextField.re.Font.Style := TextStyle; TextField.re.Font.Color := TextColor; TextField.re.Lines.Clear; for i := 0 to aText.Count - 1 do begin aText[i] := FastReplace(aText[i],#13#10,' '); TextField.re.Lines.Add(aText[i]); end; // GCadForm.PCad.AddCustomFigure(1, TextField, False); // RefreshCAD(GCadForm.PCad); // получить свойства // Tolik -- 13/01/2017 TextField.ttMetaFile:= TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetaFile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); if TextField.re.Lines.Count > 1 then h := TM.tmHeight / 4 * TextField.re.Lines.Count + 1 else h := TM.tmHeight / 4 * TextField.re.Lines.Count; w := 0; for i := 0 to TextField.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(TextField.Re.Lines[i]) then w := xCanvas.TextWidth(TextField.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); TextField.ttMetaFile.Free; // пересоздать с новыми свойствами if TextField <> nil then begin // GCadForm.PCad.Figures.Remove(TextField); FreeAndNil(TextField); end; TextField := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := TextSize; TextField.re.Font.Style := TextStyle; TextField.re.Font.Color := TextColor; TextField.Re.Alignment := TAlignment(2); TextField.re.Lines.Clear; for i := 0 to aText.Count - 1 do begin aText[i] := FastReplace(aText[i],#13#10,' '); TextField.re.Lines.Add(aText[i]); end; TextField.Move(FieldCP.x - TextField.CenterPoint.x, (FieldCP.y - TextField.CenterPoint.y) + delta); Result := TextField; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.DrawTextToField', E.Message); end; end; procedure RotateTrunkObject(aObject: TConnectorObject; aAngleDegree: Double); var i, j, k: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; HelpLine: TLine; HelpLinesList1: TList; HelpLinesList2: TList; x1, x2, y1, y2: double; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; OtherConn: TConnectorObject; LHandle: Integer; OldPos, NewPos: TDoublePoint; OtherConnsMoved: TList; begin try // сохранить позиции присоединенных коннекторов LHandle := GCadForm.PCad.GetLayerHandle(2); HelpLinesList1 := TList.create; HelpLinesList2 := TList.create; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); x1 := aObject.ActualPoints[1].x; y1 := aObject.ActualPoints[1].y; x2 := JoinedConn.ActualPoints[1].x; y2 := JoinedConn.ActualPoints[1].y; HelpLine := TLine.create(x1, y1, x2, y2, 1, ord(psClear), clNone, 0, LHandle, mydsNormal, GCadForm.PCad); HelpLinesList1.Add(HelpLine); // противоположные коннекторы for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.JoinConnector1 <> JoinedConn then begin x2 := JoinedLine.JoinConnector1.ActualPoints[1].x; y2 := JoinedLine.JoinConnector1.ActualPoints[1].y; HelpLine := TLine.create(x1, y1, x2, y2, 1, ord(psClear), clNone, 0, LHandle, mydsNormal, GCadForm.PCad); HelpLinesList2.Add(HelpLine); end; if JoinedLine.JoinConnector2 <> JoinedConn then begin x2 := JoinedLine.JoinConnector2.ActualPoints[1].x; y2 := JoinedLine.JoinConnector2.ActualPoints[1].y; HelpLine := TLine.create(x1, y1, x2, y2, 1, ord(psClear), clNone, 0, LHandle, mydsNormal, GCadForm.PCad); HelpLinesList2.Add(HelpLine); end; end; end; AngleRad := aAngleDegree / 180 * pi; aObject.Rotate(AngleRad, aObject.ActualPoints[1]); aObject.DrawFigure.Rotate(AngleRad, aObject.CenterPoint); aObject.FDrawFigureAngle := aObject.FDrawFigureAngle + AngleRad; if aObject.FDrawFigureAngle >= 2 * pi then aObject.FDrawFigureAngle := aObject.FDrawFigureAngle - 2 * pi; Bnd := aObject.DrawFigure.GetBoundRect; aObject.GrpSizeX := Bnd.Right - Bnd.Left; aObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // if aObject.FCaptionsViewType = cv_Right then CurrCaptionAngle := 0; if aObject.FCaptionsViewType = cv_Down then CurrCaptionAngle := 90; if aObject.FCaptionsViewType = cv_Left then CurrCaptionAngle := 180; if aObject.FCaptionsViewType = cv_Up then CurrCaptionAngle := 270; CurrCaptionAngle := CurrCaptionAngle + 180; CurrCaptionAngle := round(CurrCaptionAngle) mod 360; if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then aObject.FCaptionsViewType := cv_Right else if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then aObject.FCaptionsViewType := cv_Down else if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then aObject.FCaptionsViewType := cv_Left else if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then aObject.FCaptionsViewType := cv_Up else if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then aObject.FCaptionsViewType := cv_Right; // RefreshCAD(GCadForm.PCad); aObject.ReCreateCaptionsGroup(false, false); // переместить трассы на новые позиции for i := 0 to HelpLinesList1.Count - 1 do begin // присоединенные коннекторы HelpLine := TLine(HelpLinesList1[i]); JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); OldPos := HelpLine.ActualPoints[2]; HelpLine.Rotate(AngleRad, HelpLine.ActualPoints[1]); NewPos := HelpLine.ActualPoints[2]; JoinedConn.Move(NewPos.x - OldPos.x, NewPos.y - OldPos.y); FreeAndNil(HelpLine); end; FreeAndNil(HelpLinesList1); // переместить трассы на новые позиции OtherConnsMoved := TList.Create; for i := 0 to HelpLinesList2.Count - 1 do begin HelpLine := TLine(HelpLinesList2[i]); JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); OldPos := HelpLine.ActualPoints[2]; HelpLine.Rotate(AngleRad, HelpLine.ActualPoints[1]); NewPos := HelpLine.ActualPoints[2]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.JoinConnector1 <> JoinedConn then begin if CheckNoFigureInList(JoinedLine.JoinConnector1, OtherConnsMoved) then begin JoinedLine.JoinConnector1.Move(NewPos.x - OldPos.x, NewPos.y - OldPos.y); OtherConnsMoved.Add(JoinedLine.JoinConnector1); end; end; if JoinedLine.JoinConnector2 <> JoinedConn then begin if CheckNoFigureInList(JoinedLine.JoinConnector2, OtherConnsMoved) then begin JoinedLine.JoinConnector2.Move(NewPos.x - OldPos.x, NewPos.y - OldPos.y); OtherConnsMoved.Add(JoinedLine.JoinConnector2); end; end; end; FreeAndNil(HelpLine); end; FreeAndNil(HelpLinesList2); FreeAndNil(OtherConnsMoved); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.RotateTrunkObject', E.Message); end; end; procedure AfterMoveTrunkObject(aObject: TConnectorObject; adeltax, adeltay: Double); var i, j: Integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; OtherConn: TConnectorObject; MovedList: TList; MovedConn: TConnectorObject; begin try MovedList := TList.Create; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.JoinConnector1 <> JoinedConn then begin if TConnectorObject(JoinedLine.JoinConnector1).JoinedConnectorsList.Count = 0 then MovedConn := TConnectorObject(JoinedLine.JoinConnector1) else MovedConn := TConnectorObject(TConnectorObject(JoinedLine.JoinConnector1).JoinedConnectorsList[0]); if CheckNoFigureInList(MovedConn, MovedList) then MovedList.Add(MovedConn); end; if JoinedLine.JoinConnector2 <> JoinedConn then begin if TConnectorObject(JoinedLine.JoinConnector2).JoinedConnectorsList.Count = 0 then MovedConn := TConnectorObject(JoinedLine.JoinConnector2) else MovedConn := TConnectorObject(TConnectorObject(JoinedLine.JoinConnector2).JoinedConnectorsList[0]); if CheckNoFigureInList(MovedConn, MovedList) then MovedList.Add(MovedConn); end; end; end; for i := 0 to MovedList.Count - 1 do begin OtherConn := TConnectorObject(MovedList[i]); if not OtherConn.Selected then OtherConn.Move(adeltax, adeltay); end; FreeAndNil(MovedList); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.AfterMoveTrunkObject', E.Message); end; end; procedure DeleteTrunkObject(aObject: TConnectorObject); var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; ConnectingTraces: TList; begin ConnectingTraces := nil; // Tolik 21/05/2018 -- try if aObject.AsEndPoint then begin GEndPoint := nil; GListWithEndPoint := nil; end; ConnectingTraces := GetAllConnectingTraces(aObject); for i := 0 to ConnectingTraces.Count - 1 do begin JoinedLine := TOrthoLine(ConnectingTraces[i]); JoinedLine.Delete; end; aObject.Deleted := True; //Tolik TF_CAD(TPowerCad(TConnectorObject(aObject).Owner).Owner).FRemFigures.Add(aObject); //GCadForm.FRemFigures.Add(aObject); // if Assigned(aObject.CaptionsGroup) then aObject.CaptionsGroup.Delete; if Assigned(aObject.NotesGroup) then aObject.NotesGroup.Delete; if Assigned(aObject.DrawFigure) then aObject.DrawFigure.Delete; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.DeleteTrunkObject', E.Message); end; ConnectingTraces.free; // Tolik 21/05/2018 -- end; Function TracingTrunkToEndPoint(ACurrentWS, AEndPoint: TConnectorObject; AID_Cable: Integer): Boolean; var i, j: integer; ComponID: Integer; isConnected: Boolean; IDLine: Integer; IDPos: Integer; AllTrace: TList; SetLinesList: TIntList; SetLinesPos: TIntList; Counts: Integer; JoinedConn: TConnectorObject; CadCrossObject: TCadCrossObject; begin try Result := False; if ACurrentWS.ConnectorType = ct_Clear then begin AllTrace := GetAllTraceInCAD(AEndPoint, ACurrentWS); // выделить трассу if AllTrace <> nil then begin for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try // скопировать кабель туда for i := 0 to AllTrace.Count - 1 do ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable); finally EnableMarking; end; // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; // SetLinesList := TIntList.Create; SetLinesPos := TIntList.Create; for i := 0 to AllTrace.Count - 1 do begin IDLine := TFigure(AllTrace[i]).ID; SetLinesList.Add(IDLine); if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin IDPos := TOrthoLine(AllTrace[i]).FConnectingPos; end else IDPos := -1; SetLinesPos.Add(IDPos); end; isConnected := ConnectObjectsInPMByWay(SetLinesList, nil, nil, SetLinesPos); if SetLinesList <> nil then FreeAndNil(SetLinesList); if SetLinesPos <> nil then FreeAndNil(SetLinesPos); if AllTrace <> nil then FreeAndNil(AllTrace); Result := True; end; end else begin ACurrentWS.FDisableTracing := True; for Counts := 0 to ACurrentWS.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(ACurrentWS.JoinedConnectorsList[Counts]); AllTrace := GetAllTraceInCAD(AEndPoint, JoinedConn); // выделить трассу if AllTrace <> nil then begin // докинуть сам объект-источник AllTrace.Add(ACurrentWS); for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try // скопировать кабель туда for i := 0 to AllTrace.Count - 1 do ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable); finally EnableMarking; end; // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; // SetLinesList := TIntList.Create; SetLinesPos := TIntList.Create; for i := 0 to AllTrace.Count - 1 do begin IDLine := TFigure(AllTrace[i]).ID; SetLinesList.Add(IDLine); if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin IDPos := TOrthoLine(AllTrace[i]).FConnectingPos; end else IDPos := -1; SetLinesPos.Add(IDPos); end; isConnected := ConnectObjectsInPMByWay(SetLinesList, nil, nil, SetLinesPos); if SetLinesList <> nil then FreeAndNil(SetLinesList); if SetLinesPos <> nil then FreeAndNil(SetLinesPos); if AllTrace <> nil then FreeAndNil(AllTrace); Result := True; end; end; ACurrentWS.FDisableTracing := False; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.TracingTrunkToEndPoint', E.Message); end; end; Function GetPosOfConnectingTrace(aListID, aObjectID: Integer): Integer; var vList: TF_CAD; vLine: TOrthoLine; begin try Result := -1; vList := GetListByID(aListID); if vList <> nil then begin vLine := TOrthoLine(GetFigureByID(vList, aObjectID)); if vLine <> nil then begin Result := vLine.FConnectingPos; end; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.GetPosOfConnectingTrace', E.Message); end; end; procedure DeleteConnectingTraces(aObject: TConnectorObject); var i, j: Integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; ConnectingTraces: TList; begin try ConnectingTraces := TList.Create; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.FConnectingLine then ConnectingTraces.Add(JoinedLine); end; end; for i := 0 to ConnectingTraces.Count - 1 do begin JoinedLine := TOrthoLine(ConnectingTraces[i]); JoinedLine.Delete; end; FreeAndNil(ConnectingTraces); RefreshCAD(GCadForm.Pcad); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.DeleteConnectingTraces', E.Message); end; end; function CheckCannotDelete(aFigure: TFigure): Boolean; var i: Integer; Conn: TConnectorObject; Line: TOrthoLine; begin try Result := False; if CheckFigureByClassName(aFigure, cTOrthoLine) then begin Line := TOrthoLine(aFigure); if Line.FConnectingLine then Result := True; end else if CheckFigureByClassName(aFigure, cTConnectorObject) then begin Conn := TConnectorObject(aFigure); for i := 0 to Conn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(Conn.JoinedOrtholinesList[i]).FConnectingLine then Result := True; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.CheckCannotDelete', E.Message); end; end; Function GetConnectingTraceByPos(aObject: TConnectorObject; aPos: Integer): TOrthoLine; var i, j: Integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin try Result := nil; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.FConnectingLine then begin if JoinedLine.FConnectingPos = aPos then begin Result := JoinedLine; Exit; end; end; end; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.GetConnectingTraceByPos', E.Message); end; end; procedure AfterMirrorTrunkObject(aObject: TConnectorObject); var i, j, k: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; HelpLine: TLine; HelpLinesList1: TList; HelpLinesList2: TList; x1, x2, y1, y2: double; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; OtherConn: TConnectorObject; LHandle: Integer; OldPos, NewPos: TDoublePoint; OtherConnsMoved: TList; begin try // сохранить позиции присоединенных коннекторов LHandle := GCadForm.PCad.GetLayerHandle(2); HelpLinesList1 := TList.create; HelpLinesList2 := TList.create; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); x1 := aObject.ActualPoints[1].x; y1 := aObject.ActualPoints[1].y; x2 := JoinedConn.ActualPoints[1].x; y2 := JoinedConn.ActualPoints[1].y; HelpLine := TLine.create(x1, y1, x2, y2, 1, ord(psClear), clNone, 0, LHandle, mydsNormal, GCadForm.PCad); HelpLinesList1.Add(HelpLine); // противоположные коннекторы for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.JoinConnector1 <> JoinedConn then begin x2 := JoinedLine.JoinConnector1.ActualPoints[1].x; y2 := JoinedLine.JoinConnector1.ActualPoints[1].y; HelpLine := TLine.create(x1, y1, x2, y2, 1, ord(psClear), clNone, 0, LHandle, mydsNormal, GCadForm.PCad); HelpLinesList2.Add(HelpLine); end; if JoinedLine.JoinConnector2 <> JoinedConn then begin x2 := JoinedLine.JoinConnector2.ActualPoints[1].x; y2 := JoinedLine.JoinConnector2.ActualPoints[1].y; HelpLine := TLine.create(x1, y1, x2, y2, 1, ord(psClear), clNone, 0, LHandle, mydsNormal, GCadForm.PCad); HelpLinesList2.Add(HelpLine); end; end; end; // переместить трассы на новые позиции for i := 0 to HelpLinesList1.Count - 1 do begin // присоединенные коннекторы HelpLine := TLine(HelpLinesList1[i]); JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); OldPos := HelpLine.ActualPoints[2]; if aObject.FTrunkName = ctsnCrossATS then MoveMirrorLineForCrossATS(HelpLine, aObject.FDrawFigureAngle); if aObject.FTrunkName = ctsnDistributionCabinet then MoveMirrorLineForDistribCab(HelpLine, aObject.FDrawFigureAngle); NewPos := HelpLine.ActualPoints[2]; JoinedConn.Move(NewPos.x - OldPos.x, NewPos.y - OldPos.y); FreeAndNil(HelpLine); end; FreeAndNil(HelpLinesList1); // переместить трассы на новые позиции OtherConnsMoved := TList.Create; for i := 0 to HelpLinesList2.Count - 1 do begin HelpLine := TLine(HelpLinesList2[i]); JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); OldPos := HelpLine.ActualPoints[2]; if aObject.FTrunkName = ctsnCrossATS then MoveMirrorLineForCrossATS(HelpLine, aObject.FDrawFigureAngle); if aObject.FTrunkName = ctsnDistributionCabinet then MoveMirrorLineForDistribCab(HelpLine, aObject.FDrawFigureAngle); NewPos := HelpLine.ActualPoints[2]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.JoinConnector1 <> JoinedConn then begin if CheckNoFigureInList(JoinedLine.JoinConnector1, OtherConnsMoved) then begin JoinedLine.JoinConnector1.Move(NewPos.x - OldPos.x, NewPos.y - OldPos.y); OtherConnsMoved.Add(JoinedLine.JoinConnector1); end; end; if JoinedLine.JoinConnector2 <> JoinedConn then begin if CheckNoFigureInList(JoinedLine.JoinConnector2, OtherConnsMoved) then begin JoinedLine.JoinConnector2.Move(NewPos.x - OldPos.x, NewPos.y - OldPos.y); OtherConnsMoved.Add(JoinedLine.JoinConnector2); end; end; end; FreeAndNil(HelpLine); end; FreeAndNil(HelpLinesList2); FreeAndNil(OtherConnsMoved); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.AfterMirrorTrunkObject', E.Message); end; end; procedure MoveMirrorLineForCrossATS(aLine: TLine; aAngle: Double); var Point: TDoublePoint; mLine1, mLine2, a1, a2, b1, b2, c1, c2, interX, interY : Double; begin try if (DoubleCMP(aAngle, 0) or DoubleCMP(aAngle, pi) or DoubleCMP(aAngle, 2 * pi)) then begin Point.x := aLine.ActualPoints[2].x + (aLine.ActualPoints[1].x - aLine.ActualPoints[2].x) * 2; Point.y := aLine.ActualPoints[2].y; end else if (DoubleCMP(aAngle, pi / 2) or DoubleCMP(aAngle, 3 * pi / 2)) then begin Point.x := aLine.ActualPoints[2].x; Point.y := aLine.ActualPoints[2].y + (aLine.ActualPoints[1].y - aLine.ActualPoints[2].y) * 2; end else begin mLine1 := (aLine.ActualPoints[1].y - aLine.ActualPoints[2].y) / (aLine.ActualPoints[1].x - aLine.ActualPoints[2].x); a1 := -1 * mLine1; b1 := 1; c1 := mLine1 * aLine.ActualPoints[1].x - aLine.ActualPoints[1].y; mline2 := -1 / mLine1; a2 := -1 * mLine2; b2 := 1; c2 := mLine2 * aLine.ActualPoints[2].x - aLine.ActualPoints[2].y; interX := (c2 * b1 - c1 * b2) / (a1 * b2 - b1 * a2); interY := (c1 * a2 - a1 * c2) / (a1 * b2 - b1 * a2); Point.x := 2 * InterX - aLine.ActualPoints[2].x; Point.y := 2 * InterY - aLine.ActualPoints[2].y; end; aLine.ActualPoints[2] := Point; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.MoveMirrorLineForCrossATS', E.Message); end; end; procedure MoveMirrorLineForDistribCab(aLine: TLine; aAngle: Double); var Point: TDoublePoint; mLine1, mLine2, a1, a2, b1, b2, c1, c2, interX, interY : Double; begin try if (DoubleCMP(aAngle, pi / 2) or DoubleCMP(aAngle, 3 * pi / 2)) then begin Point.x := aLine.ActualPoints[2].x + (aLine.ActualPoints[1].x - aLine.ActualPoints[2].x) * 2; Point.y := aLine.ActualPoints[2].y; end else if (DoubleCMP(aAngle, 0) or DoubleCMP(aAngle, pi) or DoubleCMP(aAngle, 2 * pi)) then begin Point.x := aLine.ActualPoints[2].x; Point.y := aLine.ActualPoints[2].y + (aLine.ActualPoints[1].y - aLine.ActualPoints[2].y) * 2; end else begin mLine1 := (aLine.ActualPoints[1].y - aLine.ActualPoints[2].y) / (aLine.ActualPoints[1].x - aLine.ActualPoints[2].x); a1 := -1 * mLine1; b1 := 1; c1 := mLine1 * aLine.ActualPoints[1].x - aLine.ActualPoints[1].y; mline2 := -1 / mLine1; a2 := -1 * mLine2; b2 := 1; c2 := mLine2 * aLine.ActualPoints[2].x - aLine.ActualPoints[2].y; interX := (c2 * b1 - c1 * b2) / (a1 * b2 - b1 * a2); interY := (c1 * a2 - a1 * c2) / (a1 * b2 - b1 * a2); Point.x := 2 * InterX - aLine.ActualPoints[2].x; Point.y := 2 * InterY - aLine.ActualPoints[2].y; end; aLine.ActualPoints[2] := Point; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.MoveMirrorLineForDistribCab', E.Message); end; end; procedure ChangeCrossATSInterf(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); var i, j: Integer; Trace: TOrthoLine; OldConnectingTraces: TList; vList: TF_CAD; vObject: TConnectorObject; CADCrossObjectElement: TCADCrossObjectElement; LHandle: Integer; PenStyle: TpenStyle; PointTo: TDoublePoint; ConnectedLine: TOrthoLine; ConnectedConn1, ConnectedConn2: TConnectorObject; ObjParams: TObjectParams; SetToAngle: Double; SetToPoints: TDoublePoint; setdeltax, setdeltay: double; begin BeginProgress; try vList := GetListByID(aListID); if vList = nil then Exit; vObject := TConnectorObject(GetFigureByID(vList, aObjectID)); if vObject = nil then Exit; OldConnectingTraces := GetAllConnectingTraces(vObject); ReCreateCadCrossATS(aListID, aObjectID, aCadCrossObject); for i := 0 to OldConnectingTraces.Count - 1 do begin Trace := TOrthoLine(OldConnectingTraces[i]); if not ExistInNewTrunkStruct(Trace, aCadCrossObject.Elements) then Trace.Delete; end; RefreshCAD(vList.PCad); LHandle := vList.PCad.GetLayerHandle(2); for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CADCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); SetToAngle := CADCrossObjectElement.Angle; SetToPoints.x := CADCrossObjectElement.InPointX; SetToPoints.y := CADCrossObjectElement.InPointY; // был добавлен - создать связующую if CADCrossObjectElement.ConnectingTraceID = -1 then begin if CadCrossObjectElement.FSignType = 1 then PenStyle := psDash else PenStyle := psSolid; PointTo.x := -100; PointTo.y := -100; ConnectedConn1 := TConnectorObject.Create(PointTo.x - 5, PointTo.y, 0, LHandle, mydsNormal, vList.PCad); ConnectedConn1.ConnectorType := ct_Clear; vList.PCad.AddCustomFigure (2, ConnectedConn1, False); ConnectedConn1.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn1.ID, ConnectedConn1.Name); ObjParams := GetFigureParams(ConnectedConn1.ID); ConnectedConn1.Name := ObjParams.Name; ConnectedConn1.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn1.ID, ConnectedConn1.ActualZOrder[1]); ConnectedConn2 := TConnectorObject.Create(PointTo.x, PointTo.y, 0, LHandle, mydsNormal, vList.PCad); ConnectedConn2.ConnectorType := ct_Clear; vList.PCad.AddCustomFigure (2, ConnectedConn2, False); ConnectedConn2.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn2.ID, ConnectedConn2.Name); ObjParams := GetFigureParams(ConnectedConn2.ID); ConnectedConn2.Name := ObjParams.Name; ConnectedConn2.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn2.ID, ConnectedConn2.ActualZOrder[1]); ConnectedLine := TOrthoLine.create(ConnectedConn1.ActualPoints[1].x, ConnectedConn1.ActualPoints[1].y, 0, ConnectedConn2.ActualPoints[1].x, ConnectedConn2.ActualPoints[1].y, 0, 1, ord(PenStyle), clBlack, 0, LHandle, mydsNormal, vList.PCad); vList.PCad.AddCustomFigure(2, ConnectedLine, False); SetConFigureCoordZInPM(ConnectedLine.ID, ConnectedLine.ActualZOrder[1]); ConnectedLine.SetJConnector1(TConnectorObject(ConnectedConn1)); ConnectedLine.SetJConnector2(TConnectorObject(ConnectedConn2)); SnapConnectorToPointObject(ConnectedConn2, vObject, False); // Locks ConnectedConn2.LockSelect := True; ConnectedConn2.LockMove := True; ConnectedConn2.LockModify := True; ConnectedLine.FConnectingLine := True; ConnectedLine.FConnectingPos := i; TCADCrossObjectElement(aCadCrossObject.Elements[i]).ConnectingTraceID := ConnectedLine.ID; ConnectedLine.Rotate(SetToAngle, ConnectedLine.ActualPoints[1]); setdeltax := ConnectedLine.ActualPoints[2].x - ConnectedLine.JoinConnector2.ActualPoints[1].x; setdeltay := ConnectedLine.ActualPoints[2].y - ConnectedLine.JoinConnector2.ActualPoints[1].y; ConnectedLine.Rotate(- SetToAngle, ConnectedLine.ActualPoints[1]); ConnectedLine.JoinConnector2.Move(setdeltax, setdeltay); end else // найти и поместить на нужныю позицию begin ConnectedLine := TOrthoLine(GetFigureByID(vList, CADCrossObjectElement.ConnectingTraceID)); end; // !!! if ConnectedLine <> nil then begin setdeltax := SetToPoints.x - ConnectedLine.JoinConnector2.ActualPoints[1].x; setdeltay := SetToPoints.y - ConnectedLine.JoinConnector2.ActualPoints[1].y; ConnectedLine.JoinConnector1.Move(setdeltax, setdeltay); ConnectedLine.JoinConnector2.Move(setdeltax, setdeltay); ConnectedLine.FConnectingPos := i; end; end; if OldConnectingTraces <> nil then FreeAndNil(OldConnectingTraces); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.ChangeCrossATSInterf', E.Message); end; EndProgress; end; procedure ChangeDistribCabInterf(aListID, aObjectID: Integer; aCadCrossObject: TCADCrossObject); var i, j: Integer; Trace: TOrthoLine; OldConnectingTraces: TList; OldAngle: Double; vList: TF_CAD; vObject: TConnectorObject; vConnectingTrace: TOrthoLine; CADCrossObjectElement: TCADCrossObjectElement; LHandle: Integer; PenStyle: TPenStyle; PointTo: TDoublePoint; ConnectedLine: TOrthoLine; ConnectedConn1, ConnectedConn2: TConnectorObject; ObjParams: TObjectParams; SetToAngle: Double; SetToPoints: TDoublePoint; setdeltax, setdeltay: double; begin BeginProgress; try vList := GetListByID(aListID); if vList = nil then Exit; vObject := TConnectorObject(GetFigureByID(vList, aObjectID)); if vObject = nil then Exit; OldConnectingTraces := GetAllConnectingTraces(vObject); ReCreateCadDistribCab(aListID, aObjectID, aCadCrossObject); for i := 0 to OldConnectingTraces.Count - 1 do begin Trace := TOrthoLine(OldConnectingTraces[i]); if not ExistInNewTrunkStruct(Trace, aCadCrossObject.Elements) then Trace.Delete; end; RefreshCAD(vList.PCad); LHandle := vList.PCad.GetLayerHandle(2); for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CADCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); SetToAngle := CADCrossObjectElement.Angle; SetToPoints.x := CADCrossObjectElement.InPointX; SetToPoints.y := CADCrossObjectElement.InPointY; // был добавлен - создать связующую if CADCrossObjectElement.ConnectingTraceID = -1 then begin if CadCrossObjectElement.FSignType = 1 then PenStyle := psDash else PenStyle := psSolid; PointTo.x := -100; PointTo.y := -100; // создать присоединенный коннектор ConnectedConn1 := TConnectorObject.Create(PointTo.x - 5, PointTo.y, 0, LHandle, mydsNormal, vList.PCad); ConnectedConn1.ConnectorType := ct_Clear; vList.PCad.AddCustomFigure (2, ConnectedConn1, False); ConnectedConn1.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn1.ID, ConnectedConn1.Name); ObjParams := GetFigureParams(ConnectedConn1.ID); ConnectedConn1.Name := ObjParams.Name; ConnectedConn1.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn1.ID, ConnectedConn1.ActualZOrder[1]); ConnectedConn2 := TConnectorObject.Create(PointTo.x, PointTo.y, 0, LHandle, mydsNormal, vList.PCad); ConnectedConn2.ConnectorType := ct_Clear; vList.PCad.AddCustomFigure (2, ConnectedConn2, False); ConnectedConn2.Name := cTrunkSCS_Mes9; SetNewObjectNameInPM(ConnectedConn2.ID, ConnectedConn2.Name); ObjParams := GetFigureParams(ConnectedConn2.ID); ConnectedConn2.Name := ObjParams.Name; ConnectedConn2.FIndex := ObjParams.MarkID; SetConFigureCoordZInPM(ConnectedConn2.ID, ConnectedConn2.ActualZOrder[1]); ConnectedLine := TOrthoLine.create(ConnectedConn1.ActualPoints[1].x, ConnectedConn1.ActualPoints[1].y, 0, ConnectedConn2.ActualPoints[1].x, ConnectedConn2.ActualPoints[1].y, 0, 1, ord(PenStyle), clBlack, 0, LHandle, mydsNormal, vList.PCad); vList.PCad.AddCustomFigure(2, ConnectedLine, False); SetConFigureCoordZInPM(ConnectedLine.ID, ConnectedLine.ActualZOrder[1]); ConnectedLine.SetJConnector1(TConnectorObject(ConnectedConn1)); ConnectedLine.SetJConnector2(TConnectorObject(ConnectedConn2)); SnapConnectorToPointObject(ConnectedConn2, vObject, False); // Locks ConnectedConn2.LockSelect := True; ConnectedConn2.LockMove := True; ConnectedConn2.LockModify := True; ConnectedLine.FConnectingLine := True; ConnectedLine.FConnectingPos := i; TCADCrossObjectElement(aCadCrossObject.Elements[i]).ConnectingTraceID := ConnectedLine.ID; ConnectedLine.Rotate(SetToAngle, ConnectedLine.ActualPoints[1]); setdeltax := ConnectedLine.ActualPoints[2].x - ConnectedLine.JoinConnector2.ActualPoints[1].x; setdeltay := ConnectedLine.ActualPoints[2].y - ConnectedLine.JoinConnector2.ActualPoints[1].y; ConnectedLine.Rotate(- SetToAngle, ConnectedLine.ActualPoints[1]); ConnectedLine.JoinConnector2.Move(setdeltax, setdeltay); end else // найти и поместить на нужныю позицию begin ConnectedLine := TOrthoLine(GetFigureByID(vList, CADCrossObjectElement.ConnectingTraceID)); end; // !!! if ConnectedLine <> nil then begin setdeltax := SetToPoints.x - ConnectedLine.JoinConnector2.ActualPoints[1].x; setdeltay := SetToPoints.y - ConnectedLine.JoinConnector2.ActualPoints[1].y; ConnectedLine.JoinConnector1.Move(setdeltax, setdeltay); ConnectedLine.JoinConnector2.Move(setdeltax, setdeltay); ConnectedLine.FConnectingPos := i; end; end; if OldConnectingTraces <> nil then FreeAndNil(OldConnectingTraces); except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.ChangeDistribCabInterf', E.Message); end; EndProgress; end; function ExistInNewTrunkStruct(aTrace: TOrthoLine; aElements: TObjectList): Boolean; var i, j: integer; begin try Result := False; for i := 0 to aElements.Count - 1 do begin if aTrace.ID = TCADCrossObjectElement(aElements[i]).ConnectingTraceID then begin Result := True; Break; end; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.ExistInNewTrunkStruct', E.Message); end; end; function GetAllConnectingTraces(aObject: TConnectorObject): TList; var i, j: Integer; JoinedConn: TConnectorObject; JoinedTrace: TOrthoLine; begin try Result := TList.Create; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedTrace := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedTrace.FConnectingLine then Result.Add(JoinedTrace); end; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.GetAllConnectingTraces', E.Message); end; end; function CheckCadCrossATSTextFields(aCadCrossObject: TCADCrossObject): Double; var MarkSize: Double; i, j: Integer; MinWidth: Double; CadCrossObjectElement: TCADCrossObjectElement; LHandle: Integer; TextField: TRichText; StrText: String; TM: TTextMetric; xCanvas: TMetafileCanvas; w, w1, w2: double; begin try MinWidth := 6; MarkSize := 0; Result := MinWidth; LHandle := GCadForm.PCad.GetLayerHandle(1); // Check Mark ============================================================== TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := GCadForm.FCrossATSFontSize; TextField.re.Font.Style := [fsBold]; TextField.re.Lines.Clear; aCadCrossObject.ComponNameMark := FastReplace(aCadCrossObject.ComponNameMark,#13#10,' '); TextField.re.Lines.Add(aCadCrossObject.ComponNameMark); aCadCrossObject.ComponNameShort := FastReplace(aCadCrossObject.ComponNameShort,#13#10,' '); TextField.re.Lines.Add(aCadCrossObject.ComponNameShort); // Tolik -- 13/01/2017 TextField.ttMetaFile:= TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetafile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); w1 := xCanvas.TextWidth(TextField.Re.Lines[0]); w1 := (w1 + 3) / 4; w2 := xCanvas.TextWidth(TextField.Re.Lines[1]); w2 := (w2 + 3) / 4; MarkSize := Max(w1, w2); FreeAndNil(xCanvas); TextField.ttMetaFile.Free; if TextField <> nil then FreeAndNil(TextField); // Check Fileds for i := 0 to aCadCrossObject.Elements.Count - 1 do begin CadCrossObjectElement := TCADCrossObjectElement(aCadCrossObject.Elements[i]); // NPP StrText := CadCrossObjectElement.Npp; TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := GCadForm.FCrossATSFontSize; TextField.re.Font.Style := [fsBold]; TextField.re.Lines.Clear; StrText := FastReplace(StrText,#13#10,' '); TextField.re.Lines.Add(StrText); // Tolik -- 13/01/2017 TextField.ttMetaFile := TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetafile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); w := xCanvas.TextWidth(TextField.Re.Lines[0]); w := (w + 3) / 4; FreeAndNil(xCanvas); if TextField <> nil then FreeAndNil(TextField); if w > Result then Result := w; // CableCapacity StrText := IntToStr(CadCrossObjectElement.CableCapacity); TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := GCadForm.FCrossATSFontSize; TextField.re.Font.Style := [fsBold]; TextField.re.Lines.Clear; StrText := FastReplace(StrText,#13#10,' '); TextField.re.Lines.Add(StrText); // Tolik -- 13/01/2017 TextField.ttMetaFile := TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetafile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); w := xCanvas.TextWidth(TextField.Re.Lines[0]); w := (w + 3) / 4; FreeAndNil(xCanvas); TextField.ttMetaFile.Free; if TextField <> nil then FreeAndNil(TextField); if w > Result then Result := w; // CableNameMark StrText := CadCrossObjectElement.CableNameMark; TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := GCadForm.FCrossATSFontSize; TextField.re.Font.Style := [fsBold]; TextField.re.Lines.Clear; StrText := FastReplace(StrText,#13#10,' '); TextField.re.Lines.Add(StrText); // Tolik -- 13/01/2017 TextField.ttMetaFile := TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetafile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); w := xCanvas.TextWidth(TextField.Re.Lines[0]); w := (w + 3) / 4; FreeAndNil(xCanvas); TextField.ttMetaFile.Free; if TextField <> nil then FreeAndNil(TextField); if w > Result then Result := w; // CableDiametr StrText := FormatFloat(ffMask, CadCrossObjectElement.CableDiameter); TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := GCadForm.FCrossATSFontSize; TextField.re.Font.Style := [fsBold]; TextField.re.Lines.Clear; StrText := FastReplace(StrText,#13#10,' '); TextField.re.Lines.Add(StrText); // Tolik -- 13/01/2017 TextField.ttMetaFile := TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetafile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); w := xCanvas.TextWidth(TextField.Re.Lines[0]); w := (w + 3) / 4; FreeAndNil(xCanvas); TextField.ttMetaFile.Free; if TextField <> nil then FreeAndNil(TextField); if w > Result then Result := w; end; // correct to MarkSize if MarkSize > Result * 4 then begin Result := MarkSize / 4; end; except on E: Exception do AddExceptionToLogEx('U_TrunkdSCS.CheckCadCrossATSTextFields', E.Message); end; end; function CheckCadDistribCabTextFields(aCadCrossObject: TCADCrossObject): Double; var MarkSize: Double; i, j: Integer; CadCrossObjectElement: TCADCrossObjectElement; LHandle: Integer; TextField: TRichText; StrText: String; TM: TTextMetric; xCanvas: TMetafileCanvas; w, w1, w2: double; ColCount: Integer; begin try Result := 4; MarkSize := 0; LHandle := GCadForm.PCad.GetLayerHandle(1); // Check Mark ============================================================== TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := GCadForm.FDistribCabFontSize; TextField.re.Font.Style := [fsBold]; TextField.re.Lines.Clear; aCadCrossObject.ComponNameMark := FastReplace(aCadCrossObject.ComponNameMark,#13#10,' '); TextField.re.Lines.Add(aCadCrossObject.ComponNameMark); aCadCrossObject.ComponNameShort := FastReplace(aCadCrossObject.ComponNameShort,#13#10,' '); TextField.re.Lines.Add(aCadCrossObject.ComponNameShort); // Tolik -- 13/01/2017 TextField.ttMetaFile := TMetaFile.Create; TextField.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(TextField.ttMetaFile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); w1 := xCanvas.TextWidth(TextField.Re.Lines[0]); w1 := (w1 + 3) / 4; w2 := xCanvas.TextWidth(TextField.Re.Lines[1]); w2 := (w2 + 3) / 4; MarkSize := Max(w1, w2); FreeAndNil(xCanvas); TextField.ttMetaFile.Free; if TextField <> nil then FreeAndNil(TextField); // ColCount := aCadCrossObject.Elements.Count; if MarkSize > Result * ColCount then begin Result := MarkSize / ColCount; end; except on E: Exception do AddExceptionToLogEx('U_TrunkSCS.CheckCadDistribCabTextFields', E.Message); end; end; { TCadCrossObject } procedure TCADCrossObject.Assign(ACADCrossObject: TCADCrossObject); begin try AssignOnlyCADCrossObject(ACADCrossObject); AssignElements(ACADCrossObject.FElements); except on E: Exception do AddExceptionToLogEx('TCADCrossObject.Assign', E.Message); end; end; procedure TCADCrossObject.AssignElements(AElements: TObjectList); var i: Integer; CADCrossObjectElement: TCADCrossObjectElement; begin try FElements.Clear; for i := 0 to AElements.Count - 1 do begin CADCrossObjectElement := TCADCrossObjectElement.Create; CADCrossObjectElement.Assign(TCADCrossObjectElement(AElements[i])); FElements.Add(CADCrossObjectElement); end; except on E: Exception do AddExceptionToLogEx('TCADCrossObject.AssignElements', E.Message); end; end; procedure TCADCrossObject.AssignOnlyCADCrossObject(ACADCrossObject: TCADCrossObject); begin try FComponTypeSysName := ACADCrossObject.FComponTypeSysName; FComponNameMark := ACADCrossObject.FComponNameMark; FComponNameShort := ACADCrossObject.FComponNameShort; FID := ACADCrossObject.FID; FObjectID := ACADCrossObject.FObjectID; FListID := ACADCrossObject.FListID; except on E: Exception do AddExceptionToLogEx('TCADCrossObject.AssignOnlyCADCrossObject', E.Message); end; end; constructor TCadCrossObject.Create; begin inherited; try FComponTypeSysName := ''; FComponNameMark := ''; FComponNameShort := ''; FID := -1; FObjectID := -1; FListID := -1; FElements := TObjectList.Create(true); except on E: Exception do AddExceptionToLogEx('TCadCrossObject.Create', E.Message); end; end; destructor TCADCrossObject.Destroy; begin try FreeAndNil(FElements); inherited; except on E: Exception do AddExceptionToLogEx('TCADCrossObject.Destroy', E.Message); end; end; { TCADCrossObjectElement } procedure TCADCrossObjectElement.Assign(ACADCrossObjectElement: TCADCrossObjectElement); begin try FNpp := ACADCrossObjectElement.FNpp; FCableCapacity := ACADCrossObjectElement.FCableCapacity; FCableNameMark := ACADCrossObjectElement.FCableNameMark; FCableDiameter := ACADCrossObjectElement.FCableDiameter; FID := ACADCrossObjectElement.FID; FIDCADCrossObject := ACADCrossObjectElement.FIDCADCrossObject; //FIDInterface := ACADCrossObjectElement.FIDInterface; FIDComponent := ACADCrossObjectElement.FIDComponent; FSignType := ACADCrossObjectElement.FSignType; FConnectingTraceID := ACADCrossObjectElement.FConnectingTraceID; FAngle := ACADCrossObjectElement.FAngle; FInPointX := ACADCrossObjectElement.FInPointX; FInPointY := ACADCrossObjectElement.FInPointY; except on E: Exception do AddExceptionToLogEx('TCADCrossObjectElement.Assign', E.Message); end; end; constructor TCADCrossObjectElement.Create; begin inherited; try FNpp := ''; FCableCapacity := 0; FCableNameMark := ''; FCableDiameter := 0; FID := -1; FIDCADCrossObject := -1; //FIDInterface := -1; FIDComponent := -1; FSignType := oitDefault; FConnectingTraceID := -1; FAngle := 0; FInPointX := 0; FInPointY := 0; except on E: Exception do AddExceptionToLogEx('TCADCrossObjectElement.Create', E.Message); end; end; destructor TCADCrossObjectElement.destroy; begin inherited; end; end.