unit U_ESCadClasess; //{J+} 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, FastStrings, PCLayerDlg, OleCtnrs, buttons, PCgui, GuiStrings, Math, RichForm, Contnrs, U_HouseClasses{Tolik}, U_BaseConstants, cxClasses, U_Common_Classes; const dimp_draw = 1.1; //1.25; //0.75; dimp_add = 1; //2; dim2: double = 2; dim02: double = 0.2; dim1: double = 1; dim4: double = 4; Type TPolyArr = array [1..4] of TPoint; TClickType = (ct_Single, ct_Double); TConnectorType = (ct_Clear, ct_NB, ct_Default); TOrthoLineType = (ot_Clear, ot_NB, ot_Default); // стиль трассы (под потолком, пустая, до 10 кабелей, до 10 в коробе, более 10 кабелей) TTraceStyle = (ts_UnderFalseFloor, ts_ClearTrace, ts_Until10, ts_Until10InCorob, ts_Over10); // тип с-п линии (подъем, спуск, отсутсвует) TLineRaiseType = (lrt_Up, lrt_Down, lrt_None); // Степень заполнения интерфейсов компонентов (кабели и точ. компоненты) TComponInterfacesFullness = (cif_None, cif_Empty, cif_HalfEmpty, cif_Full); // Степень дефектности TDefectDegree = (dodNone, dodNormal, dodDefect, dodPartDefect); // Вершина с-п - тип: обычный, межэтажный, отсутсвует TConnRaiseType = (crt_None, crt_OnFloor, crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown); // Тип сети в объекте TObjectNetworkTypes = set of (nt_All, nt_Computer, nt_Telephon, nt_Television, nt_Gas, nt_Electric); // Тип рисования стрелок к подписям для NotesGroup TNotesRowsType = (nr_AutoSide, nr_UpLeftSide, nr_DownLeftSide, nr_UpRightSide, nr_DownRightSide); // Тип отображения длинны линии: над линией, под линией // Tolik -- 30/11/2015 // TLineCaptionsViewType = (cv_OverLine, cv_UnderLine); // добавлены новые свойства cv_Center -- по центру линии, cv_Auto -- над линией, если в надписи одна строка, иначе - по центру TLineCaptionsViewType = (cv_OverLine, cv_UnderLine, cv_Center, cv_Auto); // // Тип отображения подписи к коннекторам: вверху, внизу, слева, справа TConnCaptionsViewType = (cv_Up, cv_Down, cv_Left, cv_Right); // Tolik 10/02/2021 -- добавлен тип листа "lt_ElScheme" для однолинейной электрической схемы // Тип листа (обычный или дизайн шкафа) //TListType = (lt_Normal, lt_DesignBox, lt_ProjectPlan); //TListType = (lt_Normal, lt_DesignBox, lt_ProjectPlan, lt_ElScheme); TListType = (lt_Normal, lt_DesignBox, lt_ProjectPlan, lt_ElScheme, lt_AScheme); // Tolik -- добавлен тип листа для монтажной схемы щитка // // Тип размещения точ. объектов TConnTracingType = (ctt_FromCeiling, ctt_FromFalseFloor, ctt_FromFloor); // Тип прокладки трассы/кабеля/короба TLineTracingType = (ltt_FromCeiling, ltt_FromFalseFloor, ltt_FromFloor, ltt_FromConnObjects); // Тип уголка TCornerType = (crn_None, crn_Out, crn_In, crn_Vertical, crn_Adapter); // Тип кабинета TCabinetType = (ct_Virtual, ct_Visual); // Тип отображения измерительной линии TDimLinesType = (dlt_None, dlt_Row, dlt_Stroke); // TRtfNoteType = (rnt_Caption, rnt_Note, rnt_None); TRtfObjectType = (rot_Line, rot_Conn, rot_None); // тип печати TPrintType = (pt_Black, pt_Color); // тип листа СКС TSCSType = (st_NoChoose, st_Internal, st_External); // тип трассировки (от РМ или от КО) TWayType = (wt_Begin, wt_End); // Тип длины новых трасс - авто, пользовательская TTraceLengthType = (tltNone, tltAuto, tltUser); //Tolik 04/09/2017 -- TOrthoLineCrossInfo = Record StartPoint: TDoublePoint; EndPoint: TDoublePoint; DrawColor: Integer; DrawFigureType: Integer; CrossLineID: Integer; disttoFirstPoint: Double; isDrawPoint: Boolean; isCritical: Byte; end; POrthoLineCrossInfo = ^TOrthoLineCrossInfo; // TFigureGrpMod = class; TFigureGrpNotMod = class; TConnectorObject = class; TOrthoLine = class; TRichTextMod = class; TPlanObject = class; TPlanConnector = class; TPlanTrace = class; TCabinet = class; TCabinetNumber = class; TSCSFigureGrp = class; ///----------- ОРТОЛИНИЯ------------------------------------------------------ TOrthoLine = class(TLine) private FOrthoLineTypeIndex: integer; FDrawFigureIndex: integer; FSingleBlockIndex: integer; FMultilineCaptionBoxIndex: integer; FCaptionsGroupIndex: integer; FNotesGroupIndex: integer; FLength: Double; FOrthoLineType: TOrthoLineType; FDrawFigure: TFigureGrpMod; FGroupObjectIndex: Integer; FJoinFigure1Index: integer; FJoinFigure2Index: integer; FObjectFromRaisedLineIndex: Integer; FJoinFigure1IndexForGrp: integer; FJoinFigure2IndexForGrp: integer; FObjectFromRaisedLineIndexForGrp: Integer; //FWasIsSnap: boolean; //удалить самыков FisSnap: Boolean; function GetActualZOrder(Index: Integer): Double; procedure SetActualZOrder(Index: Integer; const Value: Double); procedure SetDrawFigure(const Value: TFigureGrpMod); procedure SetOrthoLineType(const Value: TOrthoLineType); procedure SetLineLength(const Value: Double); procedure SetIsSnap(const Value: Boolean); protected FActualZOrder: Array of Double; procedure DrawVertical(ADEngine: TPCDrawEngine); public isTraceShow: Boolean; // режим показа трассы до сервера IsShowBlock: Boolean; // отображать усл.обозначение FIsRaiseUpDown: Boolean; FIsVertical: Boolean; ShowLength: Boolean; // показывать длину трассы ShowCaptions: Boolean; // показывать подписи ShowNotes: Boolean; // показывать выноски IsLengthAboveLimit: Boolean; // в трассе есть кабель с превышающей длиной FNotRecalcLength: Boolean; FConnectingLine: Boolean; // св-ва измененнных полей FIsNameChanged: Boolean; FIsCaptionsChanged: Boolean; FIsNotesChanged: Boolean; FIsBlockChanged: Boolean; FCaptionsFontBold: Boolean; FExistOtherObjectType: Boolean; FIsRotated: Boolean; FIsCableChannel: Boolean; FOrthoStatus: Boolean; FMarkTracing: Boolean; FDisableTracing: Boolean; FIsDraw: Boolean; //05.04.2011 // Shadow tmpDrawShadow: Boolean; tmpWasOrtho: Boolean; tmpShadowP1: TDoublePoint; tmpShadowP2: TDoublePoint; FCount: Integer; // кол-во линий FIndex: Integer; // Индекс объекта FBlockID: Integer; // BLOCK ID FObjectType: Integer; FTraceWidth: Integer; FCabinetID: Integer; FConnectingPos: Integer; tmpParentDupID: Integer; FCaptionsFontSize: Integer; FNotesFontSize: Integer; FCaptionsFontColor: Integer; FNotesFontColor: Integer; FTagPM: Integer; FDrawColor: Integer; FDrawStyle: Integer; GrpSizeX: Double; // размеры одиночного блока GrpSizeY: Double; BlockStep: Double; // шаг усл.обозначения FGap: Double; // расстояние UserLength: Double; // юзер-длина CalculLength: Double; // вычисляемая длина FDrawFigureAngle: Double; FSingleBlockDelta: Double; FOriginalSizeX: Double; FOriginalSizeY: Double; FDrawFigurePercent: Double; DrawFigureH: Double; CaptionsGroupH: Double; FCaptionsFontName: string; FNotesFontName: string; FTrunkNumber: string; FBlockGUID: string; // BLOCK GUID FMark: string; SaveCaption: String; NotesGroup: TFigureGrpNotMod; OutTextCaptions: TStringList; OutTextNotes: TStringList; FTraceCaptionsList: TStringList; tmpCaptionsGroup: TFigure; tmpCaptions: TFigure; tmpNotesCaptions: TFigure; JoinConnector1: TFigure; // соединитель 1 JoinConnector2: TFigure; // соединитель 2 FTextBox: TFigure; MultilineCaptionBox: TFigure; FObjectFromRaisedLine: TConnectorObject; FSingleBlock: TFigureGrpMod; // Одиночный блок CaptionsGroup: TFigureGrpNotMod; // *** FCableFullnessSide1: TComponInterfacesFullness; // заполненность интерфейсов кабелей сторона1 FCableFullnessSide2: TComponInterfacesFullness; // заполненность интерфейсов кабелей сторона2 FCableChannelFullness: TComponInterfacesFullness; // заполненность кабельных каналов FCableChannelClosedSide1: TComponInterfacesFullness; // закрытость/открытость каб.канала сторона1 FCableChannelClosedSide2: TComponInterfacesFullness; // закрытость/открытость каб.канала сторона2 FDefectDegree: TDefectDegree; // степень дефектности // *** FLineType: TTraceStyle; // тип линии (действующая, проектируемая) FLineRaiseType: TLineRaiseType; FNetworkTypes: TObjectNetworkTypes; // типы сетей объекта FNotesRowsType: TNotesRowsType; FCaptionsViewType: TLineCaptionsViewType; // вид отображения трасс FTraceColor: TColor; FTraceStyle: TPenStyle; // если в группе - ссылка на группу FGroupObject: TSCSFigureGrp; F3DObject: TObject; FRegionPoints: array[0..4] of TPoint; FRegionPointsIsActual: boolean; //Tolik 04/09/2017 -- CrossList: TList; // property isSnap: Boolean read FisSnap write SetIsSnap; // есть привязка property ActualZOrder[Index: Integer]: Double read GetActualZOrder write SetActualZOrder; property LineLength: Double read FLength write SetLineLength; property DrawFigure: TFigureGrpMod read FDrawFigure write SetDrawFigure; property OrthoLineType: TOrthoLineType read FOrthoLineType write SetOrthoLineType; //Tolik -- 24/11/2015 { constructor create(aX1, aY1, aZ1, aX2, aY2, aZ2 : Double; w: Integer; s: Integer; c: Integer; row: Integer; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent; aCreateCaptionNotes: Boolean = True); } constructor create(aX1, aY1, aZ1, aX2, aY2, aZ2 : Double; w: Integer; s: Integer; c: Integer; row: Integer; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent; aCreateCaptionNotes: Boolean = True; aCanRecalcCaptionsGroupPos: Boolean = True); // destructor Destroy; override; procedure Select; override; procedure Initialize; override; function getclred: TColor; procedure Draw(DEngine: TPCDrawEngine; isFlue: Boolean); override; procedure DrawTraceStyle(ADEngine: TPCDrawEngine); procedure DrawActiveTrace(ADEngine: TPCDrawEngine; aPoint1, aPoint2: TDoublePoint); procedure DrawProjectibleTrace(ADEngine: TPCDrawEngine; aPoint1, aPoint2: TDoublePoint); procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); override; procedure GetBoundsWithOutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); override; //procedure GetModPoints(ModList: TList); override; procedure GetModPoints(ModList: TMyList); override; // Tolik 24/12/2019 -- procedure Move(deltax, deltay: Double); override; procedure MoveOrthoLine(deltax, deltay: Double); procedure Delete; // DELETE!!! // Tolik -- 20/04/2017 -- //procedure SetJConnector1(jc: TFigure); //procedure SetJConnector2(jc: TFigure); // переписано, чтобы можно было в зависимости от параметра изменить координаты края ортолинии // на координаты коннектора, который задан на соответствующем крае procedure SetJConnector1(jc: TFigure; CanChangeActuals: Boolean = True); procedure SetJConnector2(jc: TFigure; CanChangeActuals: Boolean = True); // procedure MoveTextBox(MvFig: TObject; Point1, Point2: TDoublePoint; isMove: Boolean); procedure UpdateLengthTextBox(aNeedReCreate: Boolean; aReturnToPos: Boolean); // //procedure ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean); // Tolik -- 01/11/2015 -- procedure ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean; OldCaptionList: TStringList = nil; OldH: Double = -1; OldW: Double = -1); // function CreateNotesRowGroup(ANotesRowsType: TNotesRowsType; aDeltaLineX: Double = -1; aDeltaLineY: Double = -1): TFigureGrpNotMod; procedure ReCreateNotesGroup(aNeedReCreate: Boolean = False); //Tolik Procedure CheckDrawFigure(aFigure: TFigureGrpMod); procedure ReCreateDrawFigureBlock; Procedure Deselect; override; // procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; // 31.07.2015 Tolik //procedure RaiseProperties; Procedure RaiseProperties(CadFigList: TList); // procedure ReRaiseProperties; function ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; override; function ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; override; function CreateModification: TFigure; override; function TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x: Double; y: Double; Shift: TShiftState): Boolean; override; function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x: Double; y: Double; Shift: TShiftState): Boolean; override; function isPointIn(x,y: Double): boolean; override; function Duplicate: TFigure; override; function GetAngle(AP1x, AP1y, AP2x, AP2y: Double): Double; // Tolik 22/10/2015 для фигуры отрисовки (без округления) function GetAngleDF(AP1x, AP1y, AP2x, AP2y: Double): Double; // function LengthCalc: Double; function AngleCalc(X1, Y1, Z1, X2, Y2, Z2: Double): Double; function AngleCalcDF(X1, Y1, Z1, X2, Y2, Z2: Double): Double; function MoveMultilineCaptionCalc(X1, Y1, Z1, X2, Y2, Z2, Angle, CaptionH: Double): TDoublePoint; function TextRotate(OldAngle, NewAngle: Double): Double; // Tolik -- 30/11/2015 -- //function CaptionsGroupRemoveCalc(TBGrpCP, OldAP1, OldAP2, NewAP1, NewAP2: TDoublePoint; aH: Double): TDoublePoint; function CaptionsGroupRemoveCalc(TBGrpCP, OldAP1, OldAP2, NewAP1, NewAP2: TDoublePoint; aH: Double; LineCount : Integer): TDoublePoint; function DrawFigureRemoveCalc(TBGrpCP, OldAP1, OldAP2, NewAP1, NewAP2: TDoublePoint; aH: Double): TDoublePoint; function CalcHDrawFigure: Double; function CalcHCaptionsGroup: Double; // Tolik -- 30/11/2015 // function GetCaptionsGroupNewPos(ADelta: Double): TDoublePoint; function GetCaptionsGroupNewPos(ADelta: Double; LineCount: Integer): TDoublePoint; // function GetAngleInRad(aX1, aY1, aX2, aY2: Double): Double; function GetAllBlocks(ADuplicateBlock: TFigureGrpMod): TFigureGrpMod; function CreateDuplicate: TOrthoLine; function CheckTraceNotHaveConnect(CheckAll: boolean = True): Boolean; function GetBreakPointOnShadowTrace(P1, P2: TDoublePoint; aCtrl: Boolean = False): TDoublePoint; function ConnectorByNum(aNum: Integer): TConnectorObject; //12.03.2012 procedure SetNewLength(aVal: Double); class function CreateFromShadow(aOwner: TComponent; LHandle: Longint; Shadow: TFigure): TFigure; override; class function CreateShadow(x, y: Double): TFigure; override; end; ///----------- CONNECTOR ----------------------------------------------------- TConnectorObject = class(TFigure) private FConnectorTypeIndex: Integer; FDrawFigureIndex: Integer; FCaptionsGroupIndex: Integer; FNotesGroupIndex: Integer; FActualZOrder: Array of Double; FDrawFigure: TFigureGrpMod; FConnectorType: TConnectorType; //FDrawStyle: TDrawStyle; FGroupObjectIndex: Integer; FObjectFromRaiseIndex: Integer; FObjectFromRaiseIndexForGrp: Integer; FHouseIndex: Integer; FisSnap : Boolean; //06.11.2013 самыков FindSnapTimer : TTimer; FFindSnapEnable : Boolean; FDeltaPoint : TDoublePoint; function GetActualZOrder(Index: Integer): Double; procedure SetActualZOrder(Index: Integer; const Value: Double); procedure SetDrawFigure(const Value: TFigureGrpMod); procedure SetConnectorType(const Value: TConnectorType); procedure SetIsSnap(const Value: Boolean); procedure OnFindSnapTimer(Sender:TObject);//ther test protected // прорисовка стрелки-подъема procedure DrawRaiseUp(ADEngine: TPCDrawEngine; AObjectFromRaise: TConnectorObject); procedure DrawRaiseDown(ADEngine: TPCDrawEngine; AObjectFromRaise: TConnectorObject); public // Tolik 02/04/2018 -- FJoinedOrthoLinesByVerticals: TList; // список трасс, присоединенных через вертикальные трассы (сидят на их коннекторах) // isPrevSnap: Boolean; // предыдущая привязка AsEndPoint: Boolean; // как текущий объект ShowCaptions: Boolean; // показывать подписи ShowNotes: Boolean; // показывать выноски FCornerTypeChangedByUser: Boolean; // св-ва измененнных полей FIsNameChanged: Boolean; FIsCaptionsChanged: Boolean; FIsNotesChanged: Boolean; FIsBlockChanged: Boolean; FDisableTracing: Boolean; FMirrored: Boolean; FIsApproach: Boolean; FIsHouseJoined: Boolean; FIsDraw: Boolean; //05.04.2011 FIndex: Integer; // Индекс объекта // для межэтажных переходов FID_ListToPassage: Integer; FID_ConnToPassage: Integer; FBlockID: Integer; // BLOCK ID FObjectType: Integer; FBlockCount: Integer; FCabinetID: Integer; tmpParentDupID: Integer; FCaptionsFontSize: Integer; FNotesFontSize: Integer; FCaptionsFontColor: Integer; FNotesFontColor: Integer; FTagPM: Integer; FComponID: Integer; // св-во для шкафа, привязка к листу FJoinedListIDForBox: Integer; FLHandle: Longint; FJoinedConnectorsIndexes: array of Integer; // массив присоединенных коннекторов FJoinedConnectorsIndexesForGrp: array of Integer; // массив присоединенных коннекторов для группы GrpSizeX: Double; // размер X GrpSizeY: Double; // размер Y FDrawFigureAngle: Double; FDrawFigureMoved: Boolean; FOriginalSizeX: Double; FOriginalSizeY: Double; FDrawFigurePercent: Double; FRaiseShiftX: Double; FRaiseShiftY: Double; FCaptionsFontName: string; FNotesFontName: string; FBlockGUID: string; // BLOCK GUID FMark: string; FTrunkName: string; // системное имя для магистрали OutTextCaptions: TStringList; OutTextNotes: TStringList; RemJoined: TList; // темп. удаление присоединенных объектов JoinedOrtholinesList: TList; // привязанные ортолинии JoinedConnectorsList: TList; // привязанные коннекторы tmpCaptionsGroup: TFigure; tmpNotesCaptions: TFigure; FTextBox: TFigure; CaptionsGroup: TRichTextMod; NotesGroup: TFigureGrpNotMod; // *** FConnFullness: TComponInterfacesFullness; // заполненность интерфейсов точ. объектов FDefectDegree: TDefectDegree; // степень дефектности // *** // для подъемов FConnRaiseType: TConnRaiseType; FObjectFromRaise: TConnectorObject; FNetworkTypes: TObjectNetworkTypes; // типы сетей объекта FNotesRowsType: TNotesRowsType; FCaptionsViewType: TConnCaptionsViewType; // тип уголка для коннектора FCornerType: TCornerType; // если в группе - ссылка на группу FGroupObject: TSCSFigureGrp; FHouse: THouse; F3DObject: TObject; FIsRotating: Boolean; //11.03.2012 //23.07.2013 FModPosOffset: TDoublePoint; FModConnsOtherSides: TList; // Соединители с других сторон трасс //Tolik 08/11/2017 -- RedRect: array[1..2] of TDoublePoint; // ByDrawF: integer; property HouseIndex: integer read FHouseIndex; // Tolik 13/02/2020 -- property ActualZOrder[Index: Integer]: Double read GetActualZOrder write SetActualZOrder; property DrawFigure: TFigureGrpMod read FDrawFigure write SetDrawFigure; property ConnectorType: TConnectorType read FConnectorType write SetConnectorType; property isSnap: Boolean read FisSnap write SetIsSnap; // есть привязка constructor Create(aX, aY, aZ: Double; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent); destructor Destroy; override; procedure Select; override; procedure DeSelect; override; procedure CreateSnapTimer(CheckDrawStyle: Boolean = True); procedure Initialize; override; procedure Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override; procedure GetBoundsDef(var figMaxX, figMaxY, figMinX, figMinY: Double); // Tolik 09/03/2021 -- procedure GetBounds(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure getboundsWithoutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); override; procedure Delete(Recurse: Boolean = True; DelRaise: Boolean = True); /// DELETE !!! // Tolik 06/08/2018 -- Function isToRaise: Boolean; //Function GetSelPoints: TList; Function GetSelPoints: TMyList; // Tolik 24/12/2019 -- // //procedure GetModPoints(ModList: TList); override; procedure GetModPoints(ModList: TMyList); override; // Tolik 24/12/2019 -- // MOVE !!! procedure Move(deltax: Double; deltay: Double); override; //Tolik 03/08/2021 -- //procedure MoveP(deltax: Double; deltay: Double; FindSnap: Boolean = True);// override; procedure MoveP(deltax: Double; deltay: Double; FindSnap: Boolean = True; aCanAlign: Boolean = True); // procedure MoveConnector(deltax, deltay: Double; aFindSnap: Boolean = True; aMoveByVertical: Boolean = False; CheckDelta: Boolean = True); procedure MoveRaiseConnector(deltax, deltay: Double); procedure MoveBetweenRaiseConnector(deltax, deltay: Double); procedure FindObjectsOnMove(deltax, deltay: Double); procedure ReMoveJoinedOrthoLines(AJoinedLine: TOrthoLine; deltax, deltay: Double; CheckDelta: boolean = True); procedure DrawSnapFigures(FFigure: TFigure; SetSnapStatus: Boolean); procedure ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean); procedure ReCreateNotesGroup(aNeedReCreate: Boolean = False); //Stream procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; //Tolik procedure RaiseProperties(CadFigList: TList); //procedure RaiseProperties; procedure ReRaiseProperties; // for DrawShadow Connected Lines procedure SetConnectedLinesDrawShadow(X, Y: Double); procedure SkipConnectedLinesDrawShadow; procedure SetDrawFigurePercent(aPercent: Double); function ShadowClick(ClickIndex: Integer; x: Double; y: Double): Boolean; override; function ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; override; function IsPointIn(x: Double; y: Double): Boolean; override; function IsPointInDrawFigure(x: Double; y: Double): Boolean; function duplicate: TFigure; override; function CreateModification: TFigure; override; function CreateRotModification: TFigure; //11.03.2012 function TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x: Double; y: Double; Shift: TShiftState): Boolean; override; function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x: Double; y: Double; Shift: TShiftState): Boolean; override; //11.03.2012 Function TraceRotate(CadControl: Pointer;mp:TModPoint;var TraceFigure:TFigure; x,y:Double;Shift: TShiftState):boolean; override; //11.03.2012 Function EndRotate(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure; x,y:Double;Shift: TShiftState):boolean; override; // поиск объектов function FindSnapObject(aFindX, aFindY: Double): TFigure; // Проверить могут ли объекты привязываться function CanSnapToFindFigure(aFindedFigure: TFigure; aFindedList: TList): Boolean; // Создание дубликатов function CreateDuplicate(x, y: double): TConnectorObject; function CreateCrossATSDuplicate(x, y: double): TConnectorObject; function CreateDistribCabDuplicate(x, y: double): TConnectorObject; function CreateNotesRowGroup(ANotesRowsType: TNotesRowsType; aDeltaLineX: Double = -1; aDeltaLineY: Double = -1): TFigureGrpNotMod; function GetPosWithAngle(aX, aY, aAngle: Double): TDoublePoint; function IsApproachInHouse(adeltax, adeltay: double): Boolean; procedure RotateByParams(aAngleRad: Double; aPoint: TDoublePoint); //11.03.2012 //Procedure Rotate(aAngle: Double; cPoint: TDoublePoint); override; //30.08.2012 procedure DefRaizeDrawFigurePos; //28.05.2013 class function CreateShadow(x: Double; y: Double): TFigure; override; class function CreateFromShadow(aOwner: TComponent; LHandle: Longint; Shadow: TFigure) : TFigure; override; //Tolik 08/06/2017-- //Procedure AddAutoCreatedObjsToDrawFigure(Angle, aTransparency: Integer; cpx, cpy, Radius, CutRadius: Double; FillColor: TColor; ACutStyle: TPieCutStyle; aRotateAngle: integer = -1); Procedure AddAutoCreatedObjsToDrawFigure(AFigClassName: String; AParamList: TStringList); //Procedure RemoveAutoCreatedObjsFromDrawFigure; //Procedure DrawRaise; // end; ///------------ TEXT OBJECT (длина линии)------------------------------------ TTextMod = class(TText) procedure Select; override; //procedure getModPoints(ModList: TList); override; procedure getModPoints(ModList: TMyList); override; procedure GetBounds(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure GetBoundsWithoutGrpSize(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; function isPointIn(x: Double; y: Double): Boolean; override; public procedure Delete; end; ///----------- FIGURE GROUP (DrawFigure) ------------------------------------- TFigureGrpMod = class(TFigureGrp) //procedure getModPoints(ModList: TList); override; procedure getModPoints(ModList: TMyList); override; procedure GetBounds(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure GetBoundsWithoutGrpSize(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure select; override; function IsPointIn(x: Double; y: Double): Boolean; override; public FNetworkTypes: TObjectNetworkTypes; // типы сетей объекта (отображать вид точ.объекта) // Для подъездов fFromApproach: TConnectorObject; fFromHouse: THouse; fRMode: Boolean; fTraceMod: Boolean; fHasParent: Boolean; procedure move(deltax, deltay: double);override; Function EndRotate(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure; x,y:Double;Shift: TShiftState): boolean; override; Function TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; override; Function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double;Shift: TShiftState): boolean; override; // ************** constructor create(LHandle: LongInt;aOwner: TComponent); procedure Delete; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override; function Duplicate: TFigure; override; // Tolik -- 11/08/2017 -- Procedure RemoveAutoCreatedFigures; // end; ///----------- МАКЕТ ЭТАЖА --------------------------------------------------- TFrame = class(TBlock) public constructor create(LHandle: Longint; aOwner: TComponent); destructor Destroy; override; procedure Select; override; procedure Move(deltax, deltay: double); override; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; procedure RaiseProperties; function IsPointIn(x: Double; y: Double): Boolean; override; end; /// -------- СКС DimLines ---------------------------------------------------- TSCSHDimLine = class(THDimLine) Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override; Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override; class Function CreateShadow(x,y:Double): TFigure;override; private class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override; public FValue: Double; Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override; Procedure ReScaleHCAD(aOldValue, aNewValue: Double); Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; Function GetValue: Double; Function Edit: Boolean; override; // Function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean; override; end; TSCSVDimLine = class(TVDimLine) Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override; Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override; class Function CreateShadow(x,y:Double): TFigure;override; private class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override; public FValue: Double; Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override; Procedure ReScaleVCAD(aOldValue, aNewValue: Double); Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; Function GetValue: Double; Function Edit: Boolean; override; Function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean; override; end; ///----------- FIGURE GROUP (для выносок, ShadowObject еще) ------------------ TFigureGrpNotMod = class (TFigureGrp) public ShadowCP: TDoublePoint; fHasParent: boolean; procedure Move(deltax: Double; deltay: Double); override; procedure Delete; procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override; //procedure getModPoints(ModList: TList); override; procedure getModPoints(ModList: TMyList); override; procedure GetBounds(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure GetBoundsWithoutGrpSize(var figMaxX: Double; var figMaxY: Double; var figMinX: Double; var figMinY: Double); override; procedure select; override; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; function IsPointIn(x: Double; y: Double): Boolean; override; Function Edit: Boolean; override; function Duplicate: TFigure; override; end; ///----------- RICH TEXT (для подписей) -------------------------------------- TRichTextMod = class(TRichText) public fHasParent: boolean; constructor create(aX1, aY1, aX2, aY2: Double; w, s, c, abrs, abrc: integer; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent; aObjectType: TRtfObjectType; aNoteType: TRtfNoteType; aAlignment: Integer = 0; AText: Boolean=true); procedure Delete; procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean); override; Procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; Function Edit: Boolean; override; end; // ---------------- ДЛЯ КАБИНЕТОВ -------------------------------------------- TCabinet = class(TRectangle) private FNumberObjectIndex: Integer; public FSCSID: Integer; FIndex: Integer; FFalseFloorHeight: Double; FType: TCabinetType; FNumberObject: TCabinetNumber; // Tolik (площадь кабинета) FCabinetSquare: Double; // CabinetConfig: TRoomConfig; constructor create(aX1, aY1, aX2, aY2: Double; w, s, c, abrs, abrc: integer; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent); destructor Destroy; override; procedure select; override; procedure Delete; procedure Draw(DEngine: TPCDrawEngine; isFlue: Boolean); override; procedure Move(deltax, deltay: Double); override; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; //Tolik //procedure RaiseProperties; procedure RaiseProperties(CadFigList: TList); // Function Edit: Boolean; override; function isPointIn(x,y:Double): boolean;override; function isPointInMod(x,y:Double): boolean; Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override; class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure;override; procedure Initialize; override; end; TCabinetExt = class(TPolyLine) private FNumberObjectIndex: Integer; public FSCSID: Integer; FIndex: Integer; FFalseFloorHeight: Double; FType: TCabinetType; FNumberObject: TCabinetNumber; // Tolik (площадь кабинета) FCabinetSquare: Double; // CabinetConfig: TRoomConfig; constructor create(Points: TDoublePointArr; w, s, c, abrs, abrc: integer; row: integer; aClosed: Boolean; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent); destructor Destroy; override; procedure select; override; procedure Delete; procedure Draw(DEngine: TPCDrawEngine; isFlue: Boolean); override; procedure Move(deltax, deltay: Double); override; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; //Tolik //procedure RaiseProperties; procedure RaiseProperties(CadFigList: TList); // Function Edit: Boolean; override; function isPointIn(x,y:Double): boolean;override; function isPointInMod(x,y:Double): boolean; Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override; class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure;override; procedure Initialize; override; procedure CenterNumberObject; end; TCabinetNumber = class(TFigureGrp) public FCabinetID: Integer; FPositionIndex: Integer; IsCabinetExt: Boolean; CircleRadius: Integer; procedure Draw(DEngine: TPCDrawEngine; isFlue: Boolean); override; procedure Delete; procedure Select; override; Procedure WriteToStream(Stream:TStream);override; Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override; function isPointIn(x,y: double): boolean;override; Function Edit: Boolean; override; end; // ------------ ДЛЯ ПЛАНА ЗДАНИЯ --------------------------------------------- TPlanObject = class(TFigureGrp) private FJoinedConnectorsIndexes: array of Integer; public FMoveWithConnector: Boolean; FSCSID: Integer; FFloorNumber: Integer; FCabNumber: Integer; FSizeX: Double; FSizeY: Double; JoinedConnectors: TList; constructor create(LHandle: LongInt; aOwner: TComponent); // Tolik --23/02/2018 -- destructor Destroy; override; // procedure Delete; procedure move(deltax, deltay: double); override; Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; //Tolik //procedure RaiseProperties; procedure RaiseProperties(CadFigList: TList); // Function Edit: Boolean; override; function IsPointIn(x: Double; y: Double): Boolean; override; end; TPlanConnector = class(TConnectorObject) private FJoinedPlanObjectIndex: integer; FJoinedTracesIndexes: array of Integer; public FBegType: string; FEndType: string; FBegSCSID: Integer; FEndSCSID: Integer; JoinedTraces: TList; JoinedPlanObject: TPlanObject; constructor Create(aX, aY, aZ: Double; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent); // -- Tolik -- 23/02/2018 -- destructor destroy; override; // procedure Delete; procedure move(deltax, deltay: double); override; Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; //Tolik //procedure RaiseProperties; procedure RaiseProperties(CadFigList: TList); // function IsPointIn(x: Double; y: Double): Boolean; override; end; TPlanTrace = class(TLine) private FJoinObject1Index: integer; FJoinObject2Index: integer; FCaptionIndex: Integer; public FBegType: string; FEndType: string; FBegSCSID: Integer; FEndSCSID: Integer; JoinObject1: TFigure; JoinObject2: TFigure; Caption: TRichText; constructor create(aX1, aY1, aX2, aY2: Double; w: Integer; s: Integer; c: Integer; row: Integer; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent); //Tolik 23/02/2018 -- destructor destroy; override; // procedure Delete; //procedure GetModPoints(ModList: TList); override; procedure getModPoints(ModList: TMyList); override; procedure SetJConnector1(aObject: TFigure); procedure SetJConnector2(aObject: TFigure); procedure Draw(DEngine: TPCDrawEngine; isFlue: Boolean); override; procedure Move(deltax, deltay: Double); override; procedure WriteToStream(Stream: TStream); override; procedure SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); override; //Tolik //procedure RaiseProperties; procedure RaiseProperties(CadFigList: TList); // function isPointIn(x,y: Double): boolean; override; function CreateModification: TFigure; override; end; // Ведомость норм TCadNorms = class(TFigureGrp) public fTableWidth: Integer; fTextSize: Integer; fTextStyle: TFontStyles; fNumberSize: Double; fNameSize: Double; fIzmSize: Double; fCountSize: Double; fColumnSize: Double; fLineHeight: Double; FNormsList: TObjectList; constructor Create(LHandle: LongInt; aOwner: TComponent); Procedure Build; Procedure ReBuild; procedure DrawTable; function DrawTextFileds(aBnd: TDoubleRect): Boolean; function DrawTextToField(aFieldBnd: TDoubleRect; aText: string; aCentered: Boolean = True; aMaxWidth: Double = -1): Double; procedure Delete; //Tolik destructor destroy; override; // Procedure WriteToStream(Stream:TStream);override; Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override; function isPointIn(x,y: double): boolean;override; Function Edit: Boolean; override; end; // SCS FigureGroup TSCSFigureGrp = class(TFigureGrp) public constructor create(LHandle: LongInt; aOwner: TComponent); procedure UnGroup; procedure move(deltax, deltay: double); override; procedure getbounds(var figMaxX, figMaxY, figMinX, figMinY: double); override; procedure getboundsWithOutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: double); override; Procedure scale(percentx, percenty: double; rPoint: Tdoublepoint); override; procedure Delete; Function Edit: Boolean; override; function isPointIn(x, y: double): boolean; override; Function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; override; Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; //Tolik procedure RaiseProperties(CadFigList: TList); // Procedure Rotate(aAngle: Double; cPoint: TDoublePoint); override; //30.08.2012 end; TBetweenFloorDownVertex = class(TVertex) class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override; end; TBetweenFloorUpVertex = class(TVertex) class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override; end; implementation uses U_Common, U_CAD, USCS_Main, U_Main, Types, U_DimLineDialog, RichEdit2, U_ProjectPlan, U_BaseCommon, U_SCSComponent, U_TrunkSCS, U_Constants, U_Protection, U_SCSClasses, {Tolik}FPlan, U_SCSLists; destructor TCabinet.Destroy; begin if TDrawStyle(DrawStyle) <> dsTrace then begin try if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then TF_CAD(TPowerCad(Owner ).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TCabinet.Destroy FNeedUpdateCheckedFigures', E.Message); end; end; inherited; end; destructor TCabinetExt.Destroy; begin if TDrawStyle(DrawStyle) <> dsTrace then begin try if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then TF_CAD(TPowerCad(Owner ).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TCabinetExt.Destroy FNeedUpdateCheckedFigures', E.Message); end; end; inherited; end; //============================================================================== //============== ORTHOLINE ===================================================== //============================================================================== function TOrthoLine.LengthCalc: Double; var X1, X2, Y1, Y2, Z1, Z2: Double; Length_X, Length_Y, Length_Z: Double; GetPointObject: TConnectorObject; StrLength: String; DblLength: Double; begin try Result := 0; X1 := ActualPoints[1].x; X2 := ActualPoints[2].x; Y1 := ActualPoints[1].y; Y2 := ActualPoints[2].y; Z1 := ActualZOrder[1]; Z2 := ActualZOrder[2]; /////////// пересчет длинн трасс ///////////////////////////////////////// // Side = 1 if (JoinConnector1 = nil) or not (CheckFigureByClassName(JoinConnector1, cTConnectorObject)) then begin X1 := ActualPoints[1].x; Y1 := ActualPoints[1].y; end else begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then begin X1 := ActualPoints[1].x; Y1 := ActualPoints[1].y; end else begin // !!! GetPointObject := TConnectorObject(JoinConnector1).JoinedConnectorsList[0]; if CheckTrunkObject(GetPointObject) then begin X1 := ActualPoints[1].x; Y1 := ActualPoints[1].y; end else begin X1 := GetPointObject.ActualPoints[1].x; Y1 := GetPointObject.ActualPoints[1].y; end; end; Z1 := ActualZOrder[1]; end; // Side = 2 if (JoinConnector2 = nil) or not (CheckFigureByClassName(JoinConnector2, cTConnectorObject)) then begin X2 := ActualPoints[2].x; Y2 := ActualPoints[2].y; end else begin if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then begin X2 := ActualPoints[2].x; Y2 := ActualPoints[2].y; end else begin GetPointObject := TConnectorObject(JoinConnector2).JoinedConnectorsList[0]; if CheckTrunkObject(GetPointObject) then begin X2 := ActualPoints[2].x; Y2 := ActualPoints[2].y; end else begin X2 := GetPointObject.ActualPoints[1].x; Y2 := GetPointObject.ActualPoints[1].y; end; end; Z2 := ActualZOrder[2]; end; if GCadForm.PCad.RulerMode = rmPage then begin Length_X := abs(X1 - X2) / 10; Length_Y := abs(Y1 - Y2) / 10; end else if GCadForm.PCad.RulerMode = rmWorld then begin Length_X := abs(X1 - X2) / 1000 * GCadForm.PCad.MapScale; Length_Y := abs(Y1 - Y2) / 1000 * GCadForm.PCad.MapScale; end; Length_Z := abs(Z1 - Z2); DblLength := SQRT(SQR(Length_X) + SQR(Length_Y) + SQR(Length_Z)); // StrLength := FormatFloat(ffMask, DblLength); Result := DblLength;//StrToFloat_My(StrLength); if FIsRaiseUpDown then begin // if FLineRaiseType = lrt_Down then // Result := - Result; end; if Result = 0 then ShowLength := False; except on E: Exception do addExceptionToLogEx('TOrthoLine.LengthCalc', E.Message); end; end; function TOrthoLine.AngleCalc(X1, Y1, Z1, X2, Y2, Z2: Double): Double; var Len_X, Len_Y, Len_Z: Double; AngleA: Double; Degree: Double; begin try Result := 0; Degree := 0; Len_X := X1 - X2; Len_Y := Y1 - Y2; Len_Z := Z1 - Z2; if Len_X = 0 then Len_X := 0.001; Degree := ArcTan(Len_Y / Len_X) * 180 / pi; // в градусах Degree := round(Degree); if Degree = 90 then Degree := -90; Result := Degree / 180 * pi; // в радианах except on E: Exception do addExceptionToLogEx('TOrthoLine.AngleCalc', E.Message); end; end; function TOrthoLine.AngleCalcDF(X1, Y1, Z1, X2, Y2, Z2: Double): Double; var Len_X, Len_Y, Len_Z: Double; AngleA: Double; Degree: Double; begin try Result := 0; Degree := 0; Len_X := X1 - X2; Len_Y := Y1 - Y2; Len_Z := Z1 - Z2; if Len_X = 0 then Len_X := 0.001; Degree := ArcTan(Len_Y / Len_X); Result := Degree; // в радианах except on E: Exception do addExceptionToLogEx('TOrthoLine.AngleCalcDF', E.Message); end; end; function TOrthoLine.MoveMultilineCaptionCalc(X1, Y1, Z1, X2, Y2, Z2, Angle, CaptionH: Double): TDoublePoint; begin try Result.x := 0; Result.y := 0; if (X1 = X2) then Exit else Result.y := - CaptionH; except on E: Exception do addExceptionToLogEx('TOrthoLine.MoveMultilineCaptionCalc', E.Message); end; end; function TOrthoLine.TextRotate(OldAngle, NewAngle: Double): Double; var Diff: Double; begin try Result := 0; Diff := - OldAngle + NewAngle; if Diff > 360 then Diff := round(Diff) mod 360; Result := Diff; except on E: Exception do addExceptionToLogEx('TOrthoLine.TextRotate', E.Message); end; end; //////////////////////////////////////////////////////////////////////////////// // Tolik --24/11/2015 -- {constructor TOrthoLine.Create(aX1, aY1, aZ1, aX2, aY2, aZ2: Double; w: Integer; s: Integer; c: Integer; row: Integer; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent; aCreateCaptionNotes: Boolean = True);} constructor TOrthoLine.Create(aX1, aY1, aZ1, aX2, aY2, aZ2: Double; w: Integer; s: Integer; c: Integer; row: Integer; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent; aCreateCaptionNotes: Boolean = True; aCanRecalcCaptionsGroupPos: Boolean = True); // aCanRecalcCaptionsGroupPos -- добавлен параметр, чтобы не выравнивать положение CaptionsGroup, если идет дублирование линии // var i: integer; CPLine: TDoublePoint; CalcItemWidth: Double; CaptionsLHandle: integer; NotesLHandle: integer; Text_str: string; NotesRowsPoints: TDoublePoint; NotesRows: TFigureGrpNotMod; NotesCaptions: TRichTextMod; Captions: TRichTextMod; Background: TRectangle; Str: String; ProgramRegisterPro_2: Boolean; ProgramRegisterTrial_2: Boolean; addcod: integer; OldAP1, OldAP2: TDoublePoint; NewAP1, NewAP2: TDoublePoint; mydeltax, mydeltay: Double; CP: TDoublePoint; x1, y1, z1, x2, y2, z2: double; ResPoints: TDoublePoint; begin try {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IF Defined(FINAL_SCS) or Defined(TRIAL_SCS)} ProgramRegisterPro_2 := ProgProtection.CheckIsVer2(PRO, addcod); {$ELSE} ProgramRegisterPro_2 := True; {$IFEND} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IF Defined(TRIAL_SCS)} addcod := 0; {$IFEND} {$IF Not Defined(FINAL_SCS)} addcod := 0; {$IFEND} {$IF Defined(FINAL_SCS) and Not Defined(TRIAL_SCS)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} if Not ProgramRegisterPro_2 then exit; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IFEND} {$ELSE} addcod := 0; {$IFEND} {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IFEND} inherited create(aX1 + addcod, aY1 + addcod, aX2, aY2 + addcod, w, s, c, row, LHandle, aDrawStyle, aOwner); {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IFEND} //Initialize; OutTextCaptions := TStringList.Create; i := OutTextCaptions.Count; OutTextNotes := TStringList.Create; FTraceCaptionsList := TStringList.Create; // Tolik -- 06/10/2015 -- при каждом создании ортолинии коннекторы создаются отдельно и переприсваиваются, // а созданные коннекторы не убиваются... поэтому обнулил, т.к. нех множить утечки памяти // JoinConnector1 := TFigure.Create(LHandle, mydsNormal, aOwner); // JoinConnector2 := TFigure.Create(LHandle, mydsNormal, aOwner); JoinConnector1 := nil; JoinConnector2 := nil; // UserLength := -1; // пользовательская длина пока не задана FLineType := ts_ClearTrace; ShowLength := GCadForm.FShowLinesLength; IsShowBlock := True; ShowCaptions := GCadForm.FShowLinesCaptions; ShowNotes := GCadForm.FShowLinesNotes; //FWasIsSnap := False; FIsRaiseUpDown := False; FIsVertical := False; FLineRaiseType := lrt_None; FObjectFromRaisedLine := Nil; FIndex := -1; // заполненность интерфейсов FCableFullnessSide1 := cif_None; FCableFullnessSide2 := cif_None; FCableChannelFullness := cif_None; FCableChannelClosedSide1 := cif_None; FCableChannelClosedSide2 := cif_None; FDefectDegree := dodNormal; // aZ1 := GCadForm.FLineHeight; // aZ2 := GCadForm.FLineHeight; OriginalPoints[1] := DoublePoint(aX1,aY1); OriginalPoints[2] := DoublePoint(aX2,aY2); OriginalPoints[3] := DoublePoint(aX2,aY2); ActualPoints[1] := DoublePoint(aX1,aY1); ActualPoints[2] := DoublePoint(aX2,aY2); ActualZOrder[1] := aZ1; ActualZOrder[2] := aZ2; CaptionsLHandle := GCadForm.PCad.GetLayerHandle(3); NotesLHandle := GCadForm.PCad.GetLayerHandle(5); FOrthoLineType := ot_Clear; FDrawFigure := Nil; FDrawFigureIndex := 0; FOrthoLineTypeIndex := 0; FObjectType := 2; FCabinetID := -1; // Центр-точки ортолинии CPLine.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; CPLine.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; if DrawStyle = mydsNormal then begin FNotesRowsType := nr_AutoSide; FCaptionsViewType := cv_OverLine; FTraceColor := GCadForm.FDefaultTraceColor; FTraceStyle := GCadForm.FDefaultTraceStyle; FTraceWidth := GCadForm.FDefaultTraceWidth; FNotRecalcLength := False; FConnectingLine := False; FConnectingPos := -1; tmpParentDupID := -1; FOriginalSizeX := 0; FOriginalSizeY := 0; FDrawFigurePercent := 100; FCaptionsFontSize := GCadForm.FLinesCaptionsFontSize; FCaptionsFontBold := GCadForm.FLinesCaptionsFontBold; FNotesFontSize := GCadForm.FLinesNotesFontSize; FCaptionsFontName := GCadForm.FFontName; FNotesFontName := GCadForm.FFontName; FCaptionsFontColor := GCadForm.FLinesCaptionsColor; FNotesFontColor := GCadForm.FLinesNotesColor; FTrunkNumber := ''; FSingleBlockDelta := 0; FIsRotated := False; FIsCableChannel := False; // Shadow tmpDrawShadow := False; tmpWasOrtho := false; tmpShadowP1 := DoublePoint(-1, -1); tmpShadowP2 := DoublePoint(-1, -1); DrawFigureH := 0; CaptionsGroupH := 0; FTagPM := 0; // создать текст-обьект длинны линии CalculLength := LengthCalc; {//08.10.2012 - Чтобы была авто длина if GCadForm.FShowLineCaptionsType = skExternalSCS then UserLength := 0 else UserLength := -1;} //09.10.2012 if GCadForm.FNewTraceLengthType = tltUser then UserLength := 0 else UserLength := -1; LineLength := CalculLength; IsLengthAboveLimit := False; OutTextCaptions.Clear; Str := GetLineCaptionFormat(Self, GCadForm.FShowLineCaptionsType); // если тип подписи - внешние СКС, то создать сперва маркировку // Tolik 05/02/2021 -- {if GCadForm.FShowLineCaptionsType = skExternalSCS then begin OutTextCaptions.Add('0'); end; } OutTextCaptions.Add(Str); OutTextNotes.Clear; // Для усл.обозначений FSingleBlock := TFigureGrpMod.create(LHandle, aOwner); FDrawFigure := TFigureGrpMod.create(LHandle, aOwner); //////GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), FSingleBlock, False); GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), FDrawFigure, False); // Tolik // здесь FSingleBlock будет сидеть первой фигурой в фигуре отрисовки FDrawFigure.AddFigure(FSingleBlock); MoveTextBox(FDrawFigure, ActualPoints[1], ActualPoints[2], False); FDrawFigure.LockModify := True; IsShowBlock := True; BlockStep := GCadForm.FDefaultBlockStep; FDrawFigure.Visible := True; if FCount = 1 then FGap := 1; // Создавать подписи и выноски для данного объекта if aCreateCaptionNotes then begin Captions := TRichTextMod.create(0, 0, 0, 0, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption, 2); Captions.RE.Lines.Clear; Captions.RE.Font.Size := FCaptionsFontSize; Captions.re.Font.Name := FCaptionsFontName; Captions.re.Font.Color := FCaptionsFontColor; if FCaptionsFontBold then Captions.RE.Font.Style := [fsBold] else Captions.RE.Font.Style := []; Captions.re.Font.Name := FCaptionsFontName; if GCadForm.PCad.PageColor = 0 then Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor + 1 else Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor - 1; Captions.Visible := True; Background := TRectangle.create(0, 0, 0, 0, 1, ord(psClear), clNone, ord(bsClear), clNone, CaptionsLHandle, mydsNormal, GCadForm.PCad); CaptionsGroup := TFigureGrpNotMod.create(CaptionsLHandle, aOwner); CaptionsGroup.AddFigure(Background); CaptionsGroup.AddFigure(Captions); CaptionsGroup.LockModify := True; GCadForm.PCad.AddCustomFigure (GLN(CaptionsLHandle), CaptionsGroup, False); ReCreateCaptionsGroup(false, false); // Tolik --- 07/12/2015 --- // выставляем высоту расположения, чтобы можно было вернуть на высоту // CaptionsGroupH := CalcHCaptionsGroup; // // Tolik -- 24/11/2015 { if aCanRecalcCaptionsGroupPos then begin // // нужно для подравнивания подписи NewAP1 := ActualPoints[1]; NewAP2 := ActualPoints[2]; OldAP1 := ActualPoints[1]; OldAP2 := ActualPoints[2]; if CaptionsGroup <> nil then begin // пересоздать подпись в нужном месте ResPoints := CaptionsGroupRemoveCalc(CaptionsGroup.CenterPoint, OldAP1, OldAP2, NewAP1, NewAP2, CaptionsGroupH); UpdateLengthTextBox(false, false); CaptionsGroup.Move(ResPoints.x - CaptionsGroup.CenterPoint.x, ResPoints.y - CaptionsGroup.CenterPoint.y); // new mark - нужно будет возможно здесь дорихтовывать по аналогии с кодом в ReMoveJoinedOrthoLines end; end; } NotesRows := CreateNotesRowGroup(nr_AutoSide); NotesRows.Visible := True; NotesCaptions := TRichTextMod.create(0, 0, 0, 0, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note); NotesCaptions.RE.Lines.Clear; NotesCaptions.RE.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; NotesCaptions.Visible := True; // создать NotesGroup и перебросить в него обьекты NotesGroup := TFigureGrpNotMod.create(NotesLHandle, aOwner); NotesGroup.AddFigure(NotesRows); NotesGroup.AddFigure(NotesCaptions); NotesGroup.LockModify := True; NotesGroup.Radius := -1; GCadForm.PCad.AddCustomFigure (GLN(NotesLHandle), NotesGroup, False); ReCreateNotesGroup; end; // ДЛЯ МУЛЬТИЛИНИИ создать текст-обьект для названия линии if FCount > 1 then begin Text_str := ''; FTextBox := TTextMod.Create(CPLine.x, CPLine.y, cCadTextModHeight, cCadTextModWidth, Text_str, GCadForm.FFontName, RUSSIAN_CHARSET, clBlue, CaptionsLHandle, mydsNormal, aOwner); TTextMod(FTextBox).LockMove := true; TTextMod(FTextBox).LockModify := true; TFigure(FTextBox).SelOrder := ord(osBack); FTextBox.Move(- TTextMod(FTextBox).TextLength / 2, 0); MultilineCaptionBox := TFigure(FTextBox); MoveTextBox(MultilineCaptionBox, ActualPoints[1], ActualPoints[2], false); GCadForm.PCad.AddCustomFigure (GLN(CaptionsLHandle), MultilineCaptionBox, False); end; FTextBox := nil; FGroupObject := nil; F3DObject := nil; end; FIsDraw := false; //05.04.2011 if aDrawStyle <> dsTrace then begin // Tolik -- высота размещения надписи -- 09/12/2015 Self.CaptionsGroupH := Self.CalcHCaptionsGroup; // TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.Create', E.Message); end; end; procedure TOrthoLine.MoveTextBox(MvFig: TObject; Point1: TDoublePoint; Point2: TDoublePoint; isMove: Boolean); var MvAngle: Double; MvMoveDelta: TDoublePoint; MvTextRotate: Double; CapH: Double; i: integer; DrawPoint: TDoublePoint; begin try // для MultilineCaptionBox if (MvFig = MultilineCaptionBox) then begin // подсчитать угол поворота // Tolik 25/11/2015 // MvAngle := AngleCalc(Point1.x, Point1.y, ActualZOrder[1], Point2.x, Point2.y, ActualZOrder[2]); MvAngle := AngleCalcDF(Point1.x, Point1.y, ActualZOrder[1], Point2.x, Point2.y, ActualZOrder[2]); // CapH := TTextMod(MultilineCaptionBox).Height / 2; if isMove = False then begin TFigure(MvFig).Rotate(MvAngle, TFigure(MvFig).CenterPoint); end else if isMove = True then begin MvTextRotate := TextRotate(MultilineCaptionBox.Angle, MvAngle); TFigure(MvFig).Rotate(MvTextRotate, TFigure(MvFig).CenterPoint); end; MvMoveDelta := MoveMultilineCaptionCalc(Point1.x, Point1.y, ActualZOrder[1], Point2.x, Point2.y, ActualZOrder[2], MvAngle, CapH); if isMove = False then TFigure(MvFig).Move(MvMoveDelta.x, MvMoveDelta.y); end; // DrawFigure if (MvFig = DrawFigure) then begin FTextBox := TFigureGrpMod(MvFig); // подсчитать угол поворота MvAngle := AngleCalcDF(Point1.x, Point1.y, ActualZOrder[1], Point2.x, Point2.y, ActualZOrder[2]); DrawPoint := FTextBox.CenterPoint; if FSingleBlock.InFigures.Count > 0 then begin DrawPoint.y := TFigureGrpMod(FSingleBlock.InFigures[0]).CenterPoint.y; end; if isMove = False then FTextBox.Rotate(MvAngle, DrawPoint) else if isMove = True then begin MvTextRotate := TextRotate(0, MvAngle); FTextBox.Rotate(MvTextRotate, DrawPoint); end; // 180 // if FIsRotated then // FTextBox.Rotate(pi, DrawPoint); // подсчитать перемещение if isMove = False then begin MvMoveDelta.x := (Point1.x + Point2.x) / 2 - FTextBox.CenterPoint.x; MvMoveDelta.y := (Point1.y + Point2.y) / 2 - FTextBox.CenterPoint.y; FTextBox.Move(MvMoveDelta.x, MvMoveDelta.y); end; FDrawFigureAngle := MvAngle; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.MoveTextBox', E.Message); end; end; function TOrthoLine.CaptionsGroupRemoveCalc(TBGrpCP, OldAP1, OldAP2, NewAP1, NewAP2: TDoublePoint; aH: Double; LineCount: Integer): TDoublePoint; var OldA, OldB, OldC: Double; NewA, NewB, NewC: Double; OldPart1, OldPart2: Double; NewPart1, NewPart2: Double; H, P: Double; KoefPart: Double; AngleDegrees: Double; AngleRad: Double; dx, dy: Double; divPoint: TDoublePoint; PointPos: boolean; //Tolik FontStyles: TFontStyles; OutTextStrings: TStringList; Captions: TRichTextMod; dd: double; // функция для определения положения надписи относительно линии // при автоматическом расположении (если пользователь сам куда-то надпись утащил) // здесь нужно знать сверху или снизу, чтобы правильно определить смещения для поворота // практически, нужно определить координаты основания перпендикуляра на линию из центра надписи // и по ним будет видно function GetCaptAutoPosition: boolean; var PPoint: TDoublePoint; begin Result := False; {A(xa,ya) и B(xb,yb) — прямая, O(xo,yo) — основание перпендикуляра, опущенного из точки P(xp,yp). Если xa = xb (вертикаль), то xo = xa и yo = yp. Если ya = yb (горизонталь), то xo = xp и yo = ya. Во всех остальных случаях xo = (xa*(yb-ya)^2 + xp*(xb-xa)^2 + (xb-xa) * (yb-ya) * (yp-ya)) / ((yb-ya)^2+(xb-xa)^2); yo = (yb-ya)*(xo-xa)/(xb-xa)+ya.} // - здесь пока большой ХЗ -- вертикальная трасса в 3д // if (OldAP1.x = OldAP2.x) and (OldAP1.y = OldAP2.y) then // это вертикаль в 3Д if ((CompareValue(OldAP1.x, OldAP2.x) = 0) and (CompareValue(OldAP1.y, OldAP2.y) = 0)) then exit; // вертикаль //if OldAP1.x = OldAP2.x then if CompareValue(OldAP1.x, OldAP2.x) = 0 then begin PPoint.x := OldAP1.x; PPoint.y := TBGrpCP.y; end else // горизонталь // if OldAP1.y = OldAP2.y then if CompareValue(OldAP1.y, OldAP2.y) = 0 then begin PPoint.x := TBGrpCP.x; PPoint.y := OldAP1.y; end else // наклонная (на плоскости) // if (OldAP1.x <> OldAP2.x) and (OldAP1.y <> OldAP2.y) then if (CompareValue(OldAP1.x, OldAP2.x) <> 0) and (CompareValue(OldAP1.y, OldAP2.y) <> 0) then begin PPoint.x := (OldAP1.x*SQR(OldAP2.y - OldAP1.y) + TBGrpCP.x*SQR(OldAP2.x - OldAP1.x) + (OldAP2.x - OldAP1.x)* (OldAP2.y - OldAP1.y)*(TBGrpCP.y - OldAP1.y)) /(sqr(OldAP2.y - OldAP1.y)+sqr(OldAP2.x - OldAP1.x)); PPoint.y := ((OldAP2.y - OldAP1.y)*(PPoint.x - OldAP1.x))/(OldAP2.x - OldAP1.x) + OldAP1.y; end; // ОПРЕДЕЛЯЕМ НАД ЛИНИЕЙ // вертикаль //if PPoint.x = OldAP1.x then // Result := (PPoint.x < TBGrpCP.x); if CompareValue(PPoint.x, OldAP1.x) = 0 then Result := (CompareValue(PPoint.x , TBGrpCP.x) = -1) else // горизонталь (и наклонная - одно##йственно) //if CompareValue(PPoint.y, OldAP1.y) = 0 then Result := (CompareValue(PPoint.y , TBGrpCP.y) = 1); end; begin try Result := DoublePoint(0, 0); PointPos := GetCaptAutoPosition; if FIsRaiseUpDown then begin Result.x := TBGrpCP.x + (NewAP1.x - OldAP1.x); Result.y := TBGrpCP.y + (NewAP1.y - OldAP1.y); end else begin OldA := SQRT(SQR(OldAP1.x - OldAP2.x ) + SQR(OldAP1.y - OldAP2.y )); if OldA = 0 then begin Result.x := TBGrpCP.x; Result.y := TBGrpCP.y; Exit; end; OldB := SQRT(SQR(OldAP1.x - TBGrpCP.x ) + SQR(OldAP1.y - TBGrpCP.y )); if OldB < 0.00001 then OldB := 0; OldC := SQRT(SQR(OldAP2.x - TBGrpCP.x ) + SQR(OldAP2.y - TBGrpCP.y )); if OldC < 0.00001 then OldC := 0; // Tolik --25/11/2015 -- не юзается - нех вычислять { P := (OldA + OldB + OldC) / 2; if P < 0.00001 then P := 0; } { try H := (2 * SQRT(P * (P - OldA) * (P - OldB) * (P - OldC))) / OldA; except H := 0; end; } H := aH; // OldPart1 := SQRT(SQR(OldB) - SQR(H)); OldPart2 := SQRT(SQR(OldC) - SQR(H)); ///////////////////////////////////// NewA := SQRT(SQR(NewAP1.x - NewAP2.x) + SQR(NewAP1.y - NewAP2.y)); KoefPart := NewA / OldA; NewPart1 := KoefPart * OldPart1; NewPart2 := KoefPart * OldPart2; NewB := SQRT(SQR(NewPart1) + SQR(H)); NewC := SQRT(SQR(NewPart2) + SQR(H)); // получить точку пересечения //Tolik -- 25/11/2015 //AngleDegrees := GetAngle(NewAP1.x, NewAP1.y, NewAP2.x, NewAP2.y); //AngleDegrees := round(AngleDegrees) mod 360; AngleDegrees := GetAngleDF(NewAP1.x , NewAP1.y, NewAP2.x, NewAP2.y); While AngleDegrees > 360 do AngleDegrees := AngleDegrees - 360; // AngleRad := AngleDegrees * pi / 180; // Tolik -- 16/12/2015 -- перекрытие FDrawfigure { if ((FCaptionsViewType <> cv_Center) and (FCaptionsViewType <> cv_Auto)) then begin dx := NewPart1 * Cos(AngleRad) + GrpSizeY * Cos(AngleRad); dy := NewPart1 * Sin(AngleRad) + GrpSizeY * Sin(AngleRad); end else begin} dx := NewPart1 * Cos(AngleRad); dy := NewPart1 * Sin(AngleRad); //end; // divPoint.x := NewAP1.x + dx; divPoint.y := NewAP1.y + dy; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; // Tolik -- 25/11/2015 // While AngleDegrees > 360 do While AngleDegrees > 360 do AngleDegrees := AngleDegrees - 360; //AngleDegrees := round(AngleDegrees) mod 360; // AngleRad := AngleDegrees * pi / 180; dx := H * Cos(AngleRad); dy := H * Sin(AngleRad); if (AngleDegrees >= 0) and (AngleDegrees <= 180) then begin dx := -dx; dy := -dy; end; // свойство отображения if GCadForm.FShowLineCaptionsType = skExternalSCS then begin dx := -dx; dy := -dy; end else begin // над линией // Tolik -- 30/11/2015 -- // if FCaptionsViewType = cv_OverLine then if FCaptionsViewType = cv_OverLine then //or ((FCaptionsViewType = cv_Auto) and (LineCount = 1))) then // begin dx := dx; dy := dy; end else // под линией if FCaptionsViewType = cv_UnderLine then begin dx := -dx; dy := -dy; end //Tolik --09/12/2015 // по центру else if FCaptionsViewType = cv_Center then begin dx := 0; dy := 0; { AngleDegrees := GetAngleDF(NewAP1.x , NewAP1.y, NewAP2.x, NewAP2.y); While AngleDegrees > 360 do AngleDegrees := AngleDegrees - 360; // AngleRad := AngleDegrees * pi / 180; dx := 0.75 * Cos(AngleRad); AngleRad := AngleRad + pi; dy := 0.25*Sin(AngleRad); if (AngleDegrees >= 90) and (AngleDegrees <= 180) then begin dx := dx; dy := dy; end; if (AngleDegrees >= 180) and (AngleDegrees <= 270) then begin //dd := dx; //dx := -dy; //dy := dx; dx := -dx; dy := -dy; end; if (AngleDegrees >= 270) and (AngleDegrees <= 360) then begin dx := -dx; dy := -dy; end; if (AngleDegrees >= 0) and (AngleDegrees <= 90) then begin dx := dx; dy := dy; end; { FontStyles := []; if FCaptionsFontBold then FontStyles := [fsBold]; Captions := TRichTextMod(CaptionsGroup.InFigures[1]); if Captions.re.Lines.Count > 0 then begin //OutTextStrings.Text := Captions.re.Text; GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', OutTextCaptions, dy, dx); dx := -(dx+3)/8; dy := dy/4; end;} end // авто else // if ((FCaptionsViewType = cv_Auto) and (not PointPos)) then if FCaptionsViewType = cv_Auto then begin if PointPos then begin dx := dx; dy := dy; end; if Not PointPos then begin dx := -dx; dy := -dy; end; end; end; Result.x := divPoint.x + dx; Result.y := divPoint.y + dy; end; except Result.x := TBGrpCP.x; Result.y := TBGrpCP.y; // on E: Exception do addExceptionToLogEx('TOrthoLine.TextBoxesGrpRemoveCalc', E.Message); end; end; // Tolik -- 30/11/2015 -- // function TOrthoLine.GetCaptionsGroupNewPos(ADelta: Double): TDoublePoint; function TOrthoLine.GetCaptionsGroupNewPos(ADelta: Double; LineCount: Integer): TDoublePoint; var HalfPart: Double; AngleDegrees: Double; AngleRad: Double; dx, dy: Double; CPLine: TDoublePoint; begin try Result := DoublePoint(0, 0); CPLine.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; CPLine.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; if GCadForm.FShowLineCaptionsType = skExternalSCS then begin // dx := 0; // dy := 0; HalfPart := SQRT(SQR(ActualPoints[1].x - CPLine.x) + SQR(ActualPoints[1].y - CPLine.y)); // получить точку пересечения AngleDegrees := GetAngle(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; AngleDegrees := round(AngleDegrees) mod 360; AngleRad := AngleDegrees * pi / 180; //23/12/2015 if FCaptionsViewType = cv_UnderLine then ADelta := ADelta + 0.25; // dx := ADelta * Cos(AngleRad); dy := ADelta * Sin(AngleRad); if (AngleDegrees >= 0) and (AngleDegrees < 180) then begin dx := -dx; dy := -dy; end; // свойство отображения dx := -dx; dy := -dy; end else begin HalfPart := SQRT(SQR(ActualPoints[1].x - CPLine.x) + SQR(ActualPoints[1].y - CPLine.y)); // получить точку пересечения //Tolik -- 03/12/2015 // AngleDegrees := GetAngle(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); AngleDegrees := GetAngleDF(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); // AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; // Tolik 25/11/2015 // AngleDegrees := round(AngleDegrees) mod 360; While AngleDegrees > 360 do AngleDegrees := AngleDegrees - 360; // AngleRad := AngleDegrees * pi / 180; //Tolik -- 16/12/2015 if FCaptionsViewType = cv_UnderLine then ADelta := ADelta + 0.25; dx := (ADelta + GRPSizeY/2) * Cos(AngleRad); dy := (ADelta + GRPSizeY/2) * Sin(AngleRad); //dx := ADelta * Cos(AngleRad); //dy := ADelta * Sin(AngleRad); // if (AngleDegrees >= 0) and (AngleDegrees < 180) then begin dx := -dx; dy := -dy; end; // свойство отображения // над линией // Tolik -- 30/11/2015 -- if FCaptionsViewType = cv_OverLine then //if ((FCaptionsViewType = cv_OverLine) or ((FCaptionsViewType = cv_Auto) and (LineCount = 1))) then // begin dx := dx; dy := dy; end else // под линией if FCaptionsViewType = cv_UnderLine then begin dx := -dx; dy := -dy; end else if FCaptionsViewType = cv_Center then begin dx := 0; dy := 0; end; end; // Result.x := CPLine.x + dx; Result.y := CPLine.y + dy; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetCaptionsGroupNewPos', E.Message); end; end; procedure TOrthoLine.Initialize; begin try inherited; FClassIndex := ciOrthoLine; //04.11.2011 FGap := GDefaultGap; FCount := GDefaultNum; FOrthoStatus := GOrthoStatus; if FCount < 1 then FCount := 1; if FCount > 100 then FCount := 100; if FCount = 1 then FGap := 0.1; FRegionPoints[0].x := 0; FRegionPoints[0].y := 0; FRegionPoints[1].x := 0; FRegionPoints[1].y := 0; FRegionPoints[2].x := 0; FRegionPoints[2].y := 0; FRegionPoints[3].x := 0; FRegionPoints[3].y := 0; FRegionPoints[4].x := 0; FRegionPoints[4].y := 0; FRegionPointsIsActual := false; //Tolik 04/03/2017 -- CrossList := TList.Create; // except on E: Exception do addExceptionToLogEx('TOrthoLine.Initialize', E.Message); end; end; function TOrthoLine.getclred: TColor; begin result := clRed; if Self.Owner <> nil then if TPowerCad(Self.Owner).Owner <> nil then if TF_Cad(TPowerCad(Self.Owner).Owner).FListSettings.ShowTracesCrossPoints = 2 then // result := RGB(255, 187, 187); //clPurple; result := RGB($FF, $AA, $AA); end; procedure TOrthoLine.Draw(DEngine: TPCDrawEngine; isFlue: Boolean); var points: array[0..2] of TDoublePoint; endp: TDoublePoint; len, f, Gap2, XGap: Extended; x1, y1, x2, y2, x3, y3, resx1, resx2, resx3, resy1, resy2, resy3: Double; i, j, k, dynarrlen: Integer; EndPointsColor: Integer; ActualsArrayCount: Integer; tracecount: Integer; isLineConnected: Boolean; IsDraw: Boolean; ActualsCount: integer; CrossPoint1, CrossPoint2: TDoublePoint; BasisPoints: TDoublePoint; RaizeKoeff: double; // Tolik 05/09/2017 -- PointInfo: POrthoLineCrossInfo; FirstLinePoint, LastLinePoint, LastPoint, LinePoint, p1, p2: TDoublePoint; reg: HRGN; l: Integer; // Tolik 11/09/2017 -- LinePenstyle: TPenStyle; LineWidth: Integer; LineColor: Integer; isDrawTraceStyle: Boolean; //CanCheckColor: Boolean; CurrFTraceColor: TColor; AlternateTraceColor: TColor; ShowCriticalCrossPoints: Boolean; Procedure SetDrawLineProps; begin try if GCadForm.FKeepLineTypesRules then begin if FLineType = ts_UnderFalseFloor then begin LinePenstyle := psDash; LineWidth := 1; end; if FLineType = ts_ClearTrace then begin LinePenstyle := psDashDot; LineWidth := 1; end; if FLineType = ts_Until10 then begin LinePenstyle := psSolid; LineWidth := 1; end; if FLineType = ts_Until10InCorob then begin LinePenstyle := psSolid; // Внешние СКС if GCadForm.FShowLineCaptionsType = skExternalSCS then LineWidth := 1 else LineWidth := 2; end; if FLineType = ts_Over10 then begin LinePenstyle := psSolid; // Внешние СКС if GCadForm.FShowLineCaptionsType = skExternalSCS then LineWidth := 1 else LineWidth := 3; end; if FIsRaiseUpDown then begin LinePenstyle := psClear; LineWidth := 1; end; if GCadForm.FShowLineCaptionsType = skExternalSCS then begin if FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin LinePenstyle := psDash; LineColor := clBlack; LineWidth := 2; end; if GCadForm.FPrintType = pt_Color then begin LinePenstyle := psDash; LineColor := clRed; LineWidth := 1; end; end; end; end else begin LinePenstyle := FTraceStyle; LineWidth := FTraceWidth; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.SetDrawLineProps', E.Message); end; end; // begin try If Deleted then Exit; // Tolik 29/03/2021 -- x3 := 0; y3 := 0; // //Tolik 11/09/2017 -- isDrawTraceStyle := False; AlternateTraceColor := 0; ShowCriticalCrossPoints := False; if Self.Owner <> nil then if TPowerCad(Self.Owner).Owner <> nil then if TF_Cad(TPowerCad(Self.Owner).Owner).FListSettings.ShowTracesCrossPoints = 2 then ShowCriticalCrossPoints := True; If DrawStyle = mydsNormal then begin if tmpDrawShadow then begin x1 := tmpShadowP1.x; y1 := tmpShadowP1.y; x2 := tmpShadowP2.x; y2 := tmpShadowP2.y; Points[0].x := x1; Points[0].y := y1; Points[1].x := x2; Points[1].y := y2; DEngine.Canvas.Pen.Mode := pmXor; DEngine.Canvas.Pen.Color := clBlue xor clWhite; DEngine.Canvas.Pen.Style := psDash; DEngine.Canvas.Pen.Width := 1; DEngine.Canvas.Brush.Style := bsClear; DEngine.Canvas.Brush.Color := clBlack; DEngine.DrawLine(points[0], points[1]); // Tolik 21/04/2018 -- чтобы не потерять оригинальное изображение трассы при обновлении Када (а то оставался только SHADOW) if GCadForm <> nil then if not GCadForm.PCad.isDrawingFigures then Exit; end; end; // TRACE ---------------------------------------- if (DrawStyle = dsTrace) then begin if FIsRaiseUpDown then begin RaizeKoeff := 1; if (FIsRaiseUpDown) and (FObjectFromRaisedLine <> nil) and (ConnectorDetect(FObjectFromRaisedLine)) then begin RaizeKoeff := Self.FDrawFigurePercent / 100; if FObjectFromRaisedLine.DrawFigure.InFigures.Count = 0 then begin BasisPoints.x := FObjectFromRaisedLine.ActualPoints[1].x + FObjectFromRaisedLine.GrpSizeX / 2; BasisPoints.y := FObjectFromRaisedLine.ActualPoints[1].y - FObjectFromRaisedLine.GrpSizeY / 2; end else begin BasisPoints.x := FObjectFromRaisedLine.DrawFigure.CenterPoint.x + FObjectFromRaisedLine.GrpSizeX / 2; BasisPoints.y := FObjectFromRaisedLine.DrawFigure.CenterPoint.y - FObjectFromRaisedLine.GrpSizeY / 2; end; {if FLineRaiseType = lrt_Up then begin x1 := BasisPoints.x; y1 := BasisPoints.y; x2 := BasisPoints.x + (2.5*RaizeKoeff); y2 := BasisPoints.y - (2.5*RaizeKoeff); end else if FLineRaiseType = lrt_Down then begin x1 := BasisPoints.x + (1.5*RaizeKoeff); y1 := BasisPoints.y - (1.5*RaizeKoeff); x2 := BasisPoints.x + (4*RaizeKoeff); y2 := BasisPoints.y - (4*RaizeKoeff); end; } BasisPoints := GetBasisPointByObjFromRaise(FObjectFromRaisedLine); CrossPoint1.x := BasisPoints.x; CrossPoint1.y := BasisPoints.y; CrossPoint2.x := BasisPoints.x + Round4(4 * RaizeKoeff); CrossPoint2.y := BasisPoints.y - Round4(4 * RaizeKoeff); //DEngine.DrawLine(CrossPoint1, CrossPoint2); actuals[0] := CrossPoint1; actuals[1] := CrossPoint2; FIsRaiseUpDown := False; end; end; DEngine.Canvas.Pen.Mode := pmXor; //Tolik 03/02/2022 -- //DEngine.Canvas.Pen.Color := clBlue xor clWhite; DEngine.Canvas.Pen.Color := clLime; // DEngine.Canvas.Pen.Style := psDash; DEngine.Canvas.Pen.Width := 1; //Tolik 03/02/2022 -- //DEngine.Canvas.Brush.Style := bsClear; //DEngine.Canvas.Brush.Color := clBlack; // if GCadForm.PCad.ToolIdx = toSelect then begin x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; end else begin x1 := OriginalPoints[1].x; y1 := OriginalPoints[1].y; x2 := OriginalPoints[2].x; y2 := OriginalPoints[2].y; x3 := OriginalPoints[3].x; y3 := OriginalPoints[3].y; end; end else // NORMAL -------------------------------------- begin // if DrawFigure <> nil then // DrawFigure.Visible := IsShowBlock; // if FSingleBlock <> nil then // FSingleBlock.Visible := IsShowBlock; // if FIsRaiseUpDown then // begin // DrawFigure.Visible := False; // FSingleBlock.Visible := False; // end; // типы сетей IsDraw := IsViewObjectInCurrentNetwork(Self); FIsDraw := IsDraw; //05.04.2011 if IsDraw then begin if CaptionsGroup <> nil then CaptionsGroup.Visible := ShowCaptions; if Assigned(NotesGroup) then begin if IsNoteExist(NotesGroup) then NotesGroup.Visible := ShowNotes else NotesGroup.Visible := False; end; if DrawFigure <> nil then DrawFigure.Visible := IsShowBlock; if FSingleBlock <> nil then FSingleBlock.Visible := IsShowBlock; if FIsRaiseUpDown then if Not TF_CAD(TPowerCad(Owner).Owner).FListSettings.CADShowRaiseDrawFigure then //28.05.2013 begin //Tolik if DrawFigure <> nil then // DrawFigure.Visible := False; //Tolik if FSingleBlock <> nil then // FSingleBlock.Visible := False; end; // if FSingleBlock <> nil then // FSingleBlock.Visible := True; // if DrawFigure <> nil then // DrawFigure.Visible := True; // Tolik 16/04/2020 -- этот блок нужен как раз здесь... если оставить ниже -- как был, то // при фильтрации по типам сетей на Каде останутся подписи и выноски к райзам, что не комильфо..... if FIsRaiseUpDown then begin if CaptionsGroup <> nil then begin if GCadForm.FShowRaise then begin CaptionsGroup.Visible := ShowCaptions; end else begin CaptionsGroup.Visible := False; end; end; if NotesGroup <> nil then begin if IsNoteExist(NotesGroup) then begin if GCadForm.FShowRaise then begin NotesGroup.Visible := ShowNotes; end else begin NotesGroup.Visible := False; end; end else NotesGroup.Visible := False; end; end; end else begin if CaptionsGroup <> nil then CaptionsGroup.Visible := False; if Assigned(NotesGroup) then NotesGroup.Visible := False; if FSingleBlock <> nil then FSingleBlock.Visible := False; if DrawFigure <> nil then DrawFigure.Visible := False; end; { if FIsRaiseUpDown then begin if CaptionsGroup <> nil then begin if GCadForm.FShowRaise then begin CaptionsGroup.Visible := ShowCaptions; end else begin CaptionsGroup.Visible := False; end; end; if NotesGroup <> nil then begin if IsNoteExist(NotesGroup) then begin if GCadForm.FShowRaise then begin NotesGroup.Visible := ShowNotes; end else begin NotesGroup.Visible := False; end; end else NotesGroup.Visible := False; end; end; } if not IsDraw then Exit; if GCadForm.FShowCableChannelsOnly then if not FIsCableChannel then begin DrawFigure.Visible := False; FSingleBlock.Visible := False; Exit; end; DEngine.Canvas.Pen.Mode := pmCopy; // подложка! if isFlue then DEngine.Canvas.Pen.Color := clGray else DEngine.Canvas.Pen.Color := FTraceColor; //Tolik 31/08/2021 -- Это перенесено сюда, чтобы было выше, чем отрисовка снапа, чтобы если на трассу будет снап, // даже если трасса выделена -- чтобы было видно, что снап if not FIsRaiseUpDown then begin // линия выделенная if Selected then begin try if JoinConnector1 <> nil then begin if not JoinConnector1.Selected then begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then //Tolik 03/02/2022 -- // EndPointsColor := clGreen EndPointsColor := $00E8731A // else EndPointsColor := clRed; DEngine.drawrect(ActualPoints[1].x - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[1].y - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[1].x + dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[1].y + dimp_draw / (GCadForm.PCad.ZoomScale / 100), EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); end; end; except JoinConnector1 := nil; end; try if JoinConnector2 <> nil then begin if not JoinConnector2.Selected then begin if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then //Tolik 03/02/2022 -- // EndPointsColor := clGreen EndPointsColor := $00E8731A // else EndPointsColor := clRed; DEngine.drawrect(ActualPoints[2].x - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[2].y - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[2].x + dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[2].y + dimp_draw / (GCadForm.PCad.ZoomScale / 100), EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); end; end; except JoinConnector2 := nil; end; DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Style := psSolid; if GCadForm.PCad.Focused then DEngine.Canvas.Pen.Color := clBlue else DEngine.Canvas.Pen.Color := clGray; end; end; {***********************************************} // отображаеться как трасса! (жирный красный) if isTraceShow then begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Width := 2; DEngine.Canvas.Pen.Color := clRed; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end else // возможность привязки! (красный) if (isSnap){ or (InsideCabinet) }then begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Width := 3; DEngine.Canvas.Pen.Color := clRed; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; //FWasIsSnap := True; test ther end else // трасса отмечена для трассировки if FMarkTracing then begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Width := 3; DEngine.Canvas.Pen.Style := psDot; DEngine.Canvas.Pen.Color := clGreen; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end else // трасса отмечена для запрета трассировки через нее if FDisableTracing then begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Width := 3; DEngine.Canvas.Pen.Style := psDot; DEngine.Canvas.Pen.Color := clGray; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end else if InsideCabinet then begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Width := 3; DEngine.Canvas.Pen.Color := $1f7ffa; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end else begin if FIsRaiseUpDown then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else begin DrawTraceStyle(DEngine); if Not CmpFloatByCP(ActualZOrder[1], ActualZOrder[2]) then begin if FIsVertical then DEngine.Canvas.Pen.Color := clMaroon else DEngine.Canvas.Pen.Color := clLime; end; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end; end; //FWasIsSnap:=false; // D0000006113 { закомментировал самыков 01.11.2013 //(*if FWasIsSnap and Not isSnap then*) //begin // DEngine.Canvas.Pen.Width := 3; // DEngine.Canvas.Pen.Color := GCadForm.PCad.PageColor; // FWasIsSnap := False; //end; } DEngine.canvas.Brush.Style := bsClear; {***********************************************} (* if not FIsRaiseUpDown then begin // линия выделенная if Selected then begin try if JoinConnector1 <> nil then begin if not JoinConnector1.Selected then begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then EndPointsColor := clGreen else EndPointsColor := clRed; DEngine.drawrect(ActualPoints[1].x - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[1].y - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[1].x + dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[1].y + dimp_draw / (GCadForm.PCad.ZoomScale / 100), EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); end; end; except JoinConnector1 := nil; end; try if JoinConnector2 <> nil then begin if not JoinConnector2.Selected then begin if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then EndPointsColor := clGreen else EndPointsColor := clRed; DEngine.drawrect(ActualPoints[2].x - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[2].y - dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[2].x + dimp_draw / (GCadForm.PCad.ZoomScale / 100), ActualPoints[2].y + dimp_draw / (GCadForm.PCad.ZoomScale / 100), EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); end; end; except JoinConnector2 := nil; end; DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Style := psSolid; if GCadForm.PCad.Focused then DEngine.Canvas.Pen.Color := clBlue else DEngine.Canvas.Pen.Color := clGray; end; end; *) {***********************************************} // отобразить заполненность объектов // кабели if GCadForm.FShowCableFullness then begin // Side = 1 if FCableFullnessSide1 = cif_None then EndPointsColor := clBlack; if FCableFullnessSide1 = cif_Empty then EndPointsColor := clRed; if FCableFullnessSide1 = cif_HalfEmpty then EndPointsColor := clYellow; if FCableFullnessSide1 = cif_Full then EndPointsColor := clGreen; DEngine.drawrect(ActualPoints[1].x - dimp_draw, ActualPoints[1].y - dimp_draw, ActualPoints[1].x + dimp_draw, ActualPoints[1].y + dimp_draw, EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); // Side = 2 if FCableFullnessSide2 = cif_None then EndPointsColor := clBlack; if FCableFullnessSide2 = cif_Empty then EndPointsColor := clRed; if FCableFullnessSide2 = cif_HalfEmpty then EndPointsColor := clYellow; if FCableFullnessSide2 = cif_Full then EndPointsColor := clGreen; DEngine.drawrect(ActualPoints[2].x - dimp_draw, ActualPoints[2].y - dimp_draw, ActualPoints[2].x + dimp_draw, ActualPoints[2].y + dimp_draw, EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); DEngine.Canvas.Pen.Color := FTraceColor; if FIsRaiseUpDown then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else if ActualZOrder[1] <> ActualZOrder[2] then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Color := FTraceColor; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end; end; // кабельные каналы if GCadForm.FShowCableChannelFullness then begin // закрытость/открытость // Side = 1 if FCableChannelClosedSide1 = cif_None then EndPointsColor := clBlack; if FCableChannelClosedSide1 = cif_Empty then EndPointsColor := clRed; if FCableChannelClosedSide1 = cif_HalfEmpty then EndPointsColor := clYellow; if FCableChannelClosedSide1 = cif_Full then EndPointsColor := clGreen; DEngine.drawrect(ActualPoints[1].x - dimp_draw, ActualPoints[1].y - dimp_draw, ActualPoints[1].x + dimp_draw, ActualPoints[1].y + dimp_draw, EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); // Side = 2 if FCableChannelClosedSide2 = cif_None then EndPointsColor := clBlack; if FCableChannelClosedSide2 = cif_Empty then EndPointsColor := clRed; if FCableChannelClosedSide2 = cif_HalfEmpty then EndPointsColor := clYellow; if FCableChannelClosedSide2 = cif_Full then EndPointsColor := clGreen; DEngine.drawrect(ActualPoints[2].x - dimp_draw, ActualPoints[2].y - dimp_draw, ActualPoints[2].x + dimp_draw, ActualPoints[2].y + dimp_draw, EndPointsColor, 1, ord(psSolid), EndPointsColor, ord(bsSolid)); // степень заполнености if FCableChannelFullness = cif_None then DEngine.Canvas.Pen.Color := clBlack; if FCableChannelFullness = cif_Empty then DEngine.Canvas.Pen.Color := clGreen; if FCableChannelFullness = cif_HalfEmpty then DEngine.Canvas.Pen.Color := clYellow; if FCableChannelFullness = cif_Full then DEngine.Canvas.Pen.Color := clRed; if FIsRaiseUpDown then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else if ActualZOrder[1] <> ActualZOrder[2] then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else begin DrawTraceStyle(DEngine); //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end; end; // кабели с превышающей длиной if GCadForm.FShowTracesLengthLimit then begin if IsLengthAboveLimit then begin if FIsRaiseUpDown then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else if ActualZOrder[1] <> ActualZOrder[2] then begin DEngine.Canvas.Pen.Width := FTraceWidth; DEngine.Canvas.Pen.Color := FTraceColor; end else begin DrawTraceStyle(DEngine); DEngine.Canvas.Pen.Color := $000080FF; //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end; end; end; // отобразить степень дефекта if GCadForm.FShowDefectObjects then begin DEngine.Canvas.Pen.Style := psSolid; if FDefectDegree = dodDefect then DEngine.Canvas.Pen.Color := clRed; if FDefectDegree = dodPartDefect then DEngine.Canvas.Pen.Color := clYellow; DrawTraceStyle(DEngine); //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end; // отобразить объекты, которые ни к чему не присоединены if GCadForm.FShowDisconnectedObjects then begin if CheckTraceNotHaveConnect and Not isSnap then begin DrawTraceStyle(DEngine); //DEngine.Canvas.Pen.Color := clPurple; DEngine.Canvas.Pen.Width := 3; DEngine.Canvas.Pen.Color := RGB($80, 0, $FF); //Tolik -- 11/09/2017 -- isDrawTraceStyle := True; end; end; x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; end; // ПРОСЧЕТ ----------------------------------------------------- for i := 0 to FCount - 1 do begin Gap2 := 0; XGap := 0; if FCount > 1 then begin Gap2 := FGap / 2; XGap := FGap - ((FGap / (FCount - 1)) * i) - Gap2; end; len := sqrt(sqr(x1 - x2) + sqr(y1 - y2)); //if FIsRaiseUpDown and (DrawStyle = dsTrace) then begin if self.FDrawFigurePercent <> 0 then begin //len := len * (self.FDrawFigurePercent / 100); len := len; end; end; if len = 0 then len := 0.01; f := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f := f * (-1); resx1 := XGap * cos((f - 90) * pi / 180) + x1; resy1 := XGap * sin((f - 90) * pi / 180) + y1; resx2 := XGap * cos((f - 90) * pi / 180) + x2; resy2 := XGap * sin((f - 90) * pi / 180) + y2; resx3 := XGap * cos((f - 90) * pi / 180) + x3; resy3 := XGap * sin((f - 90) * pi / 180) + y3; points[0].x := resx1; points[0].y := resy1; points[1].x := resx2; points[1].y := resy2; points[2].x := resx3; points[2].y := resy3; if (DrawStyle = dsTrace) then begin ActualsCount := Length(GTempActualPoints); for k := 1 to ActualsCount - 2 do begin //Tolik 03/02/2022 -- //DEngine.Canvas.Pen.Mode := pmMask; DEngine.Canvas.Pen.Mode := pmCopy; DEngine.Canvas.Pen.Color := $00E8731A; // DEngine.DrawLine(GTempActualPoints[k], GTempActualPoints[k + 1]); DEngine.Canvas.Pen.Mode := pmXor; DEngine.Canvas.Pen.Color := clLime; end; // if GReDrawAfterRefresh then begin DEngine.Canvas.Pen.Mode := pmXor; // *VISIO* DEngine.DrawLine(points[0], points[1]); DEngine.DrawLine(points[1], points[2]); // *VISIO* GReDrawAfterRefresh := False; end; end; if not FIsRaiseUpDown then begin // *VISIO* if (DrawStyle = dsTrace) and (GCadForm.PCad.ToolIdx = toFigure) then begin DEngine.DrawLine(points[0], points[1]); DEngine.DrawLine(points[1], points[2]); end else begin if not Self.FIsVertical then begin // Tolik 05/09/2017 -- // DEngine.DrawLine(points[0], points[1]); if CrossList.Count = 0 then begin LineColor := DEngine.Canvas.Pen.Color; if LineColor = clRed then AlternateTraceColor := getclRed; if AlternateTraceColor = 0 then DEngine.DrawLine(points[0], points[1]) else DEngine.DrawLine(points[0], points[1], AlternateTraceColor, DEngine.Canvas.Pen.Width, ord(DEngine.Canvas.Pen.Style), 0, 3.5, 1.2, False); end else begin if not isDrawTraceStyle then SetDrawLineProps; LinePenStyle := DEngine.Canvas.Pen.Style; LineWidth := DEngine.Canvas.Pen.Width; LineColor := DEngine.Canvas.Pen.Color; if LineColor = clRed then AlternateTraceColor := getclRed; // reg := 0; // отрисовку линии ориентируем относительно (0; 0), т.как список пересечений отсортирован так же {FirstLinePoint := Points[0]; LastLinePoint := Points[1]; if CompareValue(sqrt(sqr(Points[0].x) + sqr(Points[0].y)), sqrt(sqr(Points[1].x) + sqr(Points[1].y))) = 1 then begin FirstLinePoint := Points[1]; LastLinePoint := Points[0]; end; } FirstLinePoint := AP1; LastLinePoint := AP2; if CompareValue(sqrt(sqr(AP1.x) + sqr(AP1.y)), sqrt(sqr(AP2.x) + sqr(AP2.y))) = 1 then begin {FirstLinePoint := Points[1]; LastLinePoint := Points[0];} FirstLinePoint := AP2; LastLinePoint := AP1; end; {if LineColor = clRed then begin for l := 0 to CrossList.Count - 1 do begin if POrthoLineCrossInfo(CrossList[l]).isDrawPoint then if POrthoLineCrossInfo(CrossList[l]).DrawColor = clRed then begin AlternateTraceColor := getclRed; end; end; end;} PointInfo := POrthoLineCrossInfo(CrossList[0]); if PointInfo.isDrawPoint then // если это - точка отрисовки пересечения begin { if isSnap then DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, LineColor,LineWidth,0,0,0,0,reg, p1, p2, true,0) else DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, PointInfo.DrawColor,LineWidth,0,0,0,0,reg, p1, p2, true,0); } if ((PointInfo.isCritical = 1) and ShowCriticalCrossPoints) then begin DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, clRed,LineWidth,0,0,0,0,reg, p1, p2, true,0) end else begin if AlternateTraceColor = 0 then DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, LineColor,LineWidth,0,0,0,0,reg, p1, p2, true,0) else DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, AlternateTraceColor,LineWidth,0,0,0,0,reg, p1, p2, true,0); end; DEngine.Canvas.Pen.Color := LineColor; LinePoint := p1; LastPoint := p2; if CompareValue(Sqrt(sqr(FirstLinePoint.x - p1.x) + sqr(FirstLinePoint.y - p1.y)), Sqrt(sqr(FirstLinePoint.x - p2.x) + sqr(FirstLinePoint.y - p2.y))) = 1 then begin LinePoint := p2; LastPoint := p1; end; //DEngine.DrawLine(FirstLinePoint, LinePoint, FDrawColor, FTraceWidth, Ord(FTraceStyle), 0, 3.5, 1.2, False); if AlternateTraceColor = 0 then DEngine.DrawLine(FirstLinePoint, LinePoint, LineColor, LineWidth, ord(LinePenstyle), 0, 3.5, 1.2, False) else begin DEngine.DrawLine(FirstLinePoint, LinePoint, AlternateTraceColor, LineWidth, ord(LinePenstyle), 0, 3.5, 1.2, False); DEngine.Canvas.Pen.Color := LineColor; end; end else // если пересечение не рисуем begin //DEngine.DrawLine(FirstLinePoint, PointInfo.StartPoint, FDrawColor, FTraceWidth, Ord(FTraceStyle),0); if AlternateTraceColor = 0 then DEngine.DrawLine(FirstLinePoint, PointInfo.StartPoint, LineColor, LineWidth, ord(LinePenstyle),0) else begin DEngine.DrawLine(FirstLinePoint, PointInfo.StartPoint, AlternateTraceColor, LineWidth, ord(LinePenstyle),0); DEngine.Canvas.Pen.Color := LineColor; end; LastPoint.x := Pointinfo.StartPoint.x; LastPoint.y := PointInfo.StartPoint.y; end; if CrossList.Count > 1 then begin for l := 1 to CrossList.Count - 1 do begin reg := 0; PointInfo := POrthoLineCrossInfo(CrossList[l]); if PointInfo.isDrawPoint then begin //DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, FDrawFigureAngle, PI + FDrawFigureAngle, 255,LineWidth,0,0,0,0,reg, p1, p2, true,0); { if isSnap then DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, FDrawFigureAngle, PI + FDrawFigureAngle, LineColor,LineWidth,0,0,0,0,reg, p1, p2, true,0) else DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, FDrawFigureAngle, PI + FDrawFigureAngle, PointInfo.DrawColor,LineWidth,0,0,0,0,reg, p1, p2, true,0); } { if isSnap then DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, LineColor,LineWidth,0,0,0,0,reg, p1, p2, true,0) else DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, PointInfo.DrawColor,LineWidth,0,0,0,0,reg, p1, p2, true,0); } if ((PointInfo.isCritical = 1) and ShowCriticalCrossPoints) then begin DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, clRed,LineWidth,0,0,0,0,reg, p1, p2, true,0) end else begin if AlternateTraceColor = 0 then DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, LineColor,LineWidth,0,0,0,0,reg, p1, p2, true,0) else DEngine.drawbezarc(PointInfo.StartPoint.x, PointInfo.StartPoint.y, 1, PI + FDrawFigureAngle, FDrawFigureAngle, AlternateTraceColor,LineWidth,0,0,0,0,reg, p1, p2, true,0); end; DEngine.Canvas.Pen.Color := LineColor; LinePoint := p1; if CompareValue(Sqrt(sqr(FirstLinePoint.x - p1.x) + sqr(FirstLinePoint.y - p1.y)), Sqrt(sqr(FirstLinePoint.x - p2.x) + sqr(FirstLinePoint.y - p2.y))) = 1 then begin LinePoint := p2; end; //DEngine.DrawLine(LastPoint, LinePoint{PointInfo.StartPoint}, FDrawColor, FTraceWidth, Ord(FTraceStyle),0); if AlternateTraceColor = 0 then DEngine.DrawLine(LastPoint, LinePoint{PointInfo.StartPoint}, LineColor, LineWidth, ord(LinePenstyle),0) else begin DEngine.DrawLine(LastPoint, LinePoint{PointInfo.StartPoint}, AlternateTraceColor, LineWidth, ord(LinePenstyle),0); DEngine.Canvas.Pen.Color := LineColor; end; LastPoint := p1; if CompareValue(Sqrt(sqr(FirstLinePoint.x - p1.x) + sqr(FirstLinePoint.y - p1.y)), Sqrt(sqr(FirstLinePoint.x - p2.x) + sqr(FirstLinePoint.y - p2.y))) = -1 then begin LastPoint := p2; end; end else begin //DEngine.DrawLine(FirstLinePoint, PointInfo.StartPoint, FDrawColor, FTraceWidth, Ord(FTraceStyle),0); //DEngine.DrawLine(FirstLinePoint, PointInfo.StartPoint, LineColor, LineWidth, ord(LinePenstyle),0); if AlternateTraceColor = 0 then DEngine.DrawLine(LastPoint, PointInfo.StartPoint, LineColor, LineWidth, ord(LinePenstyle),0) else begin DEngine.DrawLine(LastPoint, PointInfo.StartPoint, AlternateTraceColor, LineWidth, ord(LinePenstyle),0); DEngine.Canvas.Pen.Color := LineColor; end; LastPoint.x := Pointinfo.StartPoint.x; LastPoint.y := PointInfo.StartPoint.y; end; end; end; //DEngine.DrawLine(LastPoint, LastLinePoint, FDrawColor, FTraceWidth, Ord(FTraceStyle),0); if AlternateTraceColor = 0 then DEngine.DrawLine(LastPoint, LastLinePoint, LineColor, LineWidth, ord(LinePenstyle),0) else begin DEngine.DrawLine(LastPoint, LastLinePoint, AlternateTraceColor, LineWidth, ord(LinePenstyle),0); DEngine.Canvas.Pen.Color := LineColor; end; end; // end; // *VISIO* end; if GCadForm.FShowLineCaptionsType = skExternalSCS then begin if FExistOtherObjectType then begin // дорисовать действующую if FObjectType = 1 then begin DEngine.Canvas.Pen.color := clBlack; DEngine.Canvas.Pen.width := 1; DEngine.Canvas.Pen.Style := psSolid; DrawActiveTrace(DEngine, points[0], points[1]); end else // дорисовать проектируемую if FObjectType = 2 then begin if GCadForm.FPrintType = pt_Black then begin DEngine.Canvas.Pen.color := clBlack; DEngine.Canvas.Pen.width := 2; DEngine.Canvas.Pen.Style := psDash; DrawProjectibleTrace(DEngine, points[0], points[1]); end else if GCadForm.FPrintType = pt_Color then begin DEngine.Canvas.Pen.color := clRed; DEngine.Canvas.Pen.width := 1; DEngine.Canvas.Pen.Style := psDash; DrawProjectibleTrace(DEngine, points[0], points[1]); end; end; end; end; end; end; if AlternateTraceColor <> 0 then FDrawColor := AlternateTraceColor else FDrawColor := DEngine.Canvas.Pen.Color; FDrawStyle := ord(DEngine.Canvas.Pen.Style); if FIsVertical then DrawVertical(DEngine); except on E: Exception do addExceptionToLogEx('TOrthoLine.Draw', E.Message); end; end; // Tolik -- 19/11/2016 -- // Старая закомменчена -- см. ниже // Здесь выполнены проверки и не допускается удаление коннекторов магистралей и // межэтажных С/П, чтобы потом не было проблем после UNDO class function TOrthoLine.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var i, j, ConnIndex, ConnID: integer; x, y, z: double; PrevFigure: TFigure; Connector: TFigure; isFigure: TFigure; ConnAsDefault: TConnectorObject; CableAsDefault: TOrthoLine; CurrSnapFigure: TFigure; CurrSavedConn: TConnectorObject; LastObjectHeight: Double; SavedConnectorsList: TList; SavedLinesList: TList; TypeIndex: Integer; SavedSnapFigure: TFigure; StartConn, EndConn: TConnectorObject; TraceCount: integer; Res1, Res2: TFigure; InCab: boolean; // Tolik // 27/02/2017 -- для контроль превышения количества объектов USER TracedLineCount: Integer; UserQuotaReached_Message: String; TraceElectric: Boolean; CallAutoTraceElectricMaster: Boolean; CurrEndPoint: TFigure; ConnectFigList: TList; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; SnapFigureConn: TConnectorObject; // SnapGrids,SnapGuides: Boolean; CanSnapConnectors: Boolean; LastClickFigure: TFigure; CadSCSFiguresIDList: TIntList; BreakedELCableTracing: Boolean; LastPoint, TmpPoint: TDoublepoint; CreatedTracesList: TList; WasCadNoMoveObjects, WasCadNoMoveObjectsPressed: Boolean; AllTraceList: TList; FirstConn, LastConn: TConnectorObject; CableTraceErr: Boolean; SavedMarkedCadTraceList: TList; //Tolik 28/08/2025-- isNormbaseCable: Boolean; SavedDropComponent: TSCSComponent; // function CheckIsElComponToConnect(aObject: TConnectorObject):Boolean; var i: integer; SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; begin Result := False; if not AObject.Deleted then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(aObject.ID); if SCSCatalog <> nil then begin for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSCompon := SCSCatalog.ComponentReferences[i]; if SCSCompon.IsLine = biFalse then begin if SCSCompon.IDNetType = 3 then begin if F_NormBase.GSCSBase.SCSComponent.CheckJoinTo(SCSCompon,1,0).CanConnect = True then begin Result := True; break; end; end; end; end; end; end; end; function CheckCanSnapConnectors(AConntoSnap, currConn: TConnectorObject) : Boolean; var i, j: Integer; NextRaiseConnector: TConnectorObject; isTrunk: Boolean; JoinedLine: TOrthoLine; // переконнектить на межэтажке или магистрали procedure ReconnectWithoutSnap; var i: Integer; JoinedLine :TOrthoLine; begin for i := 0 to currConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(currConn.JoinedOrtholinesList[i]); if TConnectorObject(JoinedLine.JoinConnector1).Id = currConn.ID then JoinedLine.SetJConnector1(AConnToSnap) else if TConnectorObject(JoinedLine.JoinConnector2).Id = currConn.ID then JoinedLine.SetJConnector2(AConnToSnap); end; currConn.JoinedOrtholinesList.Clear; currConn.Delete(True, False); end; begin Result := True; if (AConntoSnap <> nil) and (not AConnToSnap.Deleted) then begin isTrunk := False; NextRaiseConnector := nil; if (AConntoSnap.FConnRaiseType = crt_BetweenFloorUp) or (AConntoSnap.FConnRaiseType = crt_BetweenFloorDown) or (AConntoSnap.FConnRaiseType = crt_TrunkUp) or (AConntoSnap.FConnRaiseType = crt_TrunkDown) then begin isTrunk := True; Result := False; ReconnectWithoutSnap; end; if not isTrunk then begin for i := 0 to AConntoSnap.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConntoSnap.JoinedOrthoLinesList[i]); if JoinedLine.FIsRaiseUpDown then begin NextRaiseConnector := nil; if TConnectorObject(JoinedLine.JoinConnector1).ID = AConntoSnap.ID then NextRaiseConnector := TConnectorObject(JoinedLine.JoinConnector2) else if TConnectorObject(JoinedLine.JoinConnector2).ID = AConntoSnap.ID then NextRaiseConnector := TConnectorObject(JoinedLine.JoinConnector1); if NextRaiseConnector <> nil then begin if (NextRaiseConnector.FConnRaiseType = crt_BetweenFloorUp) or (NextRaiseConnector.FConnRaiseType = crt_BetweenFloorDown) or (NextRaiseConnector.FConnRaiseType = crt_TrunkUp) or (NextRaiseConnector.FConnRaiseType = crt_TrunkDown) then begin isTrunk := True; Break; //// BREAK ////; end; end; end; end; if isTrunk then begin Result := False; ReconnectWithoutSnap; end; end; end; end; // Tolik 02/03/2021 -- function GetTypeIndex: integer; var SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; begin Result := 2; //if not GCallElectricAutoTraceMaster then if not GAutoAddCableAfterDragDrop then exit; //if (LastClickFigure <> nil) and (not GAutoAddCableAfterDragDrop) then if (LastClickFigure <> nil) then begin Result := 1; exit; end; if GSnapFiguresList.Count > 0 then begin if GSnapFiguresList[GSnapFiguresList.Count -1] <> nil then begin if TFigure(GSnapFiguresList[GSnapFiguresList.Count -1]) is TConnectorObject then begin if TConnectorObject(GSnapFiguresList[GSnapFiguresList.Count -1]).ConnectorType = ct_NB then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(GSnapFiguresList[GSnapFiguresList.Count -1]).ID); if SCSCatalog <> nil then begin SCSComponent := SCSCatalog.GetFirstComponent; if SCSComponent <> nil then begin if SCSComponent.IDNetType = 3 then if (SCSComponent.ComponentType.SysName = ctsnShield) or (SCSComponent.ComponentType.SysName = ctsnTerminalBox) then Result := 1; end; end; end; end; end; end; end; function CheckCanCallAutoTraceElectricMaster: Boolean; var i: integer; ElComponCount: integer; SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; CanConnToLastPoint: Boolean; begin Result := False; ElComponCount := 0; CanConnToLastPoint := False; if GCallElectricAutoTraceMaster then begin for i := 0 to GSnapFiguresList.Count - 1 do begin if GSnapFiguresList[i] <> nil then begin if TFigure(GSnapFiguresList[i]) is TConnectorObject then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TConnectorObject(GSnapFiguresList[i]).ID); if SCSCatalog <> nil then begin SCSCompon := SCSCatalog.GetFirstComponent; if SCSCompon <> nil then begin if SCSCompon.IDNetType = 3 then begin inc(ElComponCount); if GCadForm.FAutoCadMouse then begin if GSnapFiguresList[GSnapFiguresList.Count - 1] <> nil then begin if i = GSnapFiguresList.Count - 1 then begin if (SCSCompon.ComponentType.SysName = ctsnShield) or (SCSCompon.ComponentType.SysName = ctsnTerminalBox) then CanConnToLastPoint := True; end; end else begin if GSnapFiguresList.Count > 2 then begin if GSnapFiguresList[GSnapFiguresList.Count - 2] <> nil then begin if i = GSnapFiguresList.Count - 2 then begin if (SCSCompon.ComponentType.SysName = ctsnShield) or (SCSCompon.ComponentType.SysName = ctsnTerminalBox) then CanConnToLastPoint := True; end; end; end; end; end else begin if GSnapFiguresList[i] <> nil then begin if i = GSnapFiguresList.Count - 1 then begin if (SCSCompon.ComponentType.SysName = ctsnShield) or (SCSCompon.ComponentType.SysName = ctsnTerminalBox) then CanConnToLastPoint := True; end; end; end; end; end; end; end; end; end; end; if ((ElComponCount > 1) and CanConnToLastPoint) then Result := True; end; // // Tolik 04/03/2021 -- try to delete double path connections Procedure CheckDelOverlappedLines; var i, j: integer; jc1, jc2, jc3, jc4: TConnectorObject; oldLine, currLine: TOrthoLine; isBreak: Boolean; begin isBreak := True; while isBreak do begin isBreak := False; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[i]) is TOrthoLine then begin if not TOrthoLine(GCadForm.FSCSFigures[i]).deleted then begin oldLine := TOrthoLine(GCadForm.FSCSFigures[i]); if CreatedTracesList.IndexOf(oldLine) = -1 then begin jc1 := TConnectorObject(oldLine.JoinConnector1); if jc1.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc1.JoinedConnectorsList[0]).deleted then jc1 := TConnectorObject(jc1.JoinedConnectorsList[0]); // point jc2 := TConnectorObject(oldLine.JoinConnector2); if jc2.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc2.JoinedConnectorsList[0]).deleted then jc2 := TConnectorObject(jc2.JoinedConnectorsList[0]); // point for j := CreatedTracesList.Count - 1 downto 0 do begin currLine := TOrthoLine(CreatedTracesList[j]); if currLine.Id <> oldLine.ID then begin if not currLine.Deleted then begin jc3 := TConnectorObject(currLine.JoinConnector1); if jc3.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc3.JoinedConnectorsList[0]).deleted then jc3 := TConnectorObject(jc3.JoinedConnectorsList[0]); jc4 := TConnectorObject(currLine.JoinConnector2); if jc4.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc4.JoinedConnectorsList[0]).deleted then jc4 := TConnectorObject(jc4.JoinedConnectorsList[0]); if ((jc1.ID = jc3.ID) and (jc2.ID = jc4.ID) or (jc2.ID = jc3.ID) and (jc1.ID = jc4.ID)) then begin CreatedTracesList.Remove(currLine); if SavedLinesList.IndexOf(currLine) <> -1 then SavedLinesList.Remove(currLine); currLine.Delete; isBreak := True; if CallAutoTraceElectricMaster then begin if SavedLinesList.IndexOf(oldLine) = -1 then begin oldLine.FMarkTracing := True; SavedLinesList.Add(oldLine); end; end; end; end; end; end; if ((CreatedTracesList.Count = 0) or isBreak) then break; end; end; end; end; end; end; { Procedure CheckDelOverlappedLines; var i, j: integer; jc1, jc2, jc3, jc4: TConnectorObject; oldLine, currLine: TOrthoLine; begin for i := GCadForm.FSCSFigures.Count - 1 downto 0 do begin if TFigure(GCadForm.FSCSFigures[i]) is TOrthoLine then begin if not TOrthoLine(GCadForm.FSCSFigures[i]).deleted then begin if CadSCSFiguresIDList.IndexOf(TOrthoLine(GCadForm.FSCSFigures[i]).Id) <> -1 then break; currLine := TOrthoLine(GCadForm.FSCSFigures[i]); // currLineConns jc1 := TConnectorObject(currLine.JoinConnector1); if jc1.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc1.JoinedConnectorsList[0]).deleted then jc1 := TConnectorObject(jc1.JoinedConnectorsList[0]); // point jc2 := TConnectorObject(currLine.JoinConnector2); if jc2.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc2.JoinedConnectorsList[0]).deleted then jc2 := TConnectorObject(jc2.JoinedConnectorsList[0]); // point for j := 0 to GCadForm.FSCSfigures.Count - 1 do begin if TFigure(GCadForm.FSCSfigures[j]) is TOrthoLine then begin if not TOrthoLine(GCadForm.FSCSfigures[j]).deleted then begin if TOrthoLine(GCadForm.FSCSfigures[j]).ID <> currLine.Id then begin oldLine := TOrthoLine(GCadForm.FSCSfigures[j]); if not OldLine.deleted then begin jc3 := TConnectorObject(OldLine.JoinConnector1); if jc3.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc3.JoinedConnectorsList[0]).deleted then jc3 := TConnectorObject(jc3.JoinedConnectorsList[0]); jc4 := TConnectorObject(OldLine.JoinConnector2); if jc4.JoinedConnectorsList.Count > 0 then if not TConnectorObject(jc4.JoinedConnectorsList[0]).deleted then jc4 := TConnectorObject(jc4.JoinedConnectorsList[0]); if ((jc1.ID = jc3.ID) and (jc2.ID = jc4.ID) or (jc2.ID = jc3.ID) and (jc1.ID = jc4.ID)) then begin if SavedLinesList.IndexOf(currLine) <> -1 then SavedLinesList.Remove(currLine); currLine.Delete; if CallAutoTraceElectricMaster then begin oldLine.FMarkTracing := True; if SavedLinesList.IndexOf(oldLine) = -1 then SavedLinesList.Add(oldLine); end; break; end; end; end; end; end; end; end; end; end; end; } function isLastELShied: Boolean; var SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; begin Result := False; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(LastClickFigure.ID); if SCSCatalog <> nil then begin SCSCompon := SCSCatalog.GetFirstComponent; if SCScompon <> nil then if SCSCompon.IDNetType = 3 then if SCSCompon.ComponentType.SysName = ctsnShield then Result := True; end; end; //Tolik 08/06/2021 -- Procedure SaveDropCadMarkedTraces; var i: integer; MarkedLine: TOrthoLine; begin for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.FSCSFigures[i]), CTOrthoLine) then begin MarkedLine := TOrthoLine(GCadForm.FSCSFigures[i]); if not MarkedLine.Deleted then if MarkedLine.FMarkTracing then if SavedMarkedCadTraceList.IndexOf(MarkedLine) = -1 then SavedMarkedCadTraceList.Add(MarkedLine); end; end; for i := 0 to SavedMarkedCadTraceList.Count - 1 do TOrthoLine(SavedMarkedCadTraceList[i]).FMarkTracing := False; end; Procedure RestoreCadMarkedTraces; var i, j: integer; MarkedLine: TOrthoLine; begin for i := 0 to SavedMarkedCadTraceList.Count - 1 do begin MarkedLine := TOrthoLine(SavedMarkedCadTraceList[i]); if not MarkedLine.Deleted then begin for j := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[j]).ID = MarkedLine.ID then begin MarkedLine.FMarkTracing := True; break; end; end; end; end; SavedMarkedCadTraceList.free; end; // begin GisOrthoLineHadow := True; // Tolik 27/08/2021 -- флажок, чтобы показать, что в данный момент создается трасса // (нужен, чтобы сбросить проверку коннекторов на снапе) Result := nil; //Tolik 28/08/2025 -- isNormbaseCable := false; if F_NormBase.GSCSBase.SCSComponent <> nil then begin isNormbaseCable := IsCableComponent(F_NormBase.GSCSBase.SCSComponent); end; SavedDropComponent := GDropComponent; GDropComponent := nil; // SavedMarkedCadTraceList := TList.Create; SaveDropCadMarkedTraces; // сохранить список и сбросить (отмеченных для трассировки трасс на каде) // Tolik 01/04/2021 -- пока костыль, чтобы не сдвигало подключенные при создании трасс, нужно пересмотерть и доделать ПРАВИЛЬНО WasCadNoMoveObjects := GCadForm.FNoMoveConnectedObjects; WasCadNoMoveObjectsPressed := GCadForm.tbNoMoveConnectedObjects.Down; GCadForm.FNoMoveConnectedObjects := True; GCadForm.tbNoMoveConnectedObjects.Down := True; // CreatedTracesList := TList.Create; BreakedELCableTracing := False; //GCallAutoTraceElectricMaster := False; //Tolik 03/03/2021 -- LastClickFigure := nil; if GSnapFiguresList.Count > 1 then if GSnapFiguresList[GSnapFiguresList.Count - 1] <> nil then LastClickFigure := TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]); { if GOrthoStatus and (LastClickFigure <> nil) then begin if GClickIndex > 1 then begin if isLastELShied then begin if (GSnapFiguresList[GSnapFiguresList.Count - 1 ] <> nil) and (GSnapFiguresList[GSnapFiguresList.Count - 2] <> nil) then begin if (GOrthoStatus) and (GFigureTraceTo <> nil) and CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then begin //if not (DoubleCMP(Shadow.OriginalPoints[1].x, Shadow.OriginalPoints[3].x)) and not (DoubleCMP(Shadow.OriginalPoints[1].y, Shadow.OriginalPoints[3].y)) then if ((CompareValue(Shadow.ActualPoints[GClickIndex].x, Shadow.ActualPoints[GClickIndex - 1].x) <> 0) and (CompareValue(Shadow.ActualPoints[GClickIndex].y, Shadow.ActualPoints[GClickIndex - 1].y) <> 0)) then begin //Tolik -- 20/04/2017 -- для ортогональных трасс добавлять лишнюю точку только, если // нне была зажата клавиша SHIFT -- иначе трасса бытет строиться точно от объекта к объекту и промежуточная // (ортогональная) точка в таком случае не нужна if not (ssShift in GGlobalShiftState) then begin LastPoint := Shadow.ActualPoints[GClickIndex]; TmpPoint.x := Shadow.ActualPoints[GClickIndex - 1].x; TmpPoint.y := Shadow.ActualPoints[GClickIndex].y; TmpPoint.z := Shadow.ActualPoints[GClickIndex].z; Shadow.ActualPoints[GClickIndex + 1] := LastPoint; Shadow.ActualPoints[GClickIndex] := TmpPoint; GSnapFiguresList.Insert(GSnapFiguresList.Count, nil); GTempActualPoints[GClickIndex] := TmpPoint; GTempActualPoints[GClickIndex + 1] := LastPoint; inc(GClickIndex); //GLastClickOrtho := True; end; end; end; end; end; end; end; } TraceElectric := False; if GCallElectricAutoTraceMaster then if GAutoAddCableAfterDragDrop then if F_NormBase.GSCSBase.SCSComponent <> nil then if F_NormBase.GSCSBase.SCSComponent.ID <> 0 then if isCableComponent(F_NormBase.GSCSBase.SCSComponent) then if F_NormBase.GSCSBase.SCSComponent.IDNetType = 3 then TraceElectric := True; CallAutoTraceElectricMaster := false; if TraceElectric then CallAutoTraceElectricMaster := CheckCanCallAutoTraceElectricMaster; // incab := false; if GCadform.PCad.SnapToGrids then SnapGrids := True else SnapGrids := False; if GCadform.PCad.SnapToGuides then SnapGuides := True else SnapGuides := False; //------------------------------------ if GWasShiftOnTraceCreate then begin GCadform.PCad.SnapToGrids := false; GCadform.PCad.SnapToGuides := false; end; //Tolik 04/03/2021 -- CadSCSFiguresIDList := TIntList.Create; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[i]) is TOrthoLine then CadSCSFiguresIDList.Add(TOrthoLine(GCadForm.FSCSFigures[i]).ID); end; // BeginProgress; try SavedConnectorsList := TList.Create; SavedLinesList := TList.Create; Result := nil; Connector := nil; PrevFigure := nil; GTraceStatus := True; // Tolik -- 18/11/2015 TraceCount := 0; // if GClickIndex > 1 then begin if not TraceElectric then // Tolik 22/03/2021 -- if GCadForm.FAutoCadMouse then begin if GLastClickOrtho then begin //Tolik 06/09/2021 -- //GClickIndex := GClickIndex - 1; if GSnapFiguresList.Count = GClickIndex then if GSnapFiguresList[GClickIndex - 1] = nil then GClickIndex := GClickIndex - 1; end; end; end; if (((GCadForm.FAutoCadMouse) and ((GClickIndex >= 3) or ((GClickIndex >= 2) and (LastClickFigure <> nil)))) or //Tolik 07/09/2021 -- //((not GCadForm.FAutoCadMouse) and (GClickIndex >= 2))) then ((not GCadForm.FAutoCadMouse) and ((GClickIndex >= 2) or ((GClickIndex = 2) and (LastClickFigure <> nil))))) then // begin if GCadForm.FAutoCadMouse then // Tolik 02/03/2021 -- здесь, если будем вести электрику и последний клик буден на щитке или коробке - // нужно чтобы и до него построилась трасса, поэтому индекс нужно будет просчитать //TypeIndex := 2 // TypeIndex := GetTypeIndex else TypeIndex := 1; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; // Tolik -- 18/11/2015 -- проинициализировано, но не там...в самом начале нужно, а то если в это условие не попадем // а эта переменная юзается и вне условия -- получаем бяку // TraceCount := 0; // Res1 := nil; Res2 := nil; if F_ProjMan.GSCSBase.CurrProject.Setting.FirstTraceCreated then SetUserLineHeightForAllProj; // Основной цикл создания трассы for i := 1 to GClickIndex - TypeIndex do begin //----- Connectors ------------------------------------------------------- Connector := TConnectorObject.Create(Shadow.ActualPoints[i].x, Shadow.ActualPoints[i].y, GCadForm.FLineHeight, LHandle, mydsNormal, aOwner); TConnectorObject(Connector).ConnectorType := GCurrentConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Connector, false); SavedConnectorsList.Add(Connector); // Saved SetConnBringToFront(TConnectorObject(Connector)); // привязка конектора к другой линии if PrevFigure <> nil then TOrthoLine(PrevFigure).SetJConnector2(Connector); //----- OrthoLine --------------------------------------------------------- Result := TOrthoLine.Create(Connector.ActualPoints[1].x, Connector.ActualPoints[1].y, GCadForm.FLineHeight, Shadow.ActualPoints[i + 1].x, Shadow.ActualPoints[i + 1].y, GCadForm.FLineHeight, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aOwner); TraceCount := TraceCount + 1; if i = 1 then Res1 := Result; if i = (GClickIndex - TypeIndex) then Res2 := Result; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Result, false); SavedLinesList.Add(Result); // Saved TOrtholine(Result).SetJConnector1(Connector); PrevFigure := Result; GCadForm.PCad.OrderFigureToFront(TOrtholine(Result).CaptionsGroup); CreatedTracesList.Add(Result); end; //-----Connectors ---------------------------------------------------------- Connector := TConnectorObject.Create(Shadow.ActualPoints[i].x, Shadow.ActualPoints[i].y, GCadForm.FLineHeight, LHandle, mydsNormal, aOwner); TConnectorObject(Connector).ConnectorType := GCurrentConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Connector, False); SavedConnectorsList.Add(Connector); // Saved SetConnBringToFront(TConnectorObject(Connector)); // привязка конектора к другой линии TOrtholine(Result).SetJConnector2(Connector); // переставить высоты с соответствием с размещением между РМ if GCadForm.FAutoPosTraceBetweenRM then AutoPosTracesBetweenRM(SavedConnectorsList, SavedLinesList, GSnapFiguresList); // Tolik -- 06/11/2016-- !!!! While GSnapFiguresList.Count < SavedConnectorsList.Count do GSnapFiguresList.Add(Nil); // // возможность подвязки! for i := 0 to SavedConnectorsList.Count - 1 do begin //Tolik 09/02/2021 -- if GSnapFiguresList[i] <> nil then begin // GMovedByOtherObject := True; CurrSavedConn := TConnectorObject(SavedConnectorsList[i]); CurrSnapFigure := TFigure(GSnapFiguresList[i]); GFigureSnap := CurrSnapFigure; // Через Линию if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin CheckingSnapConnectorToOrtholine(CurrSavedConn, TOrthoLine(GFigureSnap)); end // Через Дом else if CheckFigureByClassName(GFigureSnap, cTHouse) then begin SnapConnectorToHouse(CurrSavedConn, THouse(GFigureSnap)); end // Через ТО else if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin // Через пустой соединитель if TConnectorObject(GFigureSnap).ConnectorType = ct_Clear then begin SavedSnapFigure := GFigureSnap; ConnID := TConnectorObject(SavedSnapFigure).ID; // Tolik -- 19/11/2016 -- чтобы не поломать межэтажки/магистрали if CheckCanSnapConnectors(TConnectorObject(GFigureSnap), CurrSavedConn) then // begin if GUseVerticalTraces then CheckingSnapConnectorToConnector(CurrSavedConn, TConnectorObject(GFigureSnap)) else begin // Tolik 11/11/2019 -- если нельзя использовате вертикальные трассы CheckingSnapConnectorToConnector(CurrSavedConn, TConnectorObject(GFigureSnap), true); end; end; //Tolik 27/08/2021 -- { if SavedSnapFigure <> nil then begin if SavedSnapFigure.Deleted then begin SavedSnapFigure := TFigure(CurrSavedConn); for j := 0 to GCadForm.FSCSFigures.Count - 1 do begin if CheckFigureByClassName(GCadForm.FSCSFigures[j], cTOrthoLine) then begin if Assigned(TOrthoLine(GCadForm.FSCSFigures[j]).JoinConnector1) then if TOrthoLine(GCadForm.FSCSFigures[j]).JoinConnector1.Id = ConnID then TOrthoLine(GCadForm.FSCSFigures[j]).JoinConnector1 := TFigure(CurrSavedConn); if Assigned(TOrthoLine(GCadForm.FSCSFigures[j]).JoinConnector2) then if TOrthoLine(GCadForm.FSCSFigures[j]).JoinConnector2.Id = ConnID then TOrthoLine(GCadForm.FSCSFigures[j]).JoinConnector2 := TFigure(CurrSavedConn); end; end; end; end; } // GFigureSnap := SavedSnapFigure; end else // Через Объект begin SavedSnapFigure := GFigureSnap; (* if TConnectorObject(CurrSavedConn).ActualZOrder[1] <> TConnectorObject(GFigureSnap).ActualZOrder[1] then begin //Tolik -- 21/04/2017 // в зависимости от состояния GWasShiftOnTraceCreate будем двигать или объект к коннектору или коннектор к объекту if (TConnectorObject(GFigureSnap).JoinedConnectorsList.Count = 0) and (TConnectorObject(GFigureSnap).JoinedOrtholinesList.Count = 0) then begin // Tolik 17/03/2021 -- значение Шифта для отрисовки трасс мы перевернули, так что и условие здесь поменяеи // if GWasShiftOnTraceCreate then if not GWasShiftOnTraceCreate then { TConnectorObject(CurrSavedConn).MoveConnector(GFigureSnap.ActualPoints[1].x - TConnectorObject(CurrSavedConn).ActualPoints[1].x, GFigureSnap.ActualPoints[1].y - TConnectorObject(CurrSavedConn).ActualPoints[1].y false, false) else TConnectorObject(GFigureSnap).MoveConnector(CurrSavedConn.ActualPoints[1].x - TConnectorObject(GFigureSnap).ActualPoints[1].x, CurrSavedConn.ActualPoints[1].y - TConnectorObject(GFigureSnap).ActualPoints[1].y false, false); } TConnectorObject(CurrSavedConn).MoveConnector(GFigureSnap.ActualPoints[1].x - TConnectorObject(CurrSavedConn).ActualPoints[1].x, GFigureSnap.ActualPoints[1].y - TConnectorObject(CurrSavedConn).ActualPoints[1].y, false, false) else TConnectorObject(GFigureSnap).MoveConnector(CurrSavedConn.ActualPoints[1].x - TConnectorObject(GFigureSnap).ActualPoints[1].x, CurrSavedConn.ActualPoints[1].y - TConnectorObject(GFigureSnap).ActualPoints[1].y, false, false); end; { if (TConnectorObject(GFigureSnap).JoinedConnectorsList.Count = 0) and (TConnectorObject(GFigureSnap).JoinedOrtholinesList.Count = 0) then TConnectorObject(GFigureSnap).MoveConnector(CurrSavedConn.ActualPoints[1].x - TConnectorObject(GFigureSnap).ActualPoints[1].x, CurrSavedConn.ActualPoints[1].y - TConnectorObject(GFigureSnap).ActualPoints[1].y false, false); } end // Tolik 03/05/2017 -- else begin //if not GConnectTraceOnClickPoint then //if GMoveRouteToPointObject then if ((GConnectTraceOnClickPoint and GMoveRouteToPointObject) or (not GConnectTraceOnClickPoint)) then begin if GFigureSnap <> nil then begin if GWasShiftOnTraceCreate then TConnectorObject(CurrSavedConn).MoveConnector(GFigureSnap.ActualPoints[1].x - TConnectorObject(CurrSavedConn).ActualPoints[1].x, GFigureSnap.ActualPoints[1].y - TConnectorObject(CurrSavedConn).ActualPoints[1].y, false, false) else begin // 07/04/2021 -- //TConnectorObject(GFigureSnap).MoveConnector(CurrSavedConn.ActualPoints[1].x - TConnectorObject(GFigureSnap).ActualPoints[1].x, // CurrSavedConn.ActualPoints[1].y - TConnectorObject(GFigureSnap).ActualPoints[1].y, false, false); if CompareValue(TConnectorObject(GFigureSnap).ActualZOrder[1], CurrSavedConn.ActualZOrder[1]) = 0 then // если на одной высоте - выравнивание по настройкам begin if (GConnectTraceOnClickPoint and GMoveRouteToPointObject) then TConnectorObject(CurrSavedConn).MoveConnector(GFigureSnap.ActualPoints[1].x - TConnectorObject(CurrSavedConn).ActualPoints[1].x, GFigureSnap.ActualPoints[1].y - TConnectorObject(CurrSavedConn).ActualPoints[1].y, false, false) end else begin // если высоты разные - выравниваем клик по фигуре, на которой он произошел, т.к. построится райз или вертикаль TConnectorObject(CurrSavedConn).MoveConnector(TConnectorObject(GFigureSnap).ActualPoints[1].x - CurrSavedConn.ActualPoints[1].x, TConnectorObject(GFigureSnap).ActualPoints[1].y - CurrSavedConn.ActualPoints[1].y, false, false); end; end; end; end; end; *) GFigureSnap := SavedSnapFigure; // Tolik 11/11/2019 -- //CheckingSnapConnectorToPointObject(CurrSavedConn, TConnectorObject(GFigureSnap), False); if GUseVerticalTraces then // Tolik 12/04/2021 -- //CheckingSnapConnectorToPointObject(CurrSavedConn, TConnectorObject(GFigureSnap), False) CheckingSnapConnectorToPointObject(CurrSavedConn, TConnectorObject(GFigureSnap), True) // else begin // если запрещены вертикальные трассы, делаем так, чтобы конец трассы присоединился к коннектору на его высоте, // и не оказался просто оторванным или неприсоединенным (по-любому) //CheckingSnapPointObjectToConnector(TConnectorObject(GFigureSnap), CurrSavedConn, False, False, True); CheckingSnapPointObjectToConnector(TConnectorObject(GFigureSnap), CurrSavedConn, False, True, False); end; // end; end; end; GMovedByOtherObject := False; end; /// ********************************************************************** if GCadForm.FAutoPosTraceBetweenRM then AutoPosTracesBetweenRMAfterSnap(SavedLinesList); // очистить привязки for i := 0 to GSnapFiguresList.Count - 1 do begin CurrSnapFigure := TFigure(GSnapFiguresList[i]); if CheckFigureByClassName(CurrSnapFigure, cTOrthoLine) then TOrthoLine(CurrSnapFigure).isSnap := False else if CheckFigureByClassName(CurrSnapFigure, cTConnectorObject) then TConnectorObject(CurrSnapFigure).isSnap := False; end; //31.01.2011 Если одним куском трассы соединили подъезды одного дома, то трассу разбиваем на два участка if ((GClickIndex-TypeIndex) = 1) then AutoDivideLine(TOrthoLine(Result)); //31.01.2011 - разделяем линию если нужно // Tolik 21/03/2018 -- GCadForm.mProtocol.Lines.Add(cCadClasses_Mes1 + FormatFloat(ffMask, MetreToUOM(GCadForm.FLineHeight)) + cCadClasses_Mes2); end; // *UNDO* // Tolik 03/03/2021 -- //GCadForm.FCanSaveForUndo := True; for i := 0 to SavedLinesList.Count - 1 do begin CurrSnapFigure := TFigure(SavedLinesList[i]); if CheckFigureByClassName(CurrSnapFigure, cTOrtholine) then begin GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures ,CurrSnapFigure); if TOrtholine(CurrSnapFigure).InsideCabinet then begin incab := true; break; end; end; end; //////////////////////////////////////////////// //if SavedConnectorsList <> nil then // FreeAndNil(SavedConnectorsList); if SavedLinesList <> nil then // Tolik 13/09/2017 -- begin if GCadForm.FListSettings.ShowTracesCrossPoints > 0 then begin for i := 0 to SavedLinesList.Count - 1 do begin if checkFigureByClassName(TFigure(SavedLinesList[i]), cTOrthoLine) then begin if not TOrthoLine(SavedLinesList[i]).FIsVertical then if not TOrthoLine(SavedLinesList[i]).FIsRaiseUpDown then if GCadForm.FListSettings.ShowTracesCrossPoints > 0 then begin DropCalcCrosses(TOrthoLine(SavedLinesList[i]), False); end; end; end; end; end; // CheckDelOverlappedLines; // Tolik 04/03/2021 -- if not GNoTraceCable then // Tolik 01/10/2021 -- begin if not CallAutoTraceElectricMaster then // если ложим кабель, то ложить тольков том случае, если не будем вызывать мастер автотрассировки электрики begin if GAutoAddCableAfterDragDrop then begin if F_NormBase.GSCSBase.SCSComponent <> nil then if F_NormBase.GSCSBase.SCSComponent.ID <> 0 then if isCableComponent(F_NormBase.GSCSBase.SCSComponent) then if F_NormBase.GSCSBase.SCSComponent.IDNetType = 3 then GDropComponent := F_NormBase.GSCSBase.SCSComponent; //if (GDropComponent <> nil) and (GDropComponent.IsLine = 1) then //if (GDropComponent <> nil) and (GDropComponent.ID <> 0) and (GDropComponent.IsLine = 1) then if (GDropComponent <> nil) and (GDropComponent.ID <> 0) and (GDropComponent.IsLine = 1) and (GDropComponent.IdNetType = 3) then begin if isCableComponent(GDropComponent) and (GDropComponent.IDNetType = 3) and (GSnapFiguresList[0] <> nil) then // для электрики проложить или по трассам или, если есть первый и последний объект - то begin // не просто по трассам, а по пути между ними, включающему созданные трассы if TFigure(GSnapFiguresList[0]) is TConnectorObject then begin FirstConn := TConnectorObject(GSnapFiguresList[0]); LastConn := nil; CableTraceErr := True; for i := 1 to GSnapFiguresList.Count - 1 do // Can Connect Anyone? begin if GSnapFiguresList[i] <> nil then begin if TFigure(GSnapFiguresList[i]) Is TConnectorObject then begin CableTraceErr := false; break; end; end; end; if not CableTraceErr then begin if GConnectEndPoints then // соединять только крайние begin for I := GSnapFiguresList.Count - 1 downto 1 do begin if GSnapFiguresList[i] <> nil then if TFigure(GSnapFiguresList[i]) is TConnectorObject then begin LastConn := TConnectorObject(GSnapFiguresList[i]); break; end; end; if (LastConn <> nil) and (LastConn.ID <> FirstConn.ID) then begin CableTraceErr := True; if CheckIsElComponToConnect(LastConn) then begin if CheckIsElComponToConnect(FirstConn) then begin CableTraceErr := false; for i := 0 to SavedLinesList.Count - 1 do TOrthoLine(SavedLinesList[i]).FMarkTracing := True; AllTraceList := GetAllTraceInCADByMarked(LastConn, FirstConn); if (AllTraceList <> nil) and (AllTraceList.Count > 0) then begin for i := 0 to TList(AllTraceList[0]).Count - 1 do begin if TFigure(TList(AllTraceList[0])[i]) is TOrthoLine then begin CopyComponentToSCSObject(TOrthoLine(TList(AllTraceList[0])[i]).ID, GDropComponent.ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(TList(AllTraceList[0])[i]).ID); end; end; end else CableTraceErr := True; end; end; // if err then message!!! end else begin for i := 0 to SavedLinesList.Count - 1 do begin CopyComponentToSCSObject(TOrthoLine(SavedLinesList[i]).ID, GDropComponent.ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(SavedLinesList[i]).ID); end; end; end else begin // соединять все подряд begin for i := 0 to SavedLinesList.Count - 1 do TOrthoLine(SavedLinesList[i]).FMarkTracing := True; firstConn := nil; LastConn := nil; for i := 0 to GSnapFiguresList.Count - 1 do begin if GSnapFiguresList[i] <> nil then begin if TFigure(GSnapFiguresList[i]) is TConnectorObject then begin LastConn := TConnectorObject(GSnapFiguresList[i]); if LastConn.ConnectorType = ct_NB then begin if FirstConn <> nil then begin if (CheckIsElComponToConnect(LastConn) and CheckIsElComponToConnect(FirstConn)) then begin //LastConn //AllTraceList := GetAllTraceInCADByMarked(LastConn, FirstConn); AllTraceList := GetAllTraceInCADByMarked(FirstConn, LastConn); if (AllTraceList <> nil) and (AllTraceList.Count > 0) then begin for j := 0 to TList(AllTraceList[0]).Count - 1 do begin if TFigure(TList(AllTraceList[0])[j]) is TOrthoLine then begin CopyComponentToSCSObject(TOrthoLine(TList(AllTraceList[0])[j]).ID, GDropComponent.ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(TList(AllTraceList[0])[j]).ID); end; end; end else begin if not CableTraceErr then CableTraceErr := True; end; end else begin if not CableTraceErr then CableTraceErr := True; end; FirstConn := LastConn; LastConn := nil; end else begin FirstConn := LastConn; LastConn := nil; end; end; end; end; end; end; end; end else begin // No Points To Connect (Only 1) for i := 0 to SavedLinesList.Count - 1 do begin CopyComponentToSCSObject(TOrthoLine(SavedLinesList[i]).ID, GDropComponent.ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(SavedLinesList[i]).ID); end; end; end; if CableTraceErr then begin if SavedLinesList.Count > 0 then begin PauseProgress(true); ShowMessage(cPeMes23); PauseProgress(false); end; end; end else begin for i := 0 to SavedLinesList.Count - 1 do begin CopyComponentToSCSObject(TOrthoLine(SavedLinesList[i]).ID, GDropComponent.ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(SavedLinesList[i]).ID); end; end; end; //GDropComponent := nil;// 25/03/2021 -- Tolik //GAutoAddCableAfterDragDrop := false; for i := 0 to SavedLinesList.Count - 1 do TOrthoLine(SavedLinesList[i]).FMarkTracing := False; end; end; end else GNoTraceCable := false; //CheckDelOverlappedLines; // Tolik 04/03/2021 -- GCadForm.PCad.KillTraceFig(False); GCadForm.PCad.NeedRefresh := True; // Tolik 23/03/2021 -- GCadForm.PCad.Refresh; // Tolik 04/03/2021 -- // Tolik 03/03/2021 -- if CallAutoTraceElectricMaster then begin GCadForm.FCanSaveForUndo := False; PauseProgress(true); GCadForm.PCad.DeselectAll(2); for i := 0 to SavedLinesList.Count - 1 do TOrthoLine(SavedLinesList[i]).FMarkTracing := True; ConnectFigList := TList.Create; for i := 0 to GSnapFiguresList.Count - 1 do begin if GSnapFiguresList[i] <> nil then begin if TFigure(GSnapFiguresList[i]) is TConnectorObject then SnapFigureConn := TConnectorObject(GSnapFiguresList[i]); if SnapFigureConn.ConnectorType = ct_Clear then if SnapFigureConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(SnapFigureConn.JoinedConnectorsList[0]).ConnectorType = ct_NB then SnapFigureConn := TConnectorObject(SnapFigureConn.JoinedConnectorsList[0]); if SnapFigureConn.ConnectorType = ct_NB then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(SnapFigureConn.ID); if SCSCatalog <> nil then begin SCSComponent := SCSCatalog.GetFirstComponent; if SCSComponent <> nil then if SCSComponent.IDNetType = 3 then SnapFigureConn.Select; end; end; end; end; { for i := 0 to SavedConnectorsList.Count - 1 do begin if TConnectorObject(SavedConnectorsList[i]).ConnectorType = CT_Nb then TConnectorObject(SavedConnectorsList[i]).Select else if TConnectorObject(SavedConnectorsList[i]).ConnectorType = ct_Clear then if TConnectorObject(SavedConnectorsList[i]).JoinedConnectorsList.Count > 0 then if TConnectorObject(TConnectorObject(SavedConnectorsList[i]).JoinedConnectorsList[0]).ConnectorType = ct_Nb then TConnectorObject(TConnectorObject(SavedConnectorsList[i]).JoinedConnectorsList[0]).Select; end; } //GCadForm.PCad.SetTool(toSelect, ''); GCadForm.PCad.NeedRefresh := True; // Tolik 23/03/2021 -- GCadForm.PCad.Refresh; //if GSnapFiguresList[GSnapFiguresList.Count - 1] <> nil then if CallAutoTraceElectricMaster then begin currEndPoint := nil; currEndPoint := GEndPoint; GEndPoint := TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]); GCallAutoTraceElectricMaster := True; TF_MAIN(F_NormBase).Act_AutoTraceByRayModeExecute(nil); GEndPoint := currEndPoint; BreakedELCableTracing := not GCallAutoTraceElectricMaster; GCallAutoTraceElectricMaster := True; for i := 0 to SavedLinesList.Count - 1 do TOrthoLine(SavedLinesList[i]).FMarkTracing := False; end; GCadForm.PCad.DeselectAll(2); GCadForm.PCad.NeedRefresh := True; // Tolik 23/03/2021 -- GCadForm.PCad.Refresh; PauseProgress(false); if SavedConnectorsList <> nil then FreeAndNil(SavedConnectorsList); //FreeAndNil(SavedLinesList); end; //Tolik 28/08/2025 -- Если не трассировка электрики(главное, чтоб не поломалась...), если линейный компонент, //то положить по трассам, если включен флажок ручной прокладки if ((GDropComponent = nil) and (CallAutoTraceElectricMaster = false)) then begin if GAutoAddCableAfterDragDrop then begin if F_NormBase.GSCSBase.SCSComponent <> nil then begin if F_NormBase.GSCSBase.SCSComponent.IsLine = biTrue then begin for i := 0 to SavedLinesList.Count - 1 do begin CopyComponentToSCSObject(TOrthoLine(SavedLinesList[i]).ID, F_NormBase.GSCSBase.SCSComponent.ID, True); if isNormbaseCable then //(если кабель то посоединять) AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(SavedLinesList[i]).ID); end; end; end; end; end; FreeAndNil(SavedLinesList); // GCadForm.PCad.DeselectAll(2); // проверка на привязку объекта if TraceCount = 1 then begin if Result <> nil then if TOrthoLine(result).CheckTraceNotHaveConnect(False) then begin //GCadForm.PCad.Hint := ''; //GCadForm.PCad.ShowHint := True; //GCadForm.PCad.Hint := 'not connected'; if(GCurrShadowTraceX >0)and(GCurrShadowTraceY > 0)then ShowHintRzR(cCadClasses_Mes36, 2000); end; end else begin if TraceCount > 1 then begin if (Res1 <> nil) and (Res2 <> nil) then begin if TOrthoLine(Res1).CheckTraceNotHaveConnect(True) and TOrthoLine(Res2).CheckTraceNotHaveConnect(True) then begin if(GCurrShadowTraceX >0)and(GCurrShadowTraceY > 0)then begin ShowHintRzR(cCadClasses_Mes36, 2000); end; end; end; end; end; Application.ProcessMessages; //Sleep(1000); Sleep(200); if incab then ShowHintRzR('This is an unroutable area. You cannot place anything here!', 2000); Result := nil; GTraceStatus := False; SetLength(GTempActualPoints, 0); GClickIndex := 0; GIsLastShadowCleared := False; GSnapFiguresList.Clear; GCurrShadowTraceX := -1; GCurrShadowTraceY := -1; GFigureSnap := nil; GPrevFigureSnap := nil; GPrevFigureTraceTo := nil; GReDrawAfterRefresh := False; RefreshCAD(GCadForm.PCad); //Tolik 07/02/2021 -- GCadForm.FContinueTrace := false; GCadForm.PCad.SetTool(toSelect, ''); //if GOrthoStatus then //GOrthoStatus := False; GDefaultGap := 1; GDefaultNum := 1; //if CallAutoTraceElectricMaster then if (CallAutoTraceElectricMaster or GDropPcadTool) then begin if GOrthoStatus then GOrthoStatus := False; { GCadForm.FContinueTrace := false; GCadForm.PCad.SetTool(toSelect, ''); if GOrthoStatus then GOrthoStatus := False; GDefaultGap := 1; GDefaultNum := 1; } end else begin if FSCS_Main.tbCADToolsExpert.Visible then // Tolik -- если режим нуба - то пусть нажимает каждый раз тулзу рисования трассы begin GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); GCadForm.FContinueTrace := True; end; if GOrthoStatus then begin //GDefaultGap := 1; //GDefaultNum := 1; GOrthoStatus := True; GCurrentConnectorType := ct_Clear; if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbToolOrtholineExtExpert.Down := True; end else begin //FSCS_Main.tbSelectNoob.Down := False; //FSCS_Main.tbToolOrtholineExtNoob.Down := True; end; end else begin //GDefaultGap := 1; //GDefaultNum := 1; GOrthoStatus := False; GCurrentConnectorType := ct_Clear; if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbToolOrtholineExpert.Down := True; end else begin //FSCS_Main.tbSelectNoob.Down := False; //FSCS_Main.tbToolOrtholineNoob.Down := True; end; end; end; except on E: Exception do begin GWasShiftOnTraceCreate := False; // на всякий addExceptionToLogEx('TOrthoLine.CreateFromShadow', E.Message); GisOrthoLineHadow := False; end; end; //Tolik 28/08/2025 -- GDropComponent := SavedDropComponent; // GisOrthoLineHadow := False; // Tolik 27/08/2021 -- RestoreCadMarkedTraces; // Tolik 08/06/2021 -- восстановить список промаркированных трасс на каде //GCallAutoTraceElectricMaster := False; // Tolik 11/03/2021 -- GConnectEndPoints := False; // Tolik 01/04/2021 -- GCadForm.FCanSaveForUndo := True; EndProgress; GWasShiftOnTraceCreate := False; if SnapGrids then GCadform.PCad.SnapToGrids := True; if SnapGuides then GCadform.PCad.SnapToGuides := True; GPrevSnapFigureID := -1; // Tolik 11/03/2021 -- if BreakedELCableTracing then GCadForm.SCSUndoNormalList; CreatedTracesList.free; // Tolik 01/04/2021 -- GCadForm.FNoMoveConnectedObjects := WasCadNoMoveObjects; GCadForm.tbNoMoveConnectedObjects.Down := WasCadNoMoveObjectsPressed; GDropPcadTool := False; ClearTreeSelection; // Tolik 30/11/2021 -- // GCadform.PCad.NeedRefresh := True; GCadform.PCad.Refresh; end; (* class function TOrthoLine.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var i: integer; x, y, z: double; PrevFigure: TFigure; Connector: TFigure; isFigure: TFigure; ConnAsDefault: TConnectorObject; CableAsDefault: TOrthoLine; CurrSnapFigure: TFigure; CurrSavedConn: TConnectorObject; LastObjectHeight: Double; SavedConnectorsList: TList; SavedLinesList: TList; TypeIndex: Integer; SavedSnapFigure: TFigure; StartConn, EndConn: TConnectorObject; TraceCount: integer; Res1, Res2: TFigure; InCab: boolean; begin Result := nil; incab := false; BeginProgress; try SavedConnectorsList := TList.Create; SavedLinesList := TList.Create; Result := nil; Connector := nil; PrevFigure := nil; GTraceStatus := True; // Tolik -- 18/11/2015 TraceCount := 0; // if GCadForm.FAutoCadMouse then begin if GLastClickOrtho then GClickIndex := GClickIndex - 1; end; if ((GCadForm.FAutoCadMouse) and (GClickIndex >= 3)) or ((not GCadForm.FAutoCadMouse) and (GClickIndex >= 2)) then begin if GCadForm.FAutoCadMouse then TypeIndex := 2 else TypeIndex := 1; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; // Tolik -- 18/11/2015 -- проинициализировано, но не там...в самом начале нужно, а то если в это условие не попадем // а эта переменная юзается и вне условия -- получаем бяку // TraceCount := 0; // Res1 := nil; Res2 := nil; // Основной цикл создания трассы for i := 1 to GClickIndex - TypeIndex do begin //----- Connectors ------------------------------------------------------- Connector := TConnectorObject.Create(Shadow.ActualPoints[i].x, Shadow.ActualPoints[i].y, GCadForm.FLineHeight, LHandle, mydsNormal, aOwner); TConnectorObject(Connector).ConnectorType := GCurrentConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Connector, false); SavedConnectorsList.Add(Connector); // Saved SetConnBringToFront(TConnectorObject(Connector)); // привязка конектора к другой линии if PrevFigure <> nil then TOrthoLine(PrevFigure).SetJConnector2(Connector); //----- OrthoLine --------------------------------------------------------- Result := TOrthoLine.Create(Connector.ActualPoints[1].x, Connector.ActualPoints[1].y, GCadForm.FLineHeight, Shadow.ActualPoints[i + 1].x, Shadow.ActualPoints[i + 1].y, GCadForm.FLineHeight, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aOwner); TraceCount := TraceCount + 1; if i = 1 then Res1 := Result; if i = (GClickIndex - TypeIndex) then Res2 := Result; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Result, false); SavedLinesList.Add(Result); // Saved TOrtholine(Result).SetJConnector1(Connector); PrevFigure := Result; GCadForm.PCad.OrderFigureToFront(TOrtholine(Result).CaptionsGroup); end; //-----Connectors ---------------------------------------------------------- Connector := TConnectorObject.Create(Shadow.ActualPoints[i].x, Shadow.ActualPoints[i].y, GCadForm.FLineHeight, LHandle, mydsNormal, aOwner); TConnectorObject(Connector).ConnectorType := GCurrentConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Connector, False); SavedConnectorsList.Add(Connector); // Saved SetConnBringToFront(TConnectorObject(Connector)); // привязка конектора к другой линии TOrtholine(Result).SetJConnector2(Connector); // переставить высоты с соответствием с размещением между РМ if GCadForm.FAutoPosTraceBetweenRM then AutoPosTracesBetweenRM(SavedConnectorsList, SavedLinesList, GSnapFiguresList); if GAutoAddCableAfterDragDrop then begin if (GDropComponent <> nil) and (GDropComponent.IsLine = 1) then begin for i := 0 to SavedLinesList.Count - 1 do begin CopyComponentToSCSObject(TOrthoLine(SavedLinesList[i]).ID, GDropComponent.ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(SavedLinesList[i]).ID); end; end; GAutoAddCableAfterDragDrop := false; end; // Tolik -- 06/11/2016-- !!!! While GSnapFiguresList.Count < SavedConnectorsList.Count do GSnapFiguresList.Add(Nil); // // возможность подвязки! for i := 0 to SavedConnectorsList.Count - 1 do begin GMovedByOtherObject := True; CurrSavedConn := TConnectorObject(SavedConnectorsList[i]); CurrSnapFigure := TFigure(GSnapFiguresList[i]); GFigureSnap := CurrSnapFigure; // Через Линию if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin CheckingSnapConnectorToOrtholine(CurrSavedConn, TOrthoLine(GFigureSnap)); end // Через Дом else if CheckFigureByClassName(GFigureSnap, cTHouse) then begin SnapConnectorToHouse(CurrSavedConn, THouse(GFigureSnap)); end // Через ТО else if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin // Через пустой соединитель if TConnectorObject(GFigureSnap).ConnectorType = ct_Clear then begin CheckingSnapConnectorToConnector(CurrSavedConn, TConnectorObject(GFigureSnap)); end else // Через Объект begin SavedSnapFigure := GFigureSnap; if TConnectorObject(CurrSavedConn).ActualZOrder[1] <> TConnectorObject(GFigureSnap).ActualZOrder[1] then begin if (TConnectorObject(GFigureSnap).JoinedConnectorsList.Count = 0) and (TConnectorObject(GFigureSnap).JoinedOrtholinesList.Count = 0) then TConnectorObject(GFigureSnap).MoveConnector(CurrSavedConn.ActualPoints[1].x - TConnectorObject(GFigureSnap).ActualPoints[1].x, CurrSavedConn.ActualPoints[1].y - TConnectorObject(GFigureSnap).ActualPoints[1].y false, false); end; GFigureSnap := SavedSnapFigure; CheckingSnapConnectorToPointObject(CurrSavedConn, TConnectorObject(GFigureSnap), False); end; end; GMovedByOtherObject := False; end; /// ********************************************************************** if GCadForm.FAutoPosTraceBetweenRM then AutoPosTracesBetweenRMAfterSnap(SavedLinesList); // очистить привязки for i := 0 to GSnapFiguresList.Count - 1 do begin CurrSnapFigure := TFigure(GSnapFiguresList[i]); if CheckFigureByClassName(CurrSnapFigure, cTOrthoLine) then TOrthoLine(CurrSnapFigure).isSnap := False else if CheckFigureByClassName(CurrSnapFigure, cTConnectorObject) then TConnectorObject(CurrSnapFigure).isSnap := False; end; //31.01.2011 Если одним куском трассы соединили подъезды одного дома, то трассу разбиваем на два участка if ((GClickIndex-TypeIndex) = 1) then AutoDivideLine(TOrthoLine(Result)); //31.01.2011 - разделяем линию если нужно GCadForm.mProtocol.Lines.Add(cCadClasses_Mes1 + FormatFloat(ffMask, MetreToUOM(GCadForm.FLineHeight)) + cCadClasses_Mes2); // *UNDO* GCadForm.FCanSaveForUndo := True; end; for i := 0 to SavedLinesList.Count - 1 do begin CurrSnapFigure := TFigure(SavedLinesList[i]); if CheckFigureByClassName(CurrSnapFigure, cTOrtholine) then begin GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures ,CurrSnapFigure); if TOrtholine(CurrSnapFigure).InsideCabinet then begin incab := true; break; end; end; end; //////////////////////////////////////////////// if SavedConnectorsList <> nil then FreeAndNil(SavedConnectorsList); if SavedLinesList <> nil then FreeAndNil(SavedLinesList); GCadForm.PCad.DeselectAll(2); // проверка на привязку объекта if TraceCount = 1 then begin if Result <> nil then if TOrthoLine(result).CheckTraceNotHaveConnect(False) then begin //GCadForm.PCad.Hint := ''; //GCadForm.PCad.ShowHint := True; //GCadForm.PCad.Hint := 'not connected'; if(GCurrShadowTraceX >0)and(GCurrShadowTraceY > 0)then ShowHintRzR(cCadClasses_Mes36, 2000); end; end else begin if TraceCount > 1 then begin if (Res1 <> nil) and (Res2 <> nil) then begin if TOrthoLine(Res1).CheckTraceNotHaveConnect(True) and TOrthoLine(Res2).CheckTraceNotHaveConnect(True) then begin if(GCurrShadowTraceX >0)and(GCurrShadowTraceY > 0)then ShowHintRzR(cCadClasses_Mes36, 2000); end; end; end; end; Application.ProcessMessages; Sleep(1000); if incab then ShowHintRzR('This is an unroutable area. You cannot place anything here!', 2000); Result := nil; GTraceStatus := False; SetLength(GTempActualPoints, 0); GClickIndex := 0; GIsLastShadowCleared := False; GSnapFiguresList.Clear; GCurrShadowTraceX := -1; GCurrShadowTraceY := -1; GFigureSnap := nil; GPrevFigureSnap := nil; GPrevFigureTraceTo := nil; GReDrawAfterRefresh := False; RefreshCAD(GCadForm.PCad); GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); GCadForm.FContinueTrace := True; if GOrthoStatus then begin GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := True; GCurrentConnectorType := ct_Clear; if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbToolOrtholineExtExpert.Down := True; end else begin FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbToolOrtholineExtNoob.Down := True; end; end else begin GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := False; GCurrentConnectorType := ct_Clear; if FSCS_Main.tbCADToolsExpert.Visible then begin FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbToolOrtholineExpert.Down := True; end else begin FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbToolOrtholineNoob.Down := True; end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.CreateFromShadow', E.Message); end; EndProgress; end; *) class function TOrthoLine.CreateShadow(x, y: Double): TFigure; begin try Result := nil; Result := TOrthoLine.Create(x, y, GCadForm.FConnHeight, x, y, GCadForm.FConnHeight, 1, ord(psSolid), clBlack, 0, 0, dsTrace, nil); except on E: Exception do addExceptionToLogEx('TOrthoLine.CreateShadow', E.Message); end; end; function TOrthoLine.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; var LCount: Integer; i: integer; ListIndex: integer; PrevSnapFigure: TFigure; AddSnapFigure: TFigure; // Tolik -- 07/11/2016-- CanAddToList: Boolean; SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; //Tolik 25/07/2021 -- function CheckAdd(aFigure: Tfigure): Boolean; begin Result := True; if GSnapFiguresList.Count > 0 then if CheckFigurebyClassName(aFigure, cTConnectorObject) then if GSnapFiguresList[GSnapFiguresList.Count - 1] <> nil then if TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]).ID = aFigure.ID then Result := false; end; begin try // Tolik 03/03/2021 { if ClickIndex > 0 then if ClickIndex = GSnapFiguresList.Count then if GSnapFiguresList[ClickIndex - 1] = nil then GSnapFiguresList.delete(ClickIndex - 1);} // // Tolik 25/07/2021 -- { if gPrevSnapFigureID = -1 then begin if GSnapFiguresList.Count > 0 then if GSnapFiguresList[GSnapFiguresList.Count - 1] <> nil then gPrevSnapFigureID := TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]).Id; end; } Result := false; //Tolik 07/11/2016 -- CanAddToList := True; // AddSnapFigure := Nil; PrevSnapFigure := Nil; // Tolik -- 21/04/2017 -- if ssShift in GGlobalShiftState then GWasShiftOnTraceCreate := True; // if ClickIndex = 1 then begin GReDrawAfterRefresh := False; GPrevSnapFigureID := -1; end //Tolik 26/07/2021 -- else begin if GSnapFiguresList.Count > 0 then begin if TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) <> nil then GPrevSnapFigureID := TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]).ID; end; end; // GLastClickOrtho := False; if ClickIndex > 1 then begin if (GOrthoStatus) and (GFigureTraceTo <> nil) and CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then begin if not (DoubleCMP(OriginalPoints[1].x, OriginalPoints[3].x)) and not (DoubleCMP(OriginalPoints[1].y, OriginalPoints[3].y)) then begin //Tolik -- 20/04/2017 -- для ортогональных трасс добавлять лишнюю точку только, если // нне была зажата клавиша SHIFT -- иначе трасса бытет строиться точно от объекта к объекту и промежуточная // (ортогональная) точка в таком случае не нужна if not (ssShift in GGlobalShiftState) then begin GSnapFiguresList.Add(Nil); // Tolik -- 07/11/2016 -- // CanAddToList := False; // ActualPoints[ClickIndex] := OriginalPoints[2]; // сохранить в темповый массив SetLength(GTempActualPoints, ClickIndex + 1); GTempActualPoints[ClickIndex] := ActualPoints[ClickIndex]; ClickIndex := ClickIndex + 1; GClickIndex := ClickIndex; GLastClickOrtho := True; end; end; end; end; //Tolik //if CheckNoFigureinList(GFigureTraceTo, GSnapFiguresList) then if GFigureTraceTo <> nil then begin if (GSnapFiguresList.Count = 0) or ((GSnapFiguresList.Count > 0) and (TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) <> nil) and (TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]).ID <> TFigure(GFigureTraceTo).ID)) or ((GSnapFiguresList.Count > 0) and (TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) = nil)) then // begin LCount := GSnapFiguresList.Count; if LCount > 0 then PrevSnapFigure := TFigure(GSnapFiguresList[LCount - 1]) else PrevSnapFigure := Nil; // первый снеп - добавить if PrevSnapFigure = nil then begin AddSnapFigure := GFigureTraceTo; if AddSnapFigure <> nil then begin //Tolik--07/11/2016 -- if CanAddToList then begin CanAddToList := False; // if GPrevSnapFigureID = -1 then begin // Tolik 29/03/2021 -- //GSnapFiguresList.Add(AddSnapFigure); if AddSnapFigure is TOrthoLine then begin if GSnapFiguresList.IndexOf(AddSnapFigure) = -1 then begin GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end else begin {GSnapFiguresList.Add(nil); gPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; // end else begin if GPrevSnapFigureID = AddSnapFigure.ID then GSnapFiguresList.Add(Nil) else begin // Tolik 29/03/2021 -- //GSnapFiguresList.Add(AddSnapFigure); if AddSnapFigure is TOrthoLine then begin if GSnapFiguresList.IndexOf(AddSnapFigure) = -1 then begin GSnapFiguresList.Add(AddSnapFigure); GPrevSnapFigureID := AddSnapFigure.ID; end else begin {GSnapFiguresList.Add(nil); GPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(AddSnapFigure); GPrevSnapFigureID := AddSnapFigure.ID; end; // end; end; end; end; end else begin AddSnapFigure := GFigureTraceTo; if CheckFigureByClassName(PrevSnapFigure, cTConnectorObject) and CheckFigureByClassName(GFigureTraceTo, cTOrthoLine) then begin if (PrevSnapFigure = TOrthoLine(GFigureTraceTo).JoinConnector1) or (PrevSnapFigure = TOrthoLine(GFigureTraceTo).JoinConnector2) then begin //commented by Tolik 31/08/2021-- //TOrthoLine(GFigureTraceTo).isSnap := False; //AddSnapFigure := Nil; end; end else if CheckFigureByClassName(PrevSnapFigure, cTOrthoLine) and CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then begin if (TOrthoLine(PrevSnapFigure).JoinConnector1 = GFigureTraceTo) or (TOrthoLine(PrevSnapFigure).JoinConnector2 = GFigureTraceTo) then begin //commented by Tolik 31/08/2021-- //TConnectorObject(GFigureTraceTo).isSnap := False; //AddSnapFigure := Nil; end; end; if AddSnapFigure <> nil then begin //Tolik 07/11/2016 -- if CanAddToList then begin CanAddToList := False; // //GSnapFiguresList.Add(AddSnapFigure); if GPrevSnapFigureID = -1 then begin // Tolik 29/03/2021 -- //GSnapFiguresList.Add(AddSnapFigure); if AddSnapFigure is TOrthoLine then begin if GSnapFiguresList.IndexOf(AddSnapFigure) = -1 then begin GSnapFiguresList.Add(AddSnapFigure); GPrevSnapFigureID := AddSnapFigure.ID; end else begin {GSnapFiguresList.Add(nil); GPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(AddSnapFigure); GPrevSnapFigureID := AddSnapFigure.ID; end; // end else begin if GPrevSnapFigureID = AddSnapFigure.ID then GSnapFiguresList.Add(Nil) else begin // Tolik 29/03/2021 -- //GSnapFiguresList.Add(AddSnapFigure); if AddSnapFigure is TOrthoLine then begin if GSnapFiguresList.IndexOf(AddSnapFigure) = -1 then begin GSnapFiguresList.Add(AddSnapFigure); GPrevSnapFigureID := AddSnapFigure.ID; end else begin {GSnapFiguresList.Add(nil); GPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(AddSnapFigure); GPrevSnapFigureID := AddSnapFigure.ID; end; // end; end; end; end; end; end //Tolik else begin AddSnapFigure := GFigureTraceTo; if CanAddToList then begin CanAddToList := False; //GSnapFiguresList.Add(Nil); if GPrevSnapFigureID = -1 then begin // Tolik 29/03/2021 -- //GSnapFiguresList.Add(AddSnapFigure); if AddSnapFigure is TOrthoLine then begin if GSnapFiguresList.IndexOf(AddSnapFigure) = -1 then begin GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end else begin {GSnapFiguresList.Add(nil); gPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; // end else begin if GPrevSnapFigureID = AddSnapFigure.ID then //Tolik 26/07/2021 -- //GSnapFiguresList.Add(Nil) begin GSnapFiguresList.Add(Nil); //GPrevSnapFigureID := -1; //GFigureTraceTo := nil; end // else begin // Tolik 29/03/2021 -- //GSnapFiguresList.Add(AddSnapFigure); if AddSnapFigure is TOrthoLine then begin if GSnapFiguresList.IndexOf(AddSnapFigure) = -1 then begin GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end else begin {GSnapFiguresList.Add(nil); gPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; // end; end; end; end; // //Tolik end // else begin if CanAddToList then begin CanAddToList := False; // Tolik 19/03/2021 -- { GPrevSnapFigureID := -1; GSnapFiguresList.Add(Nil); } if GFigureSnap = nil then begin GPrevSnapFigureID := -1; GSnapFiguresList.Add(Nil); end else begin if GFigureSnap is TOrthoLine then begin if GSnapFiguresList.IndexOf(GFigureSnap) = -1 then begin GSnapFiguresList.Add(GFigureSnap); GPrevSnapFigureID := GFigureSnap.ID; end else begin {GSnapFiguresList.Add(nil); GPrevSnapFigureID := -1;} end; end else begin GSnapFiguresList.Add(GFigureSnap); GPrevSnapFigureID := GFigureSnap.ID; end; end; // end; end; // !!! if ClickIndex = 1 then if (GFigureTraceTo <> nil) then //Tolik begin // if CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then if TConnectorObject(GFigureTraceTo).ConnectorType <> ct_Clear then if TConnectorObject(GFigureTraceTo).ActualZOrder[1] <> GCadForm.FLineHeight then begin OriginalPoints[3]:= DoublePoint(TConnectorObject(GFigureTraceTo).ActualPoints[1].x, TConnectorObject(GFigureTraceTo).ActualPoints[1].y); end; end //{ //Tolik else begin if CanAddToList then begin // 19/03/2021 -- (* CanAddToList := False; //GPrevSnapFigureId := GSnapFiguresList.Add(Nil);//} *) if GFigureSnap = nil then begin GPrevSnapFigureID := -1; GSnapFiguresList.Add(Nil); end else begin //GSnapFiguresList.Add(GFigureSnap); //GPrevSnapFigureID := GFigureSnap.ID; if GFigureSnap is TOrthoLine then begin if GSnapFiguresList.IndexOf(GFigureSnap) = -1 then begin GSnapFiguresList.Add(GFigureSnap); GPrevSnapFigureID := GFigureSnap.ID; end else begin {GSnapFiguresList.Add(nil); GPrevSnapFigureID := -1;} GSnapFiguresList.Add(AddSnapFigure); gPrevSnapFigureID := AddSnapFigure.ID; end; end else begin GSnapFiguresList.Add(GFigureSnap); GPrevSnapFigureID := GFigureSnap.ID; end; end; // end; end; // // !!! OriginalPoints[1] := DoublePoint(x, y); OriginalPoints[1] := OriginalPoints[3]; ActualPoints[ClickIndex] := OriginalPoints[3]; // сохранить в темповый массив SetLength(GTempActualPoints, ClickIndex + 1); GTempActualPoints[ClickIndex] := ActualPoints[ClickIndex]; GClickIndex := ClickIndex; GcadForm.PCad.ClickIndex := ClickIndex; GCadForm.sbView.Panels[2].Text := cCadClasses_Mes3; // Tolik 22/03/2021 -- if GClickIndex > 1 then begin if GCallElectricAutoTraceMaster then begin if GAutoAddCableAfterDragDrop then begin //if GFigureTraceTo <> nil then if TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) <> nil then begin //if GFigureTraceTo is TConnectorObject then if TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) is TConnectorObject then begin //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(GFigureTraceTo.ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]).ID); if SCSCatalog <> nil then begin SCSCompon := SCSCatalog.GetFirstComponent; if SCScompon <> nil then begin if SCSCompon.IDNetType = 3 then begin if SCSCompon.ComponentType.SysName = ctsnShield then //begin //if GClickIndex > 1 then //begin Result := True; //end; //end; end; end; end; end; end; end; end; end; //Tolik 07/02/2022 -- if GClickIndex > 1 then begin if not Result then begin if TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) <> nil then begin //if GFigureTraceTo is TConnectorObject then if TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]) is TConnectorObject then begin //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(GFigureTraceTo.ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]).ID); if SCSCatalog <> nil then begin SCSCompon := SCSCatalog.GetFirstComponent; if SCSCompon <> nil then begin if SCSCompon.ComponentType.SysName = ctsnCupboard then Result := True; end; end; end; end; end; end; // except on E: Exception do addExceptionToLogEx('TOrthoLine.ShadowClick', E.Message); end; end; function TOrthoLine.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; var i: integer; cP: TDoublePoint; Len_X, Len_Y: double; AngleOut: Double; LenSize: Double; FullLenSize: Double; x1, y1: double; shiftOn: boolean; begin try Result := false; // Tolik 04/03/2021 -- MADE BY IGOR -- здесь меняется поведение SHIFT при ручной прокладке трассы, чтобы просто // мышкой можно было нарисовать трассу в любом направлении, а с SHIFT -- ТОЛЬКО ОРТОГОНАЛЬНО if (GOrthoStatus) then shiftOn := Not (ssShift in GGlobalShiftState) else shiftOn := ssShift in GGlobalShiftState; if shiftOn then //if Not (ssShift in GGlobalShiftState) then // begin angle := 1 / tan(GDefaultAngle * pi / 180 / 2); Len_X := abs(OriginalPoints[1].X - X); Len_Y := abs(OriginalPoints[1].Y - Y); if Len_X > Len_Y then begin if Len_X > angle * Len_Y then Y := OriginalPoints[1].Y else if Len_X < angle * Len_Y then begin if Y > OriginalPoints[1].Y then Y := OriginalPoints[1].Y + Len_X else if Y < OriginalPoints[1].Y then Y := OriginalPoints[1].Y - Len_X; end; end else if Len_X < Len_Y then begin if Len_Y > angle * Len_X then X := OriginalPoints[1].X else if Len_Y < angle * Len_X then begin if X > OriginalPoints[1].X then X := OriginalPoints[1].X + Len_Y else if X < OriginalPoints[1].X then X := OriginalPoints[1].X - Len_Y; end; end; // *VISIO* if (GOrthoStatus) and (GFigureTraceTo <> nil) and CheckFigureByClassName(GFigureTraceTo, cTConnectorObject) then begin x1 := TConnectorObject(GFigureTraceTo).ActualPoints[1].x; y1 := TConnectorObject(GFigureTraceTo).ActualPoints[1].y; if ssCtrl in GGlobalShiftState then begin x := x1; y := OriginalPoints[1].y; end else begin x := OriginalPoints[1].x; y := y1; end; end else begin x1 := x; y1 := y; end; // *VISIO* end else begin x1 := x; y1 := y; end; CP.X := X; CP.Y := Y; OriginalPoints[2] := cP; CP.X := X1; CP.Y := Y1; OriginalPoints[3] := cP; result := true; //// выводить угол и размеры текущей линии LenSize := SQRT(SQR(OriginalPoints[1].x - OriginalPoints[2].x) + SQR(OriginalPoints[1].y - OriginalPoints[2].y)); if ClickIndex = 1 then FullLenSize := LenSize else begin FullLenSize := 0; for i := ClickIndex downto 2 do begin FullLenSize := FullLenSize + SQRT(SQR(ActualPoints[ClickIndex].x - ActualPoints[ClickIndex - 1].x) + SQR(ActualPoints[ClickIndex].y - ActualPoints[ClickIndex - 1].y)); end; FullLenSize := FullLenSize + LenSize; end; if GCadForm.PCad.RulerMode = rmPage then begin LenSize := LenSize / 10; FullLenSize := FullLenSize / 10; GCadForm.sbView.Panels[1].Text := cCadClasses_Mes4 + FormatFloat(ffMask, MetreToUOM(LenSize)) + cCadClasses_Mes6 + cCadClasses_Mes5 + FormatFloat(ffMask, MetreToUOM(FullLenSize)) + cCadClasses_Mes6; end; if GCadForm.PCad.RulerMode = rmWorld then begin LenSize := LenSize / 1000 * GCadForm.PCad.MapScale; FullLenSize := FullLenSize / 1000 * GCadForm.PCad.MapScale; GCadForm.sbView.Panels[1].Text := cCadClasses_Mes4 + FormatFloat(ffMask, MetreToUOM(LenSize)) + GetUOMString(GCurrProjUnitOfMeasure) + cCadClasses_Mes5 + FormatFloat(ffMask, MetreToUOM(FullLenSize)) + GetUOMString(GCurrProjUnitOfMeasure); end; AngleOut := GetAngle(OriginalPoints[1].x, OriginalPoints[1].y, X, Y); GCadForm.sbView.Panels[2].Text := '> ' + FormatFloat(ffMask, AngleOut) + cCadClasses_Mes8; // текущее положение трейса для поиска объектов GCurrShadowTraceX := OriginalPoints[3].x; GCurrShadowTraceY := OriginalPoints[3].y; except on E: Exception do addExceptionToLogEx('TOrthoLine.ShadowTrace', E.Message); end; end; procedure TOrthoLine.GetModPoints(ModList: TMyList); var cp1, cp2, cp3, cp4, mPt: TDoublePoint; l, f, Gap2: Extended; SCSList: TSCSList; LObject: TSCSCatalog; begin try cp1 := ActualPoints[1]; cp2 := ActualPoints[2]; cp3.x := (cp1.x + cp2.x) / 2; cp3.y := (cp1.y + cp2.y) / 2; Gap2 := FGap / 2 + 0.2; l := sqrt(sqr(cp1.x - cp2.x) + sqr(cp1.y - cp2.y)); if l = 0 then l := 0.001; f := arcsin((abs(cp1.y - cp2.y) / l)) * 180 / pi; if ((cp1.x > cp2.x) and (cp1.y < cp2.y)) or ((cp1.x < cp2.x) and (cp1.y > cp2.y)) then f := f*(-1); cp4.x := Gap2 * cos((f + 90) * pi / 180) + cp3.x; cp4.y := Gap2 * sin((f + 90) * pi / 180) + cp3.y; cp3.x := Gap2 * cos((f - 90) * pi / 180) + cp3.x; cp3.y := Gap2 * sin((f - 90) * pi / 180) + cp3.y; // если это не спуск-подъем if not FIsRaiseUpDown then begin if FCount > 1 then begin // Tolik -- 11/04/2017 -- нельзя через GCadForm, так как это не всегда -- владелец фигуры, // НЕЛЬЗЯ ТАК ДЕЛАТЬ!!!!! БУДУТ ТРАБЛЫ ПРИ ЗАКРЫТИИ ПРОЕКТА!!! (* ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptLineEnd, ptRect, clBlue, pointdim + dimp_add, cp3.x, cp3.y, 11)); ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptLineEnd, ptRect, clBlue, pointdim + dimp_add, cp4.x, cp4.y, 22)); *) ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptLineEnd, ptRect, clBlue, pointdim + dimp_add, cp3.x, cp3.y, 11)); ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptLineEnd, ptRect, clBlue, pointdim + dimp_add, cp4.x, cp4.y, 22)); end; //22.07.2013 - точка для превращения трассы в ортогональную if (Not tmpDrawShadow) and (Not TPowerCad(Owner).IsDragging) then //Tolik 11/04/2017 -- //if GCadForm.PCad.Selection.Count <= 1 then if TPCDrawing(Self.Owner).Selection.Count <=1 then // if Not CmpFloatByCP(cp3.x, cp4.x) and Not CmpFloatByCP(cp3.y, cp4.y) then begin try { SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(Owner).Owner).FCADListID); if SCSList <> nil then begin LObject := SCSList.GetCatalogFromReferencesBySCSID(self.ID); //SCSList.GetCatalogFromSortedRefByID(self.ID); if LObject <> nil then begin if LObject.SCSComponents.Count = 0 then begin mPt := MPoint(cp3, cp4); ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptControlPoint, ptRect, clBlack, pointdim + 1, mPt.x, mPt.y, 15)); ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptControlPoint, ptRect, clYellow, pointdim, mPt.x, mPt.y, 0)); // Служебная для отрисовки другим цветом //FF7F00 end; end; end; } mPt := MPoint(cp3, cp4); // Tolik -- 11/04/2017 -- нельзя через GCadForm, так как это не всегда -- владелец фигуры, // НЕЛЬЗЯ ТАК ДЕЛАТЬ!!!!! БУДУТ ТРАБЛЫ ПРИ ЗАКРЫТИИ ПРОЕКТА!!! (* ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptControlPoint, ptRect, clBlack, pointdim + dimp_add, mPt.x, mPt.y, 15)); ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptControlPoint, ptRect, clYellow, pointdim, mPt.x, mPt.y, 0)); // Служебная для отрисовки другим цветом //FF7F00 *) ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptControlPoint, ptRect, clBlack, pointdim + dimp_add, mPt.x, mPt.y, 15)); ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptControlPoint, ptRect, clYellow, pointdim, mPt.x, mPt.y, 0)); // Служебная для отрисовки другим цветом //FF7F00 except end; end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetModPoints', E.Message); end; end; procedure TOrthoLine.Move(deltax, deltay: Double); var distx, disty: double; Cabinet: TCabinet; begin try MoveOrthoLine(deltax, deltay); // Auto ReAlign if GCadForm.PCad.SnapToGrids then begin if DrawStyle = mydsNormal then begin if not FIsRaiseUpDown then begin distx := abs(ActualPoints[1].x - ActualPoints[2].x); disty := abs(ActualPoints[1].y - ActualPoints[2].y); if (distx < GCadForm.PCad.GridStep) or (disty < GCadForm.PCad.GridStep) then ReAlignLine(Self); end; end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.Move', E.Message); end; end; procedure TOrthoLine.MoveOrthoLine(deltax, deltay: Double); var i, j: integer; CurrPointObject: TConnectorObject; CurrJoinedToPO: TConnectorObject; CurrClearConnector: TConnectorObject; RaiseObject1, RaiseObject2: TConnectorObject; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; MovedConnector1, MovedConnector2: TConnectorObject; Angle: Double; fulldeltax, fulldeltay: double; isMove: Boolean; GetConn: TConnectorObject; // Tolik 29/05/2017 -- RefreshFlag: boolean; // begin // Tolik 29/05/2017 -- RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; // try //Normal Style if DrawStyle = mydsNormal then begin GFigureSnap := Nil; FNotRecalcLength := True; GMovedByLine := True; // ДУБЛИКАТ !!! if (not FIsRaiseUpDown) and (not FIsVertical) then begin if (ssCtrl in GGlobalShiftState) and (not GMoveByArrow) then begin if GCadForm.PCad.SelectedCount = 1 then begin if not FConnectingLine then begin if (GLastTracedLinePoints1.x <> -10000) and (GLastTracedLinePoints2.x <> -10000) and (GLastTracedlinePoints1.y <> -10000) and (GLastTracedLinePoints2.y <> -10000) then CreateDuplicate; GLastTracedLinePoints1 := DoublePoint(-10000, -10000); GLastTracedLinePoints2 := DoublePoint(-10000, -10000); end; GCanRefreshCad := RefreshFlag; //Toilk --15/07/2019 -- Exit; end; end; end; // можно ли перемещать if GCadForm.FNoMoveConnectedObjects then if (TConnectorObject(JoinConnector1).JoinedConnectorsList.Count > 0) or (TConnectorObject(JoinConnector2).JoinedConnectorsList.Count > 0) or (GetRaiseConn(TConnectorObject(JoinConnector1)) <> nil) or (GetRaiseConn(TConnectorObject(JoinConnector2)) <> nil) or (TConnectorObject(JoinConnector1).FConnRaiseType <> crt_None) or (TConnectorObject(JoinConnector2).FConnRaiseType <> crt_None) then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes9); GCanRefreshCad := RefreshFlag; //Toilk --15/07/2019 -- Exit; end; if (GCadForm.PCad.SelectedCount > 1) and (GCadForm.FNoMoveConnectedObjects) then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes9); GCanRefreshCad := RefreshFlag; //Toilk --15/07/2019 -- Exit; end; if not FIsRaiseUpDown then begin if GCadForm.PCad.SelectedCount = 1 then begin if ssShift in GGlobalShiftState then begin if abs(deltax) >= abs(deltay) then begin deltay := 0; end else if abs(deltax) < abs(deltay) then begin deltax := 0; end; end; end; end; // C-П if FIsRaiseUpDown then begin if FObjectFromRaisedLine <> nil then TConnectorObject(FObjectFromRaisedLine).Move(deltax, deltay); end else if FIsVertical then begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then GetConn := TConnectorObject(JoinConnector1) else GetConn := TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]); if not GetConn.Selected then GetConn.Move(deltax, deltay); end else // ОБЫЧНЫЙ begin if (JoinConnector1 <> nil) AND (JoinConnector2 <> nil) then begin MovedConnector1 := TConnectorObject(JoinConnector1); MovedConnector2 := TConnectorObject(JoinConnector2); // Определение перемещающихся коннекторов // -1- if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count > 0 then MovedConnector1 := TConnectorObject(JoinConnector1).JoinedConnectorsList[0]; if TConnectorObject(JoinConnector1).FConnRaiseType <> crt_None then if TConnectorObject(JoinConnector1).FObjectFromRaise <> nil then MovedConnector1 := TConnectorObject(JoinConnector1).FObjectFromRaise; // -2- if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count > 0 then MovedConnector2 := TConnectorObject(JoinConnector2).JoinedConnectorsList[0]; if TConnectorObject(JoinConnector2).FConnRaiseType <> crt_None then if TConnectorObject(JoinConnector2).FObjectFromRaise <> nil then MovedConnector2 := TConnectorObject(JoinConnector2).FObjectFromRaise; // ******************************************************************* isMove := True; if (MovedConnector1.FIsApproach) and (not MovedConnector1.fHouse.Selected) then isMove := MovedConnector1.IsApproachInHouse(deltax, deltay); if (MovedConnector2.FIsApproach) and (not MovedConnector2.fHouse.Selected) then isMove := MovedConnector1.IsApproachInHouse(deltax, deltay); if isMove then begin // Перемещение через коннекторы if abs(ActualPoints[1].x - ActualPoints[2].x) < 0.1 then deltay := 0 else if abs(ActualPoints[1].y - ActualPoints[2].y) < 0.1 then deltax := 0; if (not MovedConnector1.Selected) and (not GDisableMove) then if not ((MovedConnector1.FIsHouseJoined) and (MovedConnector1.fHouse <> nil) and (MovedConnector1.fHouse.Selected)) then MovedConnector1.Move(deltax, deltay); if (not MovedConnector2.Selected) and (not GDisableMove) then if not ((MovedConnector2.FIsHouseJoined) and (MovedConnector2.fHouse <> nil) and (MovedConnector2.fHouse.Selected)) then MovedConnector2.Move(deltax, deltay); end else begin ShowMessage(cHouse_Mes1); end; // ******************************************************************* end; end; FNotRecalcLength := False; GMovedByLine := False; GtmpIsRaise := False; end //Trace Style else begin GMovedByLine := True; // С-П if GtmpIsRaise then begin if GtmpObjectFromRaisedLine <> nil then begin if GtmpObjectFromRaisedLine.DrawFigure.InFigures.Count = 0 then begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax + GtmpObjectFromRaisedLine.GrpSizeX / 2, ActualPoints[1].y + deltay - GtmpObjectFromRaisedLine.GrpSizeY / 2); ActualPoints[2] := DoublePoint(ActualPoints[1].x + 4, ActualPoints[1].y - 4); end else begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax + GtmpObjectFromRaisedLine.GrpSizeX / 2, ActualPoints[1].y + deltay - GtmpObjectFromRaisedLine.GrpSizeY / 2); ActualPoints[2] := DoublePoint(ActualPoints[1].x + 4, ActualPoints[1].y - 4); end; GtmpObjectFromRaisedLine := nil; end else begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); ActualPoints[2] := DoublePoint(ActualPoints[2].x + deltax, ActualPoints[2].y + deltay); end; end else // ОБЫЧНЫЙ begin // If Shift if GCadForm.PCad.SelectedCount = 1 then begin if ssShift in GGlobalShiftState then begin fulldeltax := GCurrMousePos.x - GMouseDownPos.x; fulldeltay := GCurrMousePos.y - GMouseDownPos.y; if abs(fulldeltax) >= abs(fulldeltay) then begin ActualPoints[1] := GBeforeDragOrthoLinesPoints1; ActualPoints[2] := GBeforeDragOrthoLinesPoints2; deltax := fulldeltax; deltay := 0; end else if abs(fulldeltax) < abs(fulldeltay) then begin ActualPoints[1] := GBeforeDragOrthoLinesPoints1; ActualPoints[2] := GBeforeDragOrthoLinesPoints2; deltay := fulldeltay; deltax := 0; end; end; end; // ===== //02/06/2016 - Tolik //ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); //ActualPoints[2] := DoublePoint(ActualPoints[2].x + deltax, ActualPoints[2].y + deltay); // if abs(ActualPoints[1].x - ActualPoints[2].x) < 0.1 then begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y); ActualPoints[2] := DoublePoint(ActualPoints[2].x + deltax, ActualPoints[2].y); end else if abs(ActualPoints[1].y - ActualPoints[2].y) < 0.1 then begin ActualPoints[1] := DoublePoint(ActualPoints[1].x, ActualPoints[1].y + deltay); ActualPoints[2] := DoublePoint(ActualPoints[2].x, ActualPoints[2].y + deltay); end else begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); ActualPoints[2] := DoublePoint(ActualPoints[2].x + deltax, ActualPoints[2].y + deltay); end; GLastTracedLinePoints1 := ActualPoints[1]; GLastTracedLinePoints2 := ActualPoints[2]; end; GMovedByLine := False; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.MoveOrthoLine', E.Message); end; GCanRefreshCad := RefreshFlag; //Toilk --29/05/2017 -- end; function TOrthoLine.CreateModification: TFigure; var Line: TOrtholine; begin try Result := nil; //22.07.2013 if assigned(TracePoint) then begin // сделать трассу ортогональной if TracePoint.SeqNbr = 15 then begin Result := TFigureGrp.Create(0, nil); Line := TOrthoLine.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], TracePoint.CoordX, TracePoint.CoordY, ActualZOrder[1], 1, ord(psSolid), clBlack, 0, 0, dsTrace, nil); TFigureGrp(Result).AddToGrp(Line); Line := TOrthoLine.Create(TracePoint.CoordX, TracePoint.CoordY, ActualZOrder[2], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], 1, ord(psSolid), clBlack, 0, 0, dsTrace, nil); TFigureGrp(Result).AddToGrp(Line); end; end; if Result = nil then begin Result := TOrthoLine.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], 1, ord(psSolid), clBlack, 0, 0, dsTrace, nil); TOrthoLine(Result).FGap := FGap; TOrthoLine(Result).FCount := FCount; TOrthoLine(Result).FDrawFigure := DrawFigure; TOrthoLine(Result).FOrthoLineType := OrthoLineType; GBeforeDragOrthoLinesPoints1 := TOrthoLine(Result).ActualPoints[1]; GBeforeDragOrthoLinesPoints2 := TOrthoLine(Result).ActualPoints[2]; GtmpIsRaise := FIsRaiseUpDown; // нельзя ставить - иначе трейс не отрисует, после рихтовок - отрисовывает TOrthoLine(Result).FIsRaiseUpDown := FIsRaiseUpDown; TOrthoLine(Result).FDrawFigurePercent := 0; TOrthoLine(Result).FObjectFromRaisedLine := FObjectFromRaisedLine; if FIsRaiseUpDown then TOrthoLine(Result).FDrawFigurePercent := FDrawFigurePercent; GtmpObjectFromRaisedLine := FObjectFromRaisedLine; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.CreateModification', E.Message); end; end; function TOrthoLine.TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): Boolean; var Point: TDoublePoint; x1, y1, x2, y2, x3, y3, x4, y4: Double; len, f1, f2, f3: Extended; ModRotate: Boolean; //22.07.2013 op1, op2, CurrPt: TDoublePoint; op: PDoublePoint; begin try Result := false; // Tolik 04/2021 if (ssShift in GGlobalShiftState) then ModRotate := false else ModRotate := true; {if (ssShift in GGlobalShiftState) then ModRotate := true else ModRotate := false;} // Point := DoublePoint(x, y); // если 1 модпоинт if mp.SeqNbr = 1 then begin if ActualPoints[1].x = ActualPoints[2].x then begin TraceFigure.ActualPoints[1] := DoublePoint(x, ActualPoints[1].y); TraceFigure.ActualPoints[2] := DoublePoint(x, ActualPoints[2].y); end else if ActualPoints[1].y = ActualPoints[2].y then begin TraceFigure.ActualPoints[1] := DoublePoint(ActualPoints[1].x, y); TraceFigure.ActualPoints[2] := DoublePoint(ActualPoints[2].x, y); end else begin TraceFigure.ActualPoints[1] := DoublePoint(x - (ActualPoints[2].x - ActualPoints[1].x) / 2, y - (ActualPoints[2].y - ActualPoints[1].y) / 2); TraceFigure.ActualPoints[2] := DoublePoint(x + (ActualPoints[2].x - ActualPoints[1].x) / 2, y + (ActualPoints[2].y - ActualPoints[1].y) / 2); end; end; // при мультилинии с возможностью вращения if ((mp.SeqNbr = 11) or (mp.SeqNbr = 22)) then begin x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; x3 := (x1 + x2) / 2; y3 := (y1 + y2) / 2; x4 := x3; y4 := y3; len := sqrt(sqr(x1 - x2) + sqr(y1 - y2)); if len = 0 then len := 0.001; f1 := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f1 := f1 * (-1); x1 := x3; y1 := y3; x2 := Point.x; y2 := Point.y; FGap := sqrt(sqr(x1 - x2) + sqr(y1 - y2)); if FGap = 0 then FGap := 0.001; f2 := arcsin((abs(y1 - y2) / FGap)) * 180 / pi; if ((x1 > x2) and (y1 < y2)) or ((x1 < x2) and (y1 > y2)) then f2 := f2 * (-1); f3 := (90 - f1) + f2; f3 := 90 - f3; FGap := FGap * 2; if (ModRotate = false) then FGap := FGap * sin(f3 * pi / 180) else begin x3 := (len / 2) * cos((f2 + 90) * pi/180) + x1; y3 := (len / 2) * sin((f2 + 90) * pi/180) + y1; x4 := (len / 2) * cos((f2 - 90) * pi/180) + x1; y4 := (len / 2) * sin((f2 - 90) * pi/180) + y1; end; TOrthoLine(TraceFigure).FGap := FGap; GDefaultGap := FGap; if (ModRotate = true) then begin TraceFigure.ActualPoints[1] := DoublePoint(x3, y3); TraceFigure.ActualPoints[2] := DoublePoint(x4, y4); ActualPoints[1] := DoublePoint(x3, y3); ActualPoints[2] := DoublePoint(x4, y4); end; end //22.07.2013 - преобразование линии в орто else if mp.SeqNbr = 15 then begin CurrPt := DoublePoint(x,y); op1 := DoublePoint(ActualPoints[1].x, ActualPoints[2].y); op2 := DoublePoint(ActualPoints[2].x, ActualPoints[1].y); op := nil; if GetLineLenght(op1, CurrPt) < GetLineLenght(op2, CurrPt) then op := @op1 else op := @op2; if op <> nil then begin TFigure(TFigureGrp(TraceFigure).InFigures[0]).ActualPoints[2] := op^; TFigure(TFigureGrp(TraceFigure).InFigures[1]).ActualPoints[1] := op^; end; end; Result := True; except on E: Exception do addExceptionToLogEx('TOrthoLine.TraceModification', E.Message); end; end; function TOrthoLine.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): Boolean; var RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ConnectedConn: TConnectorObject; op: TDoublePoint; begin try Result := false; //22.07.2013 if mp.SeqNbr = 15 then begin if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; ConnectedConn := DivideLineSimple(Self); if ConnectedConn <> nil then begin op := TFigure(TFigureGrp(TraceFigure).InFigures[0]).ActualPoints[2]; ConnectedConn.Move(op.x-ConnectedConn.ActualPoints[1].x, op.y-ConnectedConn.ActualPoints[1].y); end; GCadForm.FCanSaveForUndo := true; end else begin GCadForm.PCad.DeselectAll(2); if FCount = 1 then Move(x - (ActualPoints[1].x + ActualPoints[2].x) / 2, y - (ActualPoints[1].y + ActualPoints[2].y) / 2); if FCount > 1 then begin JoinConnector1.Move(ActualPoints[1].x - JoinConnector1.ActualPoints[1].x, ActualPoints[1].y - JoinConnector1.ActualPoints[1].y); JoinConnector2.Move(ActualPoints[2].x - JoinConnector2.ActualPoints[2].x, ActualPoints[2].y - JoinConnector2.ActualPoints[2].y); ActualPoints[1] := JoinConnector1.ActualPoints[1]; ActualPoints[2] := JoinConnector2.ActualPoints[1]; end; FGap := abs(FGap); Result := true; Select; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.EndModification', E.Message); end; end; function TOrthoLine.Duplicate: TFigure; begin try Result := nil; Result := TOrthoLine.create(ActualPoints[1].x + 5, ActualPoints[1].y + 5, ActualZOrder[1], ActualPoints[2].x + 5, ActualPoints[2].y + 5, ActualZOrder[2], 1, ord(psSolid), clBlack, 0, LayerHandle, DrawStyle, Owner); except on E: Exception do addExceptionToLogEx('TOrthoLine.Duplicate', E.Message); end; end; procedure TOrthoLine.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); var x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: Double; len, f, Gap2: Extended; cp1: TDoublePoint; cp2: TDoublePoint; figMaxX1, figMaxY1, figMinX1, figMinY1: Double; xmax,xmin,ymax,ymin: double; XGAP: Double; begin try cp1 := ActualPoints[1]; cp2 := ActualPoints[2]; x1 := cp1.x; y1 := cp1.y; x2 := cp2.x; y2 := cp2.y; if FCount > 0 then begin xmax := max(x1, x2); xmin := min(x1, x2); ymax := max(y1, y2); ymin := min(y1, y2); len := sqrt(sqr(xmax - xmin) + sqr(ymax - ymin)); if len = 0 then len := 0.001; Gap2 := 0; XGap := 0; if FCount > 1 then begin Gap2 := FGap / 2; XGap := FGap - ((FGap / (FCount - 1)) * 0) - Gap2; f := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f := f * (-1); x3 := XGap * cos((f - 90) * pi / 180) + x1; y3 := XGap * sin((f - 90) * pi / 180) + y1; x4 := XGap * cos((f - 90) * pi / 180) + x2; y4 := XGap * sin((f - 90) * pi / 180) + y2; XGap := FGap - ((FGap / (FCount - 1)) * (FCount - 1)) - Gap2; f := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f := f * (-1); x5 := XGap * cos((f - 90) * pi / 180) + x1; y5 := XGap * sin((f - 90) * pi / 180) + y1; x6 := XGap * cos((f - 90) * pi / 180) + x2; y6 := XGap * sin((f - 90) * pi / 180) + y2; figMaxX1 := max(x3, x4); figMaxX := max(x5,x6); figMaxX := max(figMaxX1, figMaxX); figMinX1 := min(x3, x4); figMinX := min(x5,x6); figMinX := min(figMinX1, figMinX); figMaxY1 := max(y3, y4); figMaxY := max(y5,y6); figMaxY := max(figMaxY1, figMaxY); figMinY1 := min(y3, y4); figMinY := min(y5,y6); figMinY := min(figMinY1, figMinY); end else begin f := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f := f * (-1); x3 := cos((f - 90) * pi / 180) + x1; y3 := sin((f - 90) * pi / 180) + y1; x4 := cos((f - 90) * pi / 180) + x2; y4 := sin((f - 90) * pi / 180) + y2; figMaxX := max(x3, x4); figMinX := min(x3, x4); figMaxY := max(y3, y4); figMinY := min(y3, y4); end; end else inherited GetBounds(figMaxX, figMaxY, figMinX, figMinY); except // Tolik 01/07/2019 - - // on E: Exception do addExceptionToLogEx('TOrthoLine.GetBounds', E.Message); on E: Exception do begin addExceptionToLogEx('TOrthoLine.GetBounds', E.Message); figMaxX := 0; figMinX := 0; figMaxY := 0; figMinY := 0; end; end; end; // Tolik 23/12/2019 -- старая закомменчена -- см ниже.... function PtInPoly(const poly: TPolyArr; p: Tpoint) : Boolean; var i,j : integer; res1, res2, res3: Double; Begin result := false; j := High(poly); For i := Low(poly) to High(poly) do begin res1 := poly[j].x - poly[i].x; res2 := p.y - poly[i].y; res3 := res1 * res2; if ( (((poly[i].y <= p.y) and (p.y < poly[j].y)) or ((poly[j].y <= p.y) and (p.y < poly[i].y)) ) and (p.x < ((res3 / (poly[j].y - poly[i].y)) + poly[i].x)) ) then result := not result; j := i; end; End; { function PtInPoly(const poly: TPolyArr; p: Tpoint) : Boolean; var i,j : integer; Begin result := false; j := High(poly); For i := Low(poly) to High(poly) do begin if ( ( ((poly[i].y <= p.y) and (p.y < poly[j].y)) or ((poly[j].y <= p.y) and (p.y < poly[i].y)) ) and (p.x < ((poly[j].x - poly[i].x) * (p.y - poly[i].y) / (poly[j].y - poly[i].y) + poly[i].x)) ) then result := not result; j := i end; End; } function TOrthoLine.isPointIn(x, y: Double): boolean; var x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: Double; len, f, Gap2: Extended; RegHandle: HRGN; Points: array[0..4] of TPoint; BasisPoints: TDoublePoint; RaizeKoeff: Double; Res2: boolean; PArr: TPolyArr; NeedPoint: TPoint; aZoomScaleCad: double; begin try Result := false; FRegionPointsIsActual := False; if Not FRegionPointsIsActual then begin RaizeKoeff := 1; x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; {*******************************************************} // ПОДЪЕМ - СПУСК if (FIsRaiseUpDown) and (FObjectFromRaisedLine <> nil) and (ConnectorDetect(FObjectFromRaisedLine)) then begin RaizeKoeff := Self.FDrawFigurePercent / 100; if FObjectFromRaisedLine.DrawFigure.InFigures.Count = 0 then begin BasisPoints.x := FObjectFromRaisedLine.ActualPoints[1].x + FObjectFromRaisedLine.GrpSizeX / 2; BasisPoints.y := FObjectFromRaisedLine.ActualPoints[1].y - FObjectFromRaisedLine.GrpSizeY / 2; end else begin BasisPoints.x := FObjectFromRaisedLine.DrawFigure.CenterPoint.x + FObjectFromRaisedLine.GrpSizeX / 2; BasisPoints.y := FObjectFromRaisedLine.DrawFigure.CenterPoint.y - FObjectFromRaisedLine.GrpSizeY / 2; end; if FLineRaiseType = lrt_Up then begin if FObjectFromRaisedLine.DrawFigure.InFigures.Count > 0 then {TODO вырулить аналогично для lrt_Down} {DONE} begin if (RaizeKoeff > 0.5) then begin x1 := BasisPoints.x - (0.2 * RaizeKoeff); //1.5 y1 := BasisPoints.y + (0.2 * RaizeKoeff); //1.5 x2 := BasisPoints.x + (2.3 * RaizeKoeff); //2.5 y2 := BasisPoints.y - (2.3 * RaizeKoeff); //2.5 end else begin if (RaizeKoeff > 0.2) then begin x1 := BasisPoints.x - (1.1 * RaizeKoeff); //1.5 y1 := BasisPoints.y + (1.1 * RaizeKoeff); //1.5 x2 := BasisPoints.x + (1.3 * RaizeKoeff); y2 := BasisPoints.y - (1.3 * RaizeKoeff); end else begin x1 := BasisPoints.x - (2.5 * RaizeKoeff); //1.5 y1 := BasisPoints.y + (2.5 * RaizeKoeff); //1.5 x2 := BasisPoints.x + (0 * RaizeKoeff); y2 := BasisPoints.y - (0 * RaizeKoeff); end; end; end else begin x1 := BasisPoints.x; y1 := BasisPoints.y; x2 := BasisPoints.x + (2.5 * RaizeKoeff); //2.5 y2 := BasisPoints.y - (2.5 * RaizeKoeff); //2.5 end; end else if FLineRaiseType = lrt_Down then begin if FObjectFromRaisedLine.DrawFigure.InFigures.Count > 0 then {TODO вырулить аналогично для lrt_Down} {DONE} begin if (RaizeKoeff > 0.5) then begin x1 := BasisPoints.x - (1.7 * RaizeKoeff); y1 := BasisPoints.y + (1.7 * RaizeKoeff); x2 := BasisPoints.x + (3.8 * RaizeKoeff); y2 := BasisPoints.y - (3.8 * RaizeKoeff); end else begin if (RaizeKoeff > 0.2) then begin x1 := BasisPoints.x - (2.6 * RaizeKoeff); y1 := BasisPoints.y + (2.6 * RaizeKoeff); x2 := BasisPoints.x + (2.8 * RaizeKoeff); y2 := BasisPoints.y - (2.8 * RaizeKoeff); end else begin x1 := BasisPoints.x - (4.0 * RaizeKoeff); y1 := BasisPoints.y + (4.0 * RaizeKoeff); x2 := BasisPoints.x + (1.5 * RaizeKoeff); y2 := BasisPoints.y - (1.5 * RaizeKoeff); end; end; end else begin x1 := BasisPoints.x + (1.5 * RaizeKoeff); y1 := BasisPoints.y - (1.5 * RaizeKoeff); x2 := BasisPoints.x + (4 * RaizeKoeff); y2 := BasisPoints.y - (4 * RaizeKoeff); end; end; end; // if FIsVertical then // begin // x1 := ActualPoints[1].x; // y1 := ActualPoints[1].y; // x2 := ActualPoints[1].x + 4; // y2 := ActualPoints[1].y - 4; // end; {*******************************************************} Gap2 := FGap / 2 + 0.2; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; if (GCadForm.PCad.ZoomScale >= 500) and (GCadForm.PCad.ZoomScale < 1000) then aZoomScaleCad := GCadForm.PCad.ZoomScale / 2 else if GCadForm.PCad.ZoomScale >= 1000 then aZoomScaleCad := GCadForm.PCad.ZoomScale / 3; end; //if (aZoomScaleCad > 50) then // adim1 := adim1 / (aZoomScaleCad / 100); if aZoomScaleCad > 0 then begin Gap2 := Gap2 / (aZoomScaleCad / 100); end; len := sqrt(sqr(x1 - x2) + sqr(y1 - y2)); if len = 0 then len := 0.001; f := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f := f * (-1); try x3 := Gap2 * cos((f - 90) * pi / 180) + x1; y3 := Gap2 * sin((f - 90) * pi / 180) + y1; x4 := Gap2 * cos((f + 90) * pi / 180) + x1; y4 := Gap2 * sin((f + 90) * pi / 180) + y1; x5 := Gap2 * cos((f - 90) * pi / 180) + x2; y5 := Gap2 * sin((f - 90) * pi / 180) + y2; x6 := Gap2 * cos((f + 90) * pi / 180) + x2; y6 := Gap2 * sin((f + 90) * pi / 180) + y2; except Result := false; Exit; end; Points[0].x := round(x3 * 100); Points[0].y := round(y3 * 100); Points[1].x := round(x5 * 100); Points[1].y := round(y5 * 100); Points[2].x := round(x6 * 100); Points[2].y := round(y6 * 100); Points[3].x := round(x4 * 100); Points[3].y := round(y4 * 100); FRegionPoints[0].X := Points[0].x; FRegionPoints[0].y := Points[0].y; FRegionPoints[1].X := Points[1].x; FRegionPoints[1].y := Points[1].y; FRegionPoints[2].X := Points[2].x; FRegionPoints[2].y := Points[2].y; FRegionPoints[3].X := Points[3].x; FRegionPoints[3].y := Points[3].y; FRegionPointsIsActual := True; end else begin Points[0].x := FRegionPoints[0].X; Points[0].y := FRegionPoints[0].y; Points[1].x := FRegionPoints[1].X; Points[1].y := FRegionPoints[1].y; Points[2].x := FRegionPoints[2].X; Points[2].y := FRegionPoints[2].y; Points[3].x := FRegionPoints[3].X; Points[3].y := FRegionPoints[3].y; end; //RegHandle := CreatePolygonRgn(Points, 4, WINDING); //result := PtInRegion(RegHandle, round(x * 100), round(y * 100)); //DeleteObject(RegHandle); Parr[1].X := Points[0].x; Parr[1].y := Points[0].y; Parr[2].X := Points[1].x; Parr[2].y := Points[1].y; Parr[3].X := Points[2].x; Parr[3].y := Points[2].y; Parr[4].X := Points[3].x; Parr[4].y := Points[3].y; NeedPoint.X := round(x * 100); NeedPoint.y := round(y * 100); //res2 := PtInPoly(PArr, NeedPoint); //if result <> res2 then // res2 := result; result := PtInPoly(PArr, NeedPoint); // VERTICAL *** if not Result then if FIsVertical then begin if (x > ActualPoints[1].x - 0.5) and (x < ActualPoints[1].x + 0.5) and (y > ActualPoints[1].y - 0.5) and (y < ActualPoints[1].y + 0.5) then Result := True; end; //05.04.2011 - Если объект скрыт от прорисовки, значит не даем его выделить мышкой if Not FIsDraw and Not Selected and (Not(ssShift in GGlobalShiftState)) then Result := false; except on E: Exception do addExceptionToLogEx('TOrthoLine.isPointIn', E.Message); end; end; destructor TOrthoLine.Destroy; begin try if TDrawStyle(DrawStyle) <> dsTrace then begin try if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then TF_CAD(TPowerCad(Owner ).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TOrthoLine.Destroy FNeedUpdateCheckedFigures', E.Message); end; end; //Tolik if Length(FActualZOrder) > 0 then SetLength(FActualZOrder, 0); if (Owner <> nil) then // Tolik 04/02/2020 -- begin //if TPowerCad(Owner).FRemFigure then if OutTextCaptions <> nil then begin // OutTextCaptions.Clear; OutTextCaptions.Free; OutTextCaptions := nil; // Tolik 23/03/2017 -- end; if OutTextNotes <> nil then begin //OutTextNotes.Clear; OutTextNotes.Free; OutTextNotes := Nil; // Tolik 23/03/2017 -- end; //////////////////////////////// if FTraceCaptionsList <> nil then begin //FTraceCaptionsList.Clear; FreeAndNil(FTraceCaptionsList); end; end; // 21.09.2105 Tolik GCadForm.PCad.Figures сюда уже может как nil попасть, потому лучше вообще так не делать, // чтобы не нарваться на AV на пустом месте { if FDrawFigure <> nil then if GCadForm.PCad.Figures.IndexOf(FDrawFigure) = -1 then //FreeAndNil(FDrawFigure); НЕЛЬЗЯ ТАК ДЕЛАТЬ FDrawFigure.Delete; // нужно так и везде так делать //} //Tolik 04/03/2017 -- //CrossList.free; // FreeAndDisposeList(CrossList); inherited; except on E: Exception do addExceptionToLogEx('TOrthoLine.Destroy', E.Message); end; end; function TOrthoLine.GetActualZOrder(Index: Integer): Double; var DynArrLen: integer; begin try result := 0; DynArrLen := length(FActualZOrder); if (Index <= DynArrLen) And (Index > 0)then result := FActualZOrder[Index - 1]; except // on E: Exception do addExceptionToLogEx('TOrthoLine.GetActualZOrder', E.Message); end; end; procedure TOrthoLine.SetActualZOrder(Index: Integer; const Value: Double); var DynArrLen: integer; begin try DynArrLen := length(FActualZOrder); if Index > DynArrLen then SetLength(FACtualZOrder, Index); FActualZOrder[Index - 1] := Value; except on E: Exception do addExceptionToLogEx('TOrthoLine.SetActualZOrder', E.Message); end; end; // Tolik -- 03/04/2017 -- старая закомменчена (смотри ниже) procedure TOrthoLine.ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean; OldCaptionList: TStringList = nil; OldH: Double = -1; OldW: Double = -1); var i, j, k: integer; CaptionsLHandle: integer; CPLine: TDoublePoint; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; PointsPos: TDoublePoint; CurAngle: Double; MvAngle: Double; CapStrings: TStrings; FRecreate: Boolean; OutTextStrings: TStringList; SavedCaptionPos: TDoublePoint; ObjectFromRaise: TConnectorObject; BasisPoint: TDoublePoint; Point1, Point2: TDoublePoint; Bnd: TDoubleRect; CapWidth: Double; PointObject: TConnectorObject; Captions: TRichTextMod; Background: TRectangle; FontStyles: TFontStyles; // Tolik --> 27/11/2015 Maxx, Maxy, Minx, Miny: double; CanMoveCaption: Boolean; NewH, NewW, deltaX, deltaY: double; LineCount: Integer; h1: double; LineAngle: Double; EmptyLineCount: integer; OneCaptionsLineHeight: double; EmptyblockH: double; DeltaH: Double; CadRefreshFlag: Boolean; CanReturnToPos: Boolean; CanDelEmptyPos: Boolean; PE_DeltaX, PE_DeltaY: Double; AngleRad: Double; // begin CadRefreshFlag := GCanRefreshCad; try if Self.deleted then exit; // Tolik 05/04/2017 -- если не показывать длину трассы - сбрасывать выравнивание подписи под линию (*{$IF Not Defined(SCS_PE)}*) if not ShowLength then begin FCaptionsViewType := cv_UnderLine; Self.CaptionsGroupH := 0; end; (*{$IFEND}*) // //Tolik CanMoveCaption := False; if FCaptionsViewType <> cv_Auto then Self.CaptionsGroupH := 0 else begin // Save Font Size Before if ((CaptionsGroup <> nil) and (CaptionsGroup.InFigures.count = 2)) then begin Captions := TRichTextMod(CaptionsGroup.InFigures[1]); // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, OldH, OldW); end else begin // OldH := -1; // OldW := -1; end; //04/04/2017 -- if ((CaptionsGroup <> nil) and (Self.CaptionsGroupH = 0)) then Self.CaptionsGroupH := Self.CalcHCaptionsGroup; end; // FontStyles := []; if FCaptionsFontBold then FontStyles := [fsBold]; OutTextStrings := TStringList.create; // Tolik 05/04/2017 -- CanReturnToPos := True; //11.10.2011 if GCadForm.FShowLineCaptionsType = skExternalSCS then begin for i := 0 to OutTextCaptions.Count - 1 do begin if i = 1 then begin if ShowLength then OutTextStrings.Add(OutTextCaptions.Strings[i]); end else //Tolik 05/04/2017 -- если не показывать длину, то пустые строки не берем // OutTextStrings.Add(OutTextCaptions.Strings[i]); begin if OutTextCaptions.Strings[i] <> '' then OutTextStrings.Add(OutTextCaptions.Strings[i]) else CanReturnToPos := False; end; // end; end else begin for i := 0 to OutTextCaptions.Count - 1 do begin if i = 0 then begin if ShowLength then OutTextStrings.Add(OutTextCaptions.Strings[i]); end else //Tolik 05/04/2017 -- если не показывать длину, то пустые строки не берем // OutTextStrings.Add(OutTextCaptions.Strings[i]); begin if ShowLength then OutTextStrings.Add(OutTextCaptions.Strings[i]) else begin if (OutTextCaptions.Strings[i] <> '') then OutTextStrings.Add(OutTextCaptions.Strings[i]) else CanReturnToPos := False; end; end; // end; end; if aNeedReCreate then FRecreate := True else begin if CaptionsGroup <> nil then begin Captions := TRichTextMod(CaptionsGroup.InFigures[1]); CapStrings := Captions.re.Lines; end else CapStrings := nil; //11.10.2011 OutTextStrings := TStringList.Create; // !!! // 11.10.2011 //if GCadForm.FShowLineCaptionsType = skExternalSCS then //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 1 then // begin // if ShowLength then // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end // else // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end; //end //else //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 0 then // begin // if ShowLength then // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end // else // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end; //end; // !!! FRecreate := IsStringListsDifferent(OutTextStrings, CapStrings); //11.10.2011 FreeAndNil(OutTextStrings); end; if CaptionsGroup <> nil then SavedCaptionPos := CaptionsGroup.CenterPoint; //Tolik //GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', OldCaptionList, OldH, OldW); // if FRecreate then begin CaptionsLHandle := GCadForm.PCad.GetLayerHandle(3); if CaptionsGroup <> nil then begin RemoveInFigureGrp(CaptionsGroup); GCadForm.PCad.Figures.Remove(CaptionsGroup); FreeAndNil(CaptionsGroup); end; //11.10.2011 - Упрощен способ расчета размеров {Captions := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption, 2); Captions.RE.Lines.Clear; Captions.re.Font.Size := FCaptionsFontSize; Captions.re.Font.Name := FCaptionsFontName; Captions.re.Font.Color := FCaptionsFontColor; if FCaptionsFontBold then Captions.re.Font.Style := [fsBold] else Captions.re.Font.Style := []; if GCadForm.PCad.PageColor = 0 then Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor + 1 else Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor - 1; // !!! //11.10.2011 //if GCadForm.FShowLineCaptionsType = skExternalSCS then //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 1 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end //else //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 0 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end; for i := 0 to OutTextStrings.Count - 1 do Captions.RE.Lines.Add(OutTextStrings[i]); //11.10.2011 // ПОЛУЧИТЬ СВОЙСТВА xCanvas := TMetafileCanvas.Create(Captions.Metafile, 0); xCanvas.Font.Name := Captions.re.Font.Name; xCanvas.Font.Size := Captions.re.Font.Size; xCanvas.Font.Style := Captions.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Captions.re.Lines.Count + 1; w := 0; for i := 0 to Captions.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(Captions.Re.Lines[i]) then w := xCanvas.TextWidth(Captions.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // ПЕРЕСОЗДАТЬ С НОВЫМИ СВОЙСТВАМИ if Captions <> nil then begin FreeAndNil(Captions); end;} // Tolik -- 25/11/2015 // GetTextSize(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', OutTextStrings, h, w); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', OutTextStrings, h, w); // Captions := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption, 2); Captions.RE.Lines.Clear; Captions.re.Font.Size := FCaptionsFontSize; Captions.re.Font.Name := FCaptionsFontName; Captions.re.Font.Color := FCaptionsFontColor; //11.10.2011 if FCaptionsFontBold then //11.10.2011 Captions.re.Font.Style := [fsBold] //11.10.2011 else //11.10.2011 Captions.re.Font.Style := []; Captions.re.Font.Style := FontStyles; if GCadForm.PCad.PageColor = 0 then Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor + 1 else Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor - 1; // !!! //11.10.2011 //if GCadForm.FShowLineCaptionsType = skExternalSCS then //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 1 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end //else //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 0 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end; for i := 0 to OutTextStrings.Count - 1 do begin OutTextStrings[i] := FastReplace(OutTextStrings[i],#13#10,' '); Captions.RE.Lines.Add(OutTextStrings[i]); //11.10.2011 end; Captions.Visible := True; // !!! // с обычным фоном Background := TRectangle.create(-100, -100, -100, -100, 1, ord(psClear), clNone, ord(bsClear), clNone, CaptionsLHandle, mydsNormal, GCadForm.PCad); Background.Visible := True; CaptionsGroup := TFigureGrpNotMod.create(CaptionsLHandle, GCadForm.PCad); CaptionsGroup.Radius := 2; CaptionsGroup.AddFigure(Background); CaptionsGroup.AddFigure(Captions); CaptionsGroup.LockModify := True; CaptionsGroup.Visible := True; GCadForm.PCad.AddCustomFigure(GLN (CaptionsLHandle), CaptionsGroup, False); end; if FIsRaiseUpDown then begin ObjectFromRaise := nil; // !!!! // 1 if JoinConnector1 <> nil then begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then begin if TConnectorObject(JoinConnector1).FConnRaiseType <> crt_None then ObjectFromRaise := TConnectorObject(JoinConnector1).FObjectFromRaise; end else begin PointObject := TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]); if PointObject.FConnRaiseType <> crt_None then ObjectFromRaise := PointObject.FObjectFromRaise; end; end; // 2 // Tolik 31/05/2016 -- if JoinConnector2 <> nil then // begin if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then begin if TConnectorObject(JoinConnector2).FConnRaiseType <> crt_None then ObjectFromRaise := TConnectorObject(JoinConnector2).FObjectFromRaise; end else begin PointObject := TConnectorObject(TConnectorObject(JoinConnector2).JoinedConnectorsList[0]); if PointObject.FConnRaiseType <> crt_None then ObjectFromRaise := PointObject.FObjectFromRaise; end; end; if ObjectFromRaise <> nil then begin if ObjectFromRaise.DrawFigure.InFigures.Count = 0 then begin BasisPoint.x := ObjectFromRaise.ActualPoints[1].x + ObjectFromRaise.GrpSizeX / 2; BasisPoint.y := ObjectFromRaise.ActualPoints[1].y - ObjectFromRaise.GrpSizeY / 2; end else begin BasisPoint.x := ObjectFromRaise.DrawFigure.CenterPoint.x + ObjectFromRaise.GrpSizeX / 2 - 0.5; BasisPoint.y := ObjectFromRaise.DrawFigure.CenterPoint.y - ObjectFromRaise.GrpSizeY / 2 + 0.5; end; Point1.x := BasisPoint.x; Point1.y := BasisPoint.y; Point2.x := BasisPoint.x + 4; Point2.y := BasisPoint.y - 4; Bnd := CaptionsGroup.GetBoundRect; CapWidth := abs(Bnd.Right - Bnd.Left); CPLine.x := (Point1.x + Point2.x) / 2 + CapWidth / 2 + 2; CPLine.y := (Point1.y + Point2.y) / 2; CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); end; end else begin Background := TRectangle(CaptionsGroup.InFigures[0]); Captions := TRichTextMod(CaptionsGroup.InFigures[1]); CPLine.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; CPLine.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; CurAngle := Captions.AngletoPoint; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then begin CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); end else begin // new mark // если не отображается длина - не будем вращать //CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставим как было CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); // Tolik ** --- тут надкись уже, по идлее выставлена по центру линии // остается только сдвинуть ее немножко в сторону CaptionsGroup.GetBounds(MaxX, MaxY, MinX, MinY); LineAngle := GetAngleDF(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); While LineAngle > 360 do LineAngle := LineAngle - 360; AngleRad := (LineAngle*PI) / 180; PE_DeltaX := (MaxX - Minx + GRPSizeY/2 + 0.25)*Sin(AngleRad); PE_DeltaY := (Maxy - MinY + GrpSizeY/2 + 0.25)*Cos(AngleRad); { if (LineAngle >= 0) and (LineAngle < 180) then begin PE_DeltaX := -PE_DeltaX; PE_DeltaY := -PE_DeltaY; end;} if (LineAngle >= 90) and (LineAngle <= 180) then begin PE_DeltaX := PE_DeltaX; PE_DeltaY := -PE_DeltaY; end; if (LineAngle > 180) and (LineAngle <= 270) then begin //dd := dx; //dx := -dy; //dy := dx; PE_DeltaX := PE_DeltaX; PE_DeltaY := -PE_DeltaY; end; if (LineAngle >= 270) and (LineAngle <= 360) then begin PE_DeltaX := -PE_DeltaX; PE_DeltaY := PE_DeltaY; end; //if (LineAngle >= 0) and (LineAngle <= 90) then if (LineAngle >= 0) and (LineAngle < 90) then begin PE_DeltaX := -PE_DeltaX; PE_DeltaY := PE_DeltaY; end; // под линией {if FCaptionsViewType = cv_UnderLine then begin PE_DeltaX := -PE_DeltaX; PE_DeltaY := -PE_DeltaY; end;} CaptionsGroup.Move(PE_DeltaX/2, PE_DeltaY/2); // end; {$ELSE} //Tolik CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); //CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); //CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); // {$IFEND} //11.10.2011 - Упрощен способ расчета размеров {xCanvas := TMetafileCanvas.Create(Captions.Metafile, 0); xCanvas.Font.Name := Captions.re.Font.Name; xCanvas.Font.Size := Captions.re.Font.Size; xCanvas.Font.Style := Captions.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Captions.re.Lines.Count + 1; FreeAndNil(xCanvas);} // Tolik -- 17/12/2015 -- если надпись по центру, то нужнен не центр надписи, а центр пустых строк if FCaptionsViewType = cv_Center then // Tolik 23/12/2015 -- юзать только свойства линии, так как после открытия проекта, например, // TRichText не поднимет свойства шрифта и будет бяка - разногласие в размерах // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, h, w); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, h, w) // else // Tolik 23/12/2015 -- юзать только свойства линии, так как после открытия проекта, например, // TRichText не поднимет свойства шрифта и будет бяка - разногласие в размерах // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, h, w); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, h, w); // // подвинуть подпись вверх/вниз if Captions.re.Lines.Count > 0 then begin if GCadForm.FShowLineCaptionsType = skExternalSCS then PointsPos := GetCaptionsGroupNewPos(h / 2 / Captions.re.Lines.Count, Captions.re.Lines.Count) else begin // Tolik 22/12/2015 -- учесть высоту FDrawFigure (если над/под линией) if ((FCaptionsViewType = cv_OverLine) or (FCaptionsViewType = cv_UnderLine)) then begin if Captions.re.Lines.Count > 1 then PointsPos := GetCaptionsGroupNewPos((h - 1) / 2 + GrpSizeY/2, Captions.re.Lines.Count) // PointsPos := GetCaptionsGroupNewPos((h - 1) / 2, Captions.re.Lines.Count) else if Captions.re.Lines.Count = 1 then PointsPos := GetCaptionsGroupNewPos(h / 2 + GrpSizeY/2, Captions.re.Lines.Count); // PointsPos := GetCaptionsGroupNewPos(h / 2, Captions.re.Lines.Count); end else begin if Captions.re.Lines.Count > 1 then PointsPos := GetCaptionsGroupNewPos((h - 1) / 2, Captions.re.Lines.Count) else if Captions.re.Lines.Count = 1 then PointsPos := GetCaptionsGroupNewPos(h / 2, Captions.re.Lines.Count); end; end; end else PointsPos := CPLine; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then // Tolik 12/04/2017 -- begin CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x, PointsPos.y - CaptionsGroup.CenterPoint.y); if FCaptionsViewType = cv_Center then begin MvAngle := AngleCalcDF(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); if Captions.re.Lines.Count <= 3 then begin NewH := 0; { if Captions.re.Lines.Count <> 1 then NewH := 0.25 } if Captions.re.Lines.Count > 0 then begin //NewH := (h - 1)/2; NewH := 0.7; //OneCaptionsLineHeight := (h - 1)/Captions.Re.Lines.Count; end; end else if Captions.re.Lines.Count > 3 then begin CanMoveCaption := False; // это на всякий, чтобы не ебнулось, вдруг пользователь чего-то наколдовал с надписью вручную // а ХЗ откуда придет LineCount := 1; k := 1; EmptyLineCount := 0; While Captions.re.Lines[k] = '' do begin Inc(EmptyLineCount); Inc(LineCount); Inc(k); if Captions.re.Lines[k] <> '' then CanMoveCaption := True; if k = Captions.re.Lines.Count - 1 then break; end; {if CanMoveCaption then begin Inc(LineCount); if LineCount < Captions.re.Lines.Count then begin NewH := ((Captions.re.Lines.Count - LineCount) * ((h - 1)/LineCount)) / 2; end; end;} if CanMoveCaption then begin OneCaptionsLineHeight := (h - 1)/Captions.Re.Lines.Count; NewH := (h - 1)/2 - OneCaptionsLineHeight - ((EmptyLineCount/2)*OneCaptionsLineHeight) + 0.25; //NewH := (h - 1)/2 - ((EmptyLineCount/2)*OneCaptionsLineHeight); end; end; LineAngle := GetAngleDF(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); While LineAngle > 360 do LineAngle := LineAngle - 360; // mvAngle := LineAngle * pi / 180; deltaX := NewH * sin(mvAngle); // mvAngle := mvAngle + pi; deltaY := NewH*cos(mvAngle); if (LineAngle >= 90) and (LineAngle <= 180) then begin deltaX := deltaX; deltaY := -deltaY; end; if (LineAngle >= 180) and (LineAngle <= 270) then begin //dd := dx; //dx := -dy; //dy := dx; deltaX := deltaX; deltaY := -deltaY; end; if (LineAngle >= 270) and (LineAngle <= 360) then begin deltaX := -deltaX; deltaY := deltaY; end; //if (LineAngle >= 0) and (LineAngle <= 90) then if (LineAngle >= 0) and (LineAngle < 90) then begin deltaX := -deltaX; deltaY := deltaY; end; // deltaX := NewH*Sin(mvAngle); // deltaY := NewH*Cos(mvAngle); CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x + deltaX, PointsPos.y - CaptionsGroup.CenterPoint.y + deltaY); end; end // else begin // new mark // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставим как было // Tolik 1/04/2017 -- // //if ShowLength then // 12/04/2017 -- { begin // Tolik 22/12/2015 -- учесть высоту FDrawFigure (если над/под линией) if ((FCaptionsViewType = cv_OverLine) or (FCaptionsViewType = cv_UnderLine)) then begin if Captions.re.Lines.Count > 1 then PointsPos := GetCaptionsGroupNewPos((h - 1) / 2 + GrpSizeY/2, Captions.re.Lines.Count) // PointsPos := GetCaptionsGroupNewPos((h - 1) / 2, Captions.re.Lines.Count) else if Captions.re.Lines.Count = 1 then PointsPos := GetCaptionsGroupNewPos(h / 2 + GrpSizeY/2, Captions.re.Lines.Count); // PointsPos := GetCaptionsGroupNewPos(h / 2, Captions.re.Lines.Count); end else begin if Captions.re.Lines.Count > 1 then PointsPos := GetCaptionsGroupNewPos((h - 1) / 2, Captions.re.Lines.Count) else if Captions.re.Lines.Count = 1 then PointsPos := GetCaptionsGroupNewPos(h / 2, Captions.re.Lines.Count); end; CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x, PointsPos.y - CaptionsGroup.CenterPoint.y); end; } //CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x, PointsPos.y - CaptionsGroup.CenterPoint.y); end; {$ELSE} // Tolik 22/12/2015 -- определить смещение центра надписи (Если выравнивание надписи - по центру) deltaX := 0; deltaY := 0; if FCaptionsViewType = cv_Center then begin MvAngle := AngleCalcDF(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); if Captions.re.Lines.Count <= 3 then begin NewH := 0; { if Captions.re.Lines.Count <> 1 then NewH := 0.25 } if Captions.re.Lines.Count > 0 then begin //NewH := (h - 1)/2; NewH := 0.7; //OneCaptionsLineHeight := (h - 1)/Captions.Re.Lines.Count; end; end else if Captions.re.Lines.Count > 3 then begin CanMoveCaption := False; // это на всякий, чтобы не ебнулось, вдруг пользователь чего-то наколдовал с надписью вручную // а ХЗ откуда придет LineCount := 1; k := 1; EmptyLineCount := 0; While Captions.re.Lines[k] = '' do begin Inc(EmptyLineCount); Inc(LineCount); Inc(k); if Captions.re.Lines[k] <> '' then CanMoveCaption := True; if k = Captions.re.Lines.Count - 1 then break; end; {if CanMoveCaption then begin Inc(LineCount); if LineCount < Captions.re.Lines.Count then begin NewH := ((Captions.re.Lines.Count - LineCount) * ((h - 1)/LineCount)) / 2; end; end;} if CanMoveCaption then begin OneCaptionsLineHeight := (h - 1)/Captions.Re.Lines.Count; NewH := (h - 1)/2 - OneCaptionsLineHeight - ((EmptyLineCount/2)*OneCaptionsLineHeight) + 0.25; //NewH := (h - 1)/2 - ((EmptyLineCount/2)*OneCaptionsLineHeight); end; end; LineAngle := GetAngleDF(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); While LineAngle > 360 do LineAngle := LineAngle - 360; // mvAngle := LineAngle * pi / 180; deltaX := NewH * sin(mvAngle); // mvAngle := mvAngle + pi; deltaY := NewH*cos(mvAngle); if (LineAngle >= 90) and (LineAngle <= 180) then begin deltaX := deltaX; deltaY := -deltaY; end; if (LineAngle >= 180) and (LineAngle <= 270) then begin //dd := dx; //dx := -dy; //dy := dx; deltaX := deltaX; deltaY := -deltaY; end; if (LineAngle >= 270) and (LineAngle <= 360) then begin deltaX := -deltaX; deltaY := deltaY; end; //if (LineAngle >= 0) and (LineAngle <= 90) then if (LineAngle >= 0) and (LineAngle < 90) then begin deltaX := -deltaX; deltaY := deltaY; end; // deltaX := NewH*Sin(mvAngle); // deltaY := NewH*Cos(mvAngle); end; // CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x + deltaX, PointsPos.y - CaptionsGroup.CenterPoint.y + deltaY); {$IFEND} // Tolik--25/11/2015 -- в перерасчете угла поворота убраны округления // MvAngle := AngleCalc(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); MvAngle := AngleCalcDF(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then begin CaptionsGroup.Rotate(MvAngle, CaptionsGroup.CenterPoint); end else begin // new mark // если не отображается длина - не вращаем //CaptionsGroup.Rotate(MvAngle, CaptionsGroup.CenterPoint); end; {$ELSE} CaptionsGroup.Rotate(MvAngle, CaptionsGroup.CenterPoint); {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока не меняем ничего { if Not ShowLength then // new mark begin CaptionsGroup.Move(abs(CaptionsGroup.ap2.x - CaptionsGroup.ap1.x)/2, 0); end; } {$IFEND} end; // вернуть позицию подписи перед модификацией // Tolik if (aReturnToPos and (FCaptionsViewType <> cv_Center)) then begin if CanReturnToPos then // если из надписи были удалены пустые строчки, то // возвращаться на старую позицию нельзя begin //05/04/2017 -- возвращаться на позицию только, если не изменилось количество строчек в подписи к трассе !!! if (OldCaptionList = nil) or ((OldCaptionList <> nil) and (OldCaptionList.Count = Captions.re.Lines.Count)) then begin // if CaptionsGroup <> nil then // if (CaptionsGroup <> nil) and (FCaptionsViewType = cv_Auto) then begin {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then begin CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); if OldCaptionList = nil then begin // Это если, допустим, размер шрифта поменялся if (OldH <> -1) and (OldW <> -1) then begin //if OldCaptionList.Count = Captions.re.Lines.count then begin // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, NewH, NewW); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, NewH, NewW); deltaX := (OldW/2 - NewW/2)*sin(CaptionsGroup.AngleToPoint); // ширина deltaY := (OldH/2 - NewH/2)*cos(CaptionsGroup.AngletoPoint); // высота if FCaptionsViewType = cv_underLine then begin deltax := -deltax; deltay := - deltay; end; CaptionsGroup.Move(deltaX, deltaY); end; end; end end else begin // new mark // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставляем как есть CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); //CaptionsGroup.Move(abs(CaptionsGroup.ap2.x - CaptionsGroup.ap1.x)/2, 0); end; {$ELSE} // Tolik -- 01/12/2015 -- CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); if Self.FCaptionsViewType <> cv_Center then // если по центру, то пох begin // если размер надписи по дороге изменился, то нужно учесть и смещение центра новой надписи относительно того, что было, // а то херня кака-то получается if OldCaptionList = nil then begin // Это если, допустим, размер шрифта поменялся if (OldH <> -1) and (OldW <> -1) then begin //if OldCaptionList.Count = Captions.re.Lines.count then begin // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, NewH, NewW); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, NewH, NewW); deltaX := (OldW/2 - NewW/2)*sin(CaptionsGroup.AngleToPoint); // ширина deltaY := (OldH/2 - NewH/2)*cos(CaptionsGroup.AngletoPoint); // высота if FCaptionsViewType = cv_underLine then begin deltax := -deltax; deltay := - deltay; end; CaptionsGroup.Move(deltaX, deltaY); end; end; end else // сюда придем, когда к трассе добавится какой-нить элемент типа каб канала begin (* if OutTextStrings.Count <> OldCaptionList.Count then begin CaptionsGroup.Move(CPLine.X - CaptionsGroup.CenterPoint.X, CPLine.Y - CaptionsGroup.CenterPoint.Y); // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, NewH, NewW); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, NewH, NewW); // NewH := NewH - 1; // сбрасываем 1 // 03/04/2017 -- // OldH := NewH/OldCaptionList.Count; //GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', OutTextStrings, OldH, OldW); //OldH := oldH - 1; //OldH := OldH/OldCaptionList.Count; // Newh := NewH/OutTextStrings.Count; //Newh := NewH/Captions.re.Lines.Count; { if FCaptionsViewType = cv_OverLine then //h1 := (NewH - OldH)/2 - GrpSizeY/2 h1 := (NewH - 1)/2 + GrpSizeY/2 else if FCaptionsViewType = cv_UnderLine then //h1 := (NewH - OldH)/2 + GrpSizeY/2; h1 := (NewH - 1)/2 + GrpSizeY/2; } //h1 := ((NewH - 1)*Captions.re.Lines.Count)/2 + GrpSizeY/2; //h1 := (NewH - 1)/2 + GrpSizeY/2; deltaX := (OldW/2 - NewW/2)*sin(CaptionsGroup.AngleToPoint); // ширина deltaY := (OldH/2 - NewH/2)*cos(CaptionsGroup.AngletoPoint); // высота if FCaptionsViewType = cv_underLine then begin deltax := -deltax; deltay := - deltay; end; { h1 := (NewH)/2 + GrpSizeY/2 + 1; deltaX := h1 * Sin(CaptionsGroup.AngletoPoint); deltaY := h1 * Cos(CaptionsGroup.AngletoPoint); if FCaptionsViewType = cv_UnderLine then begin deltaX := -deltaX; deltaY := -deltaY; end else if FCaptionsViewType = cv_OverLine then begin deltaX := -deltaX; deltaY := deltaY; end; } // Tolik 04/04/2017 -- //CaptionsGroup.Move(deltaX, deltay); CaptionsGroup.Move(deltaX,deltay); //CaptionsGroup.Move(PointsPos.X - CaptionsGroup.CenterPoint.X + deltaX, PointsPos.Y - CaptionsGroup.CenterPoint.Y + deltay); // end; *) end; end; // {$IFEND} end end; end else begin // если был сброс позиционирования надписи -- удалить пустые строчки (на всякий) CanDelEmptyPos := true; while CanDelEmptyPos do begin CanDelEmptyPos := False; for i := 0 to OutTextCaptions.Count - 1 do begin if OutTextCaptions[i] = '' then begin OutTextCaptions.Delete(i); CanDelEmptyPos := True; break; end; end; end; end; end; // Tolik -- 22/09/2016 -- чтобы надпись не оказалась под линией - выдвинуть наверх if self.Owner <> nil then begin TPowerCad(Self.Owner).OrderFigureToFront(CaptionsGroup); end; //OutTextStrings.Free; FreeAndNil(OutTextStrings); //CadRefreshFlag := GCanRefreshCad; {GCanRefreshCad := True; GCadForm.PCad.Refresh; GCanRefReshCad := CadRefreshFlag;} except on E: Exception do addExceptionToLogEx('TOrthoLine.ReCreateCaptionsGroup', E.Message); end; GCanRefReshCad := CadRefreshFlag; GCadForm.PCad.Refresh; end; (* //procedure TOrthoLine.ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean; OldCaptionList: TStringList = nil); procedure TOrthoLine.ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean; OldCaptionList: TStringList = nil; OldH: Double = -1; OldW: Double = -1); var i, j, k: integer; CaptionsLHandle: integer; CPLine: TDoublePoint; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; PointsPos: TDoublePoint; CurAngle: Double; MvAngle: Double; CapStrings: TStrings; FRecreate: Boolean; OutTextStrings: TStringList; SavedCaptionPos: TDoublePoint; ObjectFromRaise: TConnectorObject; BasisPoint: TDoublePoint; Point1, Point2: TDoublePoint; Bnd: TDoubleRect; CapWidth: Double; PointObject: TConnectorObject; Captions: TRichTextMod; Background: TRectangle; FontStyles: TFontStyles; // Tolik --> 27/11/2015 Maxx, Maxy, Minx, Miny: double; CanMoveCaption: Boolean; NewH, NewW, deltaX, deltaY: double; LineCount: Integer; h1: double; LineAngle: Double; // begin try if Self.deleted then exit; //Tolik CanMoveCaption := False; if FCaptionsViewType <> cv_Auto then Self.CaptionsGroupH := 0 else begin // Save Font Size Before if ((CaptionsGroup <> nil) and (CaptionsGroup.InFigures.count = 2)) then begin Captions := TRichTextMod(CaptionsGroup.InFigures[1]); // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, OldH, OldW); end else begin // OldH := -1; // OldW := -1; end; end; // FontStyles := []; if FCaptionsFontBold then FontStyles := [fsBold]; OutTextStrings := TStringList.create; //11.10.2011 if GCadForm.FShowLineCaptionsType = skExternalSCS then begin for i := 0 to OutTextCaptions.Count - 1 do begin if i = 1 then begin if ShowLength then OutTextStrings.Add(OutTextCaptions.Strings[i]); end else OutTextStrings.Add(OutTextCaptions.Strings[i]); end; end else begin for i := 0 to OutTextCaptions.Count - 1 do begin if i = 0 then begin if ShowLength then OutTextStrings.Add(OutTextCaptions.Strings[i]); end else OutTextStrings.Add(OutTextCaptions.Strings[i]); end; end; if aNeedReCreate then FRecreate := True else begin if CaptionsGroup <> nil then begin Captions := TRichTextMod(CaptionsGroup.InFigures[1]); CapStrings := Captions.re.Lines; end else CapStrings := nil; //11.10.2011 OutTextStrings := TStringList.Create; // !!! // 11.10.2011 //if GCadForm.FShowLineCaptionsType = skExternalSCS then //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 1 then // begin // if ShowLength then // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end // else // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end; //end //else //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 0 then // begin // if ShowLength then // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end // else // OutTextStrings.Add(OutTextCaptions.Strings[i]); // end; //end; // !!! FRecreate := IsStringListsDifferent(OutTextStrings, CapStrings); //11.10.2011 FreeAndNil(OutTextStrings); end; if CaptionsGroup <> nil then SavedCaptionPos := CaptionsGroup.CenterPoint; //Tolik //GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', OldCaptionList, OldH, OldW); // if FRecreate then begin CaptionsLHandle := GCadForm.PCad.GetLayerHandle(3); if CaptionsGroup <> nil then begin RemoveInFigureGrp(CaptionsGroup); GCadForm.PCad.Figures.Remove(CaptionsGroup); FreeAndNil(CaptionsGroup); end; //11.10.2011 - Упрощен способ расчета размеров {Captions := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption, 2); Captions.RE.Lines.Clear; Captions.re.Font.Size := FCaptionsFontSize; Captions.re.Font.Name := FCaptionsFontName; Captions.re.Font.Color := FCaptionsFontColor; if FCaptionsFontBold then Captions.re.Font.Style := [fsBold] else Captions.re.Font.Style := []; if GCadForm.PCad.PageColor = 0 then Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor + 1 else Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor - 1; // !!! //11.10.2011 //if GCadForm.FShowLineCaptionsType = skExternalSCS then //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 1 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end //else //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 0 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end; for i := 0 to OutTextStrings.Count - 1 do Captions.RE.Lines.Add(OutTextStrings[i]); //11.10.2011 // ПОЛУЧИТЬ СВОЙСТВА xCanvas := TMetafileCanvas.Create(Captions.Metafile, 0); xCanvas.Font.Name := Captions.re.Font.Name; xCanvas.Font.Size := Captions.re.Font.Size; xCanvas.Font.Style := Captions.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Captions.re.Lines.Count + 1; w := 0; for i := 0 to Captions.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(Captions.Re.Lines[i]) then w := xCanvas.TextWidth(Captions.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // ПЕРЕСОЗДАТЬ С НОВЫМИ СВОЙСТВАМИ if Captions <> nil then begin FreeAndNil(Captions); end;} // Tolik -- 25/11/2015 // GetTextSize(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', OutTextStrings, h, w); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', OutTextStrings, h, w); // Captions := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption, 2); Captions.RE.Lines.Clear; Captions.re.Font.Size := FCaptionsFontSize; Captions.re.Font.Name := FCaptionsFontName; Captions.re.Font.Color := FCaptionsFontColor; //11.10.2011 if FCaptionsFontBold then //11.10.2011 Captions.re.Font.Style := [fsBold] //11.10.2011 else //11.10.2011 Captions.re.Font.Style := []; Captions.re.Font.Style := FontStyles; if GCadForm.PCad.PageColor = 0 then Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor + 1 else Captions.re.DefAttributes.BackColor := GCadForm.PCad.PageColor - 1; // !!! //11.10.2011 //if GCadForm.FShowLineCaptionsType = skExternalSCS then //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 1 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end //else //begin // for i := 0 to OutTextCaptions.Count - 1 do // begin // if i = 0 then // begin // if ShowLength then // Captions.RE.Lines.Add(OutTextCaptions[i]); // end // else // Captions.RE.Lines.Add(OutTextCaptions[i]); // end; //end; for i := 0 to OutTextStrings.Count - 1 do Captions.RE.Lines.Add(OutTextStrings[i]); //11.10.2011 Captions.Visible := True; // !!! // с обычным фоном Background := TRectangle.create(-100, -100, -100, -100, 1, ord(psClear), clNone, ord(bsClear), clNone, CaptionsLHandle, mydsNormal, GCadForm.PCad); Background.Visible := True; CaptionsGroup := TFigureGrpNotMod.create(CaptionsLHandle, GCadForm.PCad); CaptionsGroup.Radius := 2; CaptionsGroup.AddFigure(Background); CaptionsGroup.AddFigure(Captions); CaptionsGroup.LockModify := True; CaptionsGroup.Visible := True; GCadForm.PCad.AddCustomFigure(GLN (CaptionsLHandle), CaptionsGroup, False); end; if FIsRaiseUpDown then begin ObjectFromRaise := nil; // !!!! // 1 if JoinConnector1 <> nil then begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then begin if TConnectorObject(JoinConnector1).FConnRaiseType <> crt_None then ObjectFromRaise := TConnectorObject(JoinConnector1).FObjectFromRaise; end else begin PointObject := TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]); if PointObject.FConnRaiseType <> crt_None then ObjectFromRaise := PointObject.FObjectFromRaise; end; end; // 2 // Tolik 31/05/2016 -- if JoinConnector2 <> nil then // begin if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then begin if TConnectorObject(JoinConnector2).FConnRaiseType <> crt_None then ObjectFromRaise := TConnectorObject(JoinConnector2).FObjectFromRaise; end else begin PointObject := TConnectorObject(TConnectorObject(JoinConnector2).JoinedConnectorsList[0]); if PointObject.FConnRaiseType <> crt_None then ObjectFromRaise := PointObject.FObjectFromRaise; end; end; if ObjectFromRaise <> nil then begin if ObjectFromRaise.DrawFigure.InFigures.Count = 0 then begin BasisPoint.x := ObjectFromRaise.ActualPoints[1].x + ObjectFromRaise.GrpSizeX / 2; BasisPoint.y := ObjectFromRaise.ActualPoints[1].y - ObjectFromRaise.GrpSizeY / 2; end else begin BasisPoint.x := ObjectFromRaise.DrawFigure.CenterPoint.x + ObjectFromRaise.GrpSizeX / 2 - 0.5; BasisPoint.y := ObjectFromRaise.DrawFigure.CenterPoint.y - ObjectFromRaise.GrpSizeY / 2 + 0.5; end; Point1.x := BasisPoint.x; Point1.y := BasisPoint.y; Point2.x := BasisPoint.x + 4; Point2.y := BasisPoint.y - 4; Bnd := CaptionsGroup.GetBoundRect; CapWidth := abs(Bnd.Right - Bnd.Left); CPLine.x := (Point1.x + Point2.x) / 2 + CapWidth / 2 + 2; CPLine.y := (Point1.y + Point2.y) / 2; CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); end; end else begin Background := TRectangle(CaptionsGroup.InFigures[0]); Captions := TRichTextMod(CaptionsGroup.InFigures[1]); CPLine.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; CPLine.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; CurAngle := Captions.AngletoPoint; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then begin CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); end else begin // new mark // если не отображается длина - не будем вращать //CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставим как было CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); end; {$ELSE} //Tolik CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); //CaptionsGroup.Move(CPLine.x - CaptionsGroup.CenterPoint.x, CPLine.y - CaptionsGroup.CenterPoint.y); //CaptionsGroup.Rotate( - CurAngle, Captions.CenterPoint); // {$IFEND} //11.10.2011 - Упрощен способ расчета размеров {xCanvas := TMetafileCanvas.Create(Captions.Metafile, 0); xCanvas.Font.Name := Captions.re.Font.Name; xCanvas.Font.Size := Captions.re.Font.Size; xCanvas.Font.Style := Captions.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Captions.re.Lines.Count + 1; FreeAndNil(xCanvas);} // Tolik -- 17/12/2015 -- если надпись по центру, то нужнен не центр надписи, а центр пустых строк if FCaptionsViewType = cv_Center then // Tolik 23/12/2015 -- юзать только свойства линии, так как после открытия проекта, например, // TRichText не поднимет свойства шрифта и будет бяка - разногласие в размерах // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, h, w); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, h, w) // else // Tolik 23/12/2015 -- юзать только свойства линии, так как после открытия проекта, например, // TRichText не поднимет свойства шрифта и будет бяка - разногласие в размерах // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, h, w); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, h, w); // // подвинуть подпись вверх/вниз if Captions.re.Lines.Count > 0 then begin if GCadForm.FShowLineCaptionsType = skExternalSCS then PointsPos := GetCaptionsGroupNewPos(h / 2 / Captions.re.Lines.Count, Captions.re.Lines.Count) else begin // Tolik 22/12/2015 -- учесть высоту FDrawFigure (если над/под линией) if ((FCaptionsViewType = cv_OverLine) or (FCaptionsViewType = cv_UnderLine)) then begin if Captions.re.Lines.Count > 1 then // PointsPos := GetCaptionsGroupNewPos((h - 1) / 2 + GrpSizeY/2, Captions.re.Lines.Count) PointsPos := GetCaptionsGroupNewPos((h - 1) / 2, Captions.re.Lines.Count) else if Captions.re.Lines.Count = 1 then // PointsPos := GetCaptionsGroupNewPos(h / 2 + GrpSizeY/2, Captions.re.Lines.Count); PointsPos := GetCaptionsGroupNewPos(h / 2, Captions.re.Lines.Count); end else begin if Captions.re.Lines.Count > 1 then PointsPos := GetCaptionsGroupNewPos((h - 1) / 2, Captions.re.Lines.Count) else if Captions.re.Lines.Count = 1 then PointsPos := GetCaptionsGroupNewPos(h / 2, Captions.re.Lines.Count); end; end; end else PointsPos := CPLine; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x, PointsPos.y - CaptionsGroup.CenterPoint.y) else begin // new mark // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставим как было CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x, PointsPos.y - CaptionsGroup.CenterPoint.y); end; {$ELSE} // Tolik 22/12/2015 -- определить смещение центра надписи (Если выравнивание надписи - по центру) deltaX := 0; deltaY := 0; if FCaptionsViewType = cv_Center then begin MvAngle := AngleCalcDF(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); if Captions.re.Lines.Count <= 4 then begin NewH := 0; if Captions.re.Lines.Count <> 1 then NewH := 0.25 end else if Captions.re.Lines.Count > 4 then begin CanMoveCaption := False; // это на всякий, чтобы не ебнулось, вдруг пользователь чего-то наколдовал с надписью вручную // а ХЗ откуда придет LineCount := 1; k := 1; While Captions.re.Lines[k] = '' do begin Inc(LineCount); Inc(k); if Captions.re.Lines[k] <> '' then CanMoveCaption := True; if k = Captions.re.Lines.Count - 1 then break; end; if CanMoveCaption then begin Inc(LineCount); if LineCount < Captions.re.Lines.Count then begin NewH := ((Captions.re.Lines.Count - LineCount) * ((h - 1)/LineCount)) / 2; end; end; end; LineAngle := GetAngleDF(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); While LineAngle > 360 do LineAngle := LineAngle - 360; // mvAngle := LineAngle * pi / 180; deltaX := NewH * sin(mvAngle); // mvAngle := mvAngle + pi; deltaY := NewH*cos(mvAngle); if (LineAngle >= 90) and (LineAngle <= 180) then begin deltaX := deltaX; deltaY := -deltaY; end; if (LineAngle >= 180) and (LineAngle <= 270) then begin //dd := dx; //dx := -dy; //dy := dx; deltaX := deltaX; deltaY := -deltaY; end; if (LineAngle >= 270) and (LineAngle <= 360) then begin deltaX := -deltaX; deltaY := deltaY; end; //if (LineAngle >= 0) and (LineAngle <= 90) then if (LineAngle >= 0) and (LineAngle < 90) then begin deltaX := -deltaX; deltaY := deltaY; end; // deltaX := NewH*Sin(mvAngle); // deltaY := NewH*Cos(mvAngle); end; // CaptionsGroup.Move(PointsPos.x - CaptionsGroup.CenterPoint.x + deltaX, PointsPos.y - CaptionsGroup.CenterPoint.y + deltaY); {$IFEND} // Tolik--25/11/2015 -- в перерасчете угла поворота убраны округления // MvAngle := AngleCalc(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); MvAngle := AngleCalcDF(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2]); {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then begin CaptionsGroup.Rotate(MvAngle, CaptionsGroup.CenterPoint); end else begin // new mark // если не отображается длина - не вращаем //CaptionsGroup.Rotate(MvAngle, CaptionsGroup.CenterPoint); end; {$ELSE} CaptionsGroup.Rotate(MvAngle, CaptionsGroup.CenterPoint); {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока не меняем ничего { if Not ShowLength then // new mark begin CaptionsGroup.Move(abs(CaptionsGroup.ap2.x - CaptionsGroup.ap1.x)/2, 0); end; } {$IFEND} end; // вернуть позицию подписи перед модификацией // Tolik if (aReturnToPos and (FCaptionsViewType <> cv_Center)) then begin if CaptionsGroup <> nil then // if (CaptionsGroup <> nil) and (FCaptionsViewType = cv_Auto) then begin {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if ShowLength then begin CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); end else begin // new mark // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставляем как есть CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); //CaptionsGroup.Move(abs(CaptionsGroup.ap2.x - CaptionsGroup.ap1.x)/2, 0); end; {$ELSE} // Tolik -- 01/12/2015 -- CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); if Self.FCaptionsViewType <> cv_Center then // если по центру, то пох begin // если размер надписи по дороге изменился, то нужно учесть и смещение центра новой надписи относительно того, что было, // а то херня кака-то получается if OldCaptionList = nil then begin // Это если, допустим, размер шрифта поменялся if (OldH <> -1) and (OldW <> -1) then begin //if OldCaptionList.Count = Captions.re.Lines.count then begin // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, NewH, NewW); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, NewH, NewW); deltaX := (OldW/2 - NewW/2)*sin(CaptionsGroup.AngleToPoint); // ширина deltaY := (OldH/2 - NewH/2)*cos(CaptionsGroup.AngletoPoint); // высота if FCaptionsViewType = cv_underLine then begin deltax := -deltax; deltay := - deltay; end; CaptionsGroup.Move(deltaX, deltaY); end; end; end else // сюда придем, когда к трассе добавится какой-нить элемент типа каб канала begin if OutTextStrings.Count <> OldCaptionList.Count then begin // GetTextSizeCapt(Captions.re.Font.Size, Captions.re.Font.Style, Captions.re.Font.Name, '', Captions.re.Lines, NewH, NewW); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', Captions.re.Lines, NewH, NewW); NewH := NewH - 1; // сбрасываем 1 OldH := NewH/OldCaptionList.Count; Newh := NewH/OutTextStrings.Count; if FCaptionsViewType = cv_OverLine then h1 := (NewH - OldH)/2 - GrpSizeY/2 else if FCaptionsViewType = cv_UnderLine then h1 := (NewH - OldH)/2 + GrpSizeY/2; deltaX := h1 * Sin(CaptionsGroup.AngletoPoint); deltaY := h1 * Cos(CaptionsGroup.AngletoPoint); if FCaptionsViewType = cv_UnderLine then begin deltaX := -deltaX; deltaY := -deltaY; end; CaptionsGroup.Move(deltaX, deltay); end; end; end; // {$IFEND} end end; // Tolik -- 22/09/2016 -- чтобы надпись не оказалась под линией - выдвинуть наверх if self.Owner <> nil then begin TPowerCad(Self.Owner).OrderFigureToFront(CaptionsGroup); end; //OutTextStrings.Free; FreeAndNil(OutTextStrings); except on E: Exception do addExceptionToLogEx('TOrthoLine.ReCreateCaptionsGroup', E.Message); end; end; *) procedure TOrthoLine.ReCreateNotesGroup(aNeedReCreate: Boolean = False); var i: integer; NotesLHandle: integer; NotesRows: TFigureGrpNotMod; NotesCaptions: TRichTextMod; NotesRowsPoints: TDoublePoint; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; NotesStrings: TStrings; FRecreate: Boolean; GetResLine: TLine; GetDeltaLineX, GetDeltaLineY: Double; // Tolik 09/11/2016 -- aOwner: TComponent; CurrCad: TF_CAD; // begin try if Self.deleted then exit; // Tolik -- 09/11/2016-- if NotesGroup <> Nil then begin if NotesGroup.InFigures.Count <> 2 then NotesGroup := nil else begin if not CheckFigureByClassName(TFigure(NotesGroup.InFigures[1]), 'TRichTextMod') then NotesGroup := nil; end; { if NotesGroup = Nil then begin NotesLHandle := GCadForm.PCad.GetLayerHandle(5); NotesRows := CreateNotesRowGroup(nr_AutoSide); NotesRows.Visible := True; NotesCaptions := TRichTextMod.create(0, 0, 0, 0, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note); NotesCaptions.RE.Lines.Clear; NotesCaptions.RE.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; NotesCaptions.Visible := True; // создать NotesGroup и перебросить в него обьекты NotesGroup := TFigureGrpNotMod.create(NotesLHandle, TComponent(GCadForm.PCad)); NotesGroup.AddFigure(NotesRows); NotesGroup.AddFigure(NotesCaptions); NotesGroup.LockModify := True; NotesGroup.Radius := -1; GCadForm.PCad.AddCustomFigure (GLN(NotesLHandle), NotesGroup, False); ReCreateNotesGroup; end;} end; // if aNeedReCreate then FRecreate := true else begin if NotesGroup <> nil then begin NotesCaptions := TRichTextMod(NotesGroup.InFigures[1]); NotesStrings := NotesCaptions.re.Lines; end else NotesStrings := nil; FRecreate := IsStringListsDifferent(OutTextNotes, NotesStrings); end; if FRecreate then begin NotesLHandle := GCadForm.PCad.GetLayerHandle(5); // удалить TextBoxesGroup if NotesGroup <> nil then begin NotesRows := TFigureGrpNotMod(TFigureGrp(NotesGroup.InFigures[0])); GetResLine := TLine(NotesRows.InFigures[1]); GetDeltaLineX := abs(GetResLine.ActualPoints[1].x - GetResLine.ActualPoints[2].x); GetDeltaLineY := abs(GetResLine.ActualPoints[1].y - GetResLine.ActualPoints[2].y); end else begin GetDeltaLineX := -1; GetDeltaLineY := -1; end; if NotesGroup <> nil then begin RemoveInFigureGrp(NotesGroup); GCadForm.PCad.Figures.Remove(NotesGroup); FreeAndNil(NotesGroup); end; {!!!} //11.10.2011 RefreshCAD(GCadForm.PCad); NotesRows := CreateNotesRowGroup(FNotesRowsType, GetDeltaLineX, GetDeltaLineY); // Tolik 09/11/ 2016 -- if Self.deleted then exit; // NotesRows.Visible := True; NotesRowsPoints.x := (TLine(NotesRows.InFigures[2]).ActualPoints[1].x + TLine(NotesRows.InFigures[2]).ActualPoints[2].x) / 2; NotesRowsPoints.y := (TLine(NotesRows.InFigures[2]).ActualPoints[1].y + TLine(NotesRows.InFigures[2]).ActualPoints[2].y) / 2; //11.10.2011 - Упрощен способ расчета размеров {NotesCaptions := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note, 0, false); //11.10.2011 NotesCaptions.RE.Lines.Clear; NotesCaptions.re.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; //NotesCaptions.RE.Lines.BeginUpdate; //11.10.2011 for i := 0 to OutTextNotes.Count - 1 do begin NotesCaptions.RE.Lines.Add(OutTextNotes[i]); end; //NotesCaptions.RE.Lines.EndUpdate; //11.10.2011 //NotesCaptions.RE.Lines.AddStrings(OutTextNotes);//11.10.2011 // ПОЛУЧИТЬ СВОЙСТВА xCanvas := TMetafileCanvas.Create(NotesCaptions.Metafile, 0); xCanvas.Font.Name := NotesCaptions.re.Font.Name; xCanvas.Font.Size := NotesCaptions.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * NotesCaptions.re.Lines.Count + 1; w := 0; for i := 0 to NotesCaptions.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(NotesCaptions.Re.Lines[i]) then w := xCanvas.TextWidth(NotesCaptions.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // ПЕРЕСОЗДАТЬ С НОВЫМИ СВОЙСТВАМИ if NotesCaptions <> nil then begin FreeAndNil(NotesCaptions); end;} GetTextSize(FNotesFontSize, [], FNotesFontName, '', OutTextNotes, h, w); NotesCaptions := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note, 0, false); //11.10.2011 NotesCaptions.RE.Lines.Clear; NotesCaptions.re.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; //NotesCaptions.RE.Lines.BeginUpdate; //11.10.2011 for i := 0 to OutTextNotes.Count - 1 do begin OutTextNotes[i] := FastReplace(OutTextNotes[i],#13#10,' '); NotesCaptions.RE.Lines.Add(OutTextNotes[i]); end; //NotesCaptions.RE.Lines.EndUpdate; //11.10.2011 //NotesCaptions.RE.Lines.AddStrings(OutTextNotes); //11.10.2011 NotesCaptions.Move(NotesRowsPoints.x - NotesCaptions.CenterPoint.x, NotesRowsPoints.y - NotesCaptions.CenterPoint.y - (h - 1) / 2); NotesCaptions.Visible := True; // создать NotesGroup и перебросить в него обьекты NotesGroup := TFigureGrpNotMod.create(NotesLHandle, Owner); NotesGroup.AddFigure(NotesRows); NotesGroup.AddFigure(NotesCaptions); NotesGroup.LockModify := True; GCadForm.PCad.AddCustomFigure (GLN(NotesLHandle), NotesGroup, False); // 15.07.2016 Tolik and Igor NotesGroup.Radius := -10; ///// ReCreateNotesGroup; end else // НЕ ПЕРЕСОЗДАВАТЬ NOTESGROUP begin NotesLHandle := GCadForm.PCad.GetLayerHandle(5); NotesRows := TFigureGrpNotMod(NotesGroup.InFigures[0]); NotesCaptions := TRichTextMod(NotesGroup.InFigures[1]); // удалить TextBoxesGroup GetResLine := TLine(NotesRows.InFigures[1]); GetDeltaLineX := abs(GetResLine.ActualPoints[1].x - GetResLine.ActualPoints[2].x); GetDeltaLineY := abs(GetResLine.ActualPoints[1].y - GetResLine.ActualPoints[2].y); if NotesRows <> nil then begin RemoveInFigureGrp(NotesRows); NotesGroup.RemoveFromGrp(NotesRows); //28.04.2011 NotesGroup.InFigures.Remove(NotesRows); FreeAndNil(NotesRows); end; NotesRows := CreateNotesRowGroup(FNotesRowsType, GetDeltaLineX, GetDeltaLineY); NotesRows.Visible := True; NotesRowsPoints.x := (TLine(NotesRows.InFigures[2]).ActualPoints[1].x + TLine(NotesRows.InFigures[2]).ActualPoints[2].x) / 2; NotesRowsPoints.y := (TLine(NotesRows.InFigures[2]).ActualPoints[1].y + TLine(NotesRows.InFigures[2]).ActualPoints[2].y) / 2; // ПОЛУЧИТЬ СВОЙСТВА {//11.10.2011 - Упрощен способ расчета размеров xCanvas := TMetafileCanvas.Create(NotesCaptions.Metafile, 0); xCanvas.Font.Name := NotesCaptions.re.Font.Name; xCanvas.Font.Size := NotesCaptions.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * NotesCaptions.re.Lines.Count + 1; FreeAndNil(xCanvas);} GetTextSize(NotesCaptions.re.Font.Size, [], NotesCaptions.re.Font.Name, '', NotesCaptions.re.Lines, h, w); // создать NotesGroup и перебросить в него обьекты NotesGroup.AddFigure(NotesRows); NotesCaptions.Move(NotesRowsPoints.x - NotesCaptions.CenterPoint.x, NotesRowsPoints.y - NotesCaptions.CenterPoint.y - (h - 1) / 2); NotesGroup.InFigures.Exchange(0, 1); NotesGroup.Radius := -2; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.ReCreateNotesGroup', E.Message); end; if NotesGroup <> Nil then begin // ТАК ОНО будет правильнее, а то от выносок остаются пустые линии if IsNoteExist(NotesGroup) then NotesGroup.Visible := ShowNotes else NotesGroup.Visible := False; end; end; procedure TOrthoLine.UpdateLengthTextBox(aNeedReCreate: Boolean; aReturnToPos: Boolean); var Str: string; Background: TRectangle; Captions: TRichTextMod; h1,h2,w1,w2: Double; FontStyles: TFontStyles; LengthStrings: TStringList; // Tolik ResPoints: TDoublePoint; OldAP1, OldAP2, NewAP1, NewAP2: TDoublePoint; SelfCrossInfo: POrthoLineCrossInfo; CrossLinesList: TList; LineFigure: TFigure; CadOwner: TF_Cad; i, j: Integer; CrossLine: TOrthoLine; RefreshFlag: Boolean; PointDeleted: Boolean; begin CrossLinesList := Nil; CrossLine := Nil; RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; try // Tolik 13/09/2017 -- // если включена опция типа показывать пересечения трасс, то сбросить и пересчитать возможные пересечения // с другими трассами if GCadForm.FListSettings.ShowTracesCrossPoints > 0 then begin // Если есть пересечения -- сбросить все if CrossList.Count > 0 then begin CrossLinesList := TList.Create; CadOwner := Nil; if Self.Owner <> nil then if Self.Owner.Owner <> nil then begin CadOwner := TF_Cad(TPowerCad(Self.Owner).Owner); While CrossList.Count > 0 do // сброс пересечений begin SelfCrossInfo := POrthoLineCrossInfo(CrossList[0]); CrossLine := TOrthoLine(GetFigureByID(CadOwner, SelfCrossInfo.CrossLineID)); if CrossLine <> nil then if not CrossLine.Deleted then if CrossLinesList.IndexOf(CrossLine) = -1 then CrossLinesList.Add(CrossLine); // линии пересечения CrossList.Remove(SelfCrossInfo); //FreeMem(SelfCrossInfo); // освободить память Dispose(SelfCrossInfo); // освободить память end; if CrossLinesList.Count > 0 then begin for i := 0 to CrossLinesList.Count - 1 do begin CrossLine := TOrthoLine(CrossLinesList[i]); PointDeleted := False; for j := CrossLine.CrossList.Count - 1 downto 0 do begin if POrthoLineCrossInfo(CrossLine.CrossList[j]).CrossLineID = Self.ID then begin SelfCrossInfo := POrthoLineCrossInfo(CrossLine.CrossList[j]); CrossLine.CrossList.Delete(j); //FreeMem(SelfCrossInfo); Dispose(SelfCrossInfo); PointDeleted := True; end; end; if PointDeleted then CrossLine.ReCreateDrawFigureBlock; end; end; DropCalcCrosses(Self, False); end; CrossLinesList.free; end else // Пересчитать возможные пересечения с другими трассами DropCalcCrosses(Self, False); end; //Tolik 05/02/2021 -- { if GCadForm.FShowLineCaptionsType = skExternalSCS then begin if OutTextCaptions.Count = 1 then begin Str := GetLineCaptionFormat(Self, GCadForm.FShowLineCaptionsType); OutTextCaptions.Add(Str); end; if OutTextCaptions.Count >= 2 then begin Str := GetLineCaptionFormat(Self, GCadForm.FShowLineCaptionsType); OutTextCaptions[1] := Str; if CaptionsGroup <> nil then begin Background := TRectangle(CaptionsGroup.InFigures[0]); Captions := TRichTextMod(CaptionsGroup.InFigures[1]); if ShowLength = True then if Captions.Re.Lines.Count >= 2 then Captions.re.Lines[1] := OutTextCaptions[1]; ReCreateCaptionsGroup(aNeedReCreate, aReturnToPos); end end; end else } begin if OutTextCaptions.Count = 0 then begin Str := GetLineCaptionFormat(Self, GCadForm.FShowLineCaptionsType); OutTextCaptions.Add(Str); end; if OutTextCaptions.Count > 0 then begin Str := GetLineCaptionFormat(Self, GCadForm.FShowLineCaptionsType); if StrLen(PChar(OutTextCaptions[0])) <> StrLen(PChar(Str)) then aNeedReCreate := True else aNeedReCreate := False; // Tolik -- 11/12/2015 FontStyles := []; if FCaptionsFontBold then FontStyles := [fsBold]; LengthStrings := TStringList.Create; LengthStrings.Add(Str); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', LengthStrings, h2, w2); LengthStrings.Clear; LengthStrings.Add(OutTextCaptions[0]); GetTextSizeCapt(FCaptionsFontSize, FontStyles, FCaptionsFontName, '', LengthStrings, h1, w1); LengthStrings.Clear; FreeAndNil(LengthStrings); if w1 <> w2 then aNeedReCreate := True else aNeedReCreate := False; // OutTextCaptions[0] := Str; if CaptionsGroup <> nil then begin if (CaptionsGroup.InFigures <> nil) and (CaptionsGroup.InFigures.Count >= 2) and (CaptionsGroup.InFigures.Count <= 1000) then begin Background := TRectangle(CaptionsGroup.InFigures[0]); Captions := TRichTextMod(CaptionsGroup.InFigures[1]); if ShowLength = True then if Captions.Re.Lines.Count > 0 then Captions.re.Lines[0] := OutTextCaptions[0]; ReCreateCaptionsGroup(aNeedReCreate, aReturnToPos); end else begin ReCreateCaptionsGroup(True, False); end; // Tolik { if (CaptionsGroup.InFigures <> nil) and (CaptionsGroup.InFigures.Count >= 2) and (CaptionsGroup.InFigures.Count <= 1000) then begin OldAP1 := ActualPoints[1]; OldAP2 := ActualPoints[2]; NewAP1 := ActualPoints[1]; NewAP2 := ActualPoints[2]; Captions := TRichTextMod(CaptionsGroup.Infigures[1]); ResPoints := CaptionsGroupRemoveCalc(CaptionsGroup.CenterPoint, OldAP1, OldAP2, NewAP1, NewAP2, CaptionsGroupH, Captions.re.Lines.Count); //if (AJoinedLine.FCaptionsViewType = cv_Auto) or (AJoinedLine.FCaptionsViewType = cv_Center) then CaptionsGroup.Move(ResPoints.x - CaptionsGroup.CenterPoint.x, ResPoints.y - CaptionsGroup.CenterPoint.y); end;} end; end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.UpdateLengthTextBox', E.Message); end; GCanRefreshCad := RefreshFlag; end; Procedure TOrthoLine.Deselect; begin try inherited; DeSelectSCSFigureInPM(ID); except on E: Exception do AddExceptionToLogEx('TOrthoLine.DeSelect', E.Message); end; end; procedure TOrthoLine.WriteToStream(Stream: TStream); var xParam: byte; xInt: integer; xStr: string; xDbl: double; i: integer; GetGroupObject: TSCSFigureGrp; FiguresList: TList; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; if JoinConnector1 <> nil then begin GetGroupObject := TConnectorObject(JoinConnector1).FGroupObject; if GetGroupObject = nil then begin xInt := FiguresList.IndexOf(JoinConnector1); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(87, Stream, xInt, sizeof(xInt)); end else begin xInt := GetGroupObject.InFigures.IndexOf(JoinConnector1); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := FiguresList.IndexOf(GetGroupObject); WriteField(87, Stream, xInt, sizeof(xInt)); end; end else begin xInt := -1; WriteField(20, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(87, Stream, xInt, sizeof(xInt)); end; if JoinConnector2 <> nil then begin GetGroupObject := TConnectorObject(JoinConnector2).FGroupObject; if GetGroupObject = nil then begin xInt := FiguresList.IndexOf(JoinConnector2); WriteField(21, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(88, Stream, xInt, sizeof(xInt)); end else begin xInt := GetGroupObject.InFigures.IndexOf(JoinConnector2); WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FiguresList.IndexOf(GetGroupObject); WriteField(88, Stream, xInt, sizeof(xInt)); end; end else begin xInt := -1; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(88, Stream, xInt, sizeof(xInt)); end; if MultilineCaptionBox <> nil then begin xInt := FiguresList.IndexOf(MultilineCaptionBox); WriteField(22, Stream, xInt, sizeof(xInt)); end; // Count xInt := FCount; WriteField(23, Stream, xInt, sizeof(xInt)); // сохранить CaptionsGroup xInt := FiguresList.IndexOf(CaptionsGroup); WriteField(24, Stream, xInt, sizeof(xInt)); // FRaiseType xInt := Ord(FLineRaiseType); WriteField(26, Stream, xInt, sizeof(xInt)); // сохранить FObjectFromRaise if FObjectFromRaisedLine <> nil then begin GetGroupObject := TConnectorObject(FObjectFromRaisedLine).FGroupObject; if GetGroupObject = nil then begin xInt := FiguresList.IndexOf(FObjectFromRaisedLine); WriteField(27, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(89, Stream, xInt, sizeof(xInt)); end else begin xInt := GetGroupObject.InFigures.IndexOf(FObjectFromRaisedLine); WriteField(27, Stream, xInt, sizeof(xInt)); xInt := FiguresList.IndexOf(GetGroupObject); WriteField(89, Stream, xInt, sizeof(xInt)); end; end else begin xInt := -1; WriteField(27, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(89, Stream, xInt, sizeof(xInt)); end; // FCableFullnessSide1 xInt := Ord(FCableFullnessSide1); WriteField(28, Stream, xInt, sizeof(xInt)); // FCableFullnessSide2 xInt := Ord(FCableFullnessSide2); WriteField(29, Stream, xInt, sizeof(xInt)); // FCableChannelFullness xInt := Ord(FCableChannelFullness); WriteField(30, Stream, xInt, sizeof(xInt)); // FCableChannelFullness xInt := Ord(FCableChannelClosedSide1); WriteField(31, Stream, xInt, sizeof(xInt)); // FCableChannelFullness xInt := Ord(FCableChannelClosedSide2); WriteField(32, Stream, xInt, sizeof(xInt)); // FTraceStyle xInt := Ord(FLineType); WriteField(33, Stream, xInt, sizeof(xInt)); // DrawFigure if DrawFigure <> nil then begin xInt := FiguresList.IndexOf(DrawFigure); WriteField(34, Stream, xInt, sizeof(xInt)); end; // ConnectorType xInt := Ord(OrthoLineType); WriteField(35, Stream, xInt, sizeof(xInt)); // SingleBlock if FSingleBlock <> nil then begin // Tolik xInt := -10000; // типа, сидит в дравфигуре // xInt := FiguresList.IndexOf(FSingleBlock); WriteField(36, Stream, xInt, sizeof(xInt)); // end; // FBlockID xInt := FBlockID; WriteField(37, Stream, xInt, sizeof(xInt)); // FObjectType xInt := FObjectType; WriteField(38, Stream, xInt, sizeof(xInt)); // NotesGroup xInt := FiguresList.IndexOf(NotesGroup); WriteField(39, Stream, xInt, sizeof(xInt)); // FNotesRowType xInt := Ord(FNotesRowsType); WriteField(40, Stream, xInt, sizeof(xInt)); // FNetworkType xInt := $0; if nt_Computer in FNetworkTypes then xInt := xInt + cComputer_nt; if nt_Telephon in FNetworkTypes then xInt := xInt + cTelephon_nt; if nt_Television in FNetworkTypes then xInt := xInt + cTelevision_nt; if nt_Gas in FNetworkTypes then xInt := xInt + cGas_nt; if nt_Electric in FNetworkTypes then xInt := xInt + cElectric_nt; WriteField(41, Stream, xInt, sizeof(xInt)); xInt := ord(FTraceStyle); WriteField(42, Stream, xInt, sizeof(xInt)); xInt := FTraceWidth; WriteField(43, Stream, xInt, sizeof(xInt)); // FCaptionsViewType xInt := Ord(FCaptionsViewType); WriteField(44, Stream, xInt, sizeof(xInt)); // FIndex xInt := FIndex; WriteField(45, Stream, xInt, sizeof(xInt)); // FCabinetID xInt := FCabinetID; WriteField(46, Stream, xInt, sizeof(xInt)); // FConnectingPos xInt := FConnectingPos; WriteField(47, Stream, xInt, sizeof(xInt)); // FCaptionsFontSize xInt := FCaptionsFontSize; WriteField(48, Stream, xInt, sizeof(xInt)); // FNotesFontSize xInt := FNotesFontSize; WriteField(49, Stream, xInt, sizeof(xInt)); // FGroupObject if FGroupObject <> nil then begin xInt := FiguresList.IndexOf(FGroupObject); WriteField(50, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(50, Stream, xInt, sizeof(xInt)); end; // FCaptionsFontColor xInt := FCaptionsFontColor; WriteField(51, Stream, xInt, sizeof(xInt)); // FNotesFontColor xInt := FNotesFontColor; WriteField(52, Stream, xInt, sizeof(xInt)); // FCableFullnessSide2 xInt := Ord(FDefectDegree); WriteField(53, Stream, xInt, sizeof(xInt)); // Save MarkingList for i := 0 to FTraceCaptionsList.Count - 1 do begin xStr := FTraceCaptionsList[i]; if ((180 + i) <= 210) then begin WriteStrField(180 + i, Stream, xStr); xStr := ReadStringFromStream(Stream); end end; // BLOCK GUID xStr := FBlockGUID; WriteStrField(211, Stream, xStr); // FTrunkNumber xStr := FTrunkNumber; WriteStrField(212, Stream, xStr); // FCaptionsNotesFontName xStr := FCaptionsFontName; WriteStrField(213, Stream, xStr); xStr := FNotesFontName; WriteStrField(214, Stream, xStr); xStr := FloatToStr(CaptionsGroupH); WriteStrField(215, Stream, xStr); // ActualPoints xDbl := ActualPoints[1].x; WriteField(220, Stream, xDbl, sizeof(xDbl)); xDbl := ActualPoints[1].y; WriteField(221, Stream, xDbl, sizeof(xDbl)); xDbl := ActualPoints[2].x; WriteField(222, Stream, xDbl, sizeof(xDbl)); xDbl := ActualPoints[2].y; WriteField(223, Stream, xDbl, sizeof(xDbl)); // Length xDbl := LineLength; WriteField(224, Stream, xDbl, sizeof(xDbl)); xDbl := UserLength; WriteField(225, Stream, xDbl, sizeof(xDbl)); xDbl := CalculLength; WriteField(226, Stream, xDbl, sizeof(xDbl)); // Gap xDbl := FGap; WriteField(227, Stream, xDbl, sizeof(xDbl)); // ActualZOrder xDbl := ActualZOrder[1]; WriteField(228, Stream, xDbl, sizeof(xDbl)); xDbl := ActualZOrder[2]; WriteField(229, Stream, xDbl, sizeof(xDbl)); // GrpSize xDbl := GrpSizeX; WriteField(230, Stream, xDbl, sizeof(xDbl)); xDbl := GrpSizeY; WriteField(231, Stream, xDbl, sizeof(xDbl)); xDbl := BlockStep; WriteField(232, Stream, xDbl, sizeof(xDbl)); xDbl := FDrawFigureAngle; WriteField(233, Stream, xDbl, sizeof(xDbl)); xDbl := FTraceColor; WriteField(234, Stream, xDbl, sizeof(xDbl)); // FSingleBlockDelta xDbl := FSingleBlockDelta; WriteField(235, Stream, xDbl, sizeof(xDbl)); // FDrawFigurePercent xDbl := FOriginalSizeX; WriteField(236, Stream, xDbl, sizeof(xDbl)); xDbl := FOriginalSizeY; WriteField(237, Stream, xDbl, sizeof(xDbl)); xDbl := FDrawFigurePercent; WriteField(238, Stream, xDbl, sizeof(xDbl)); xDbl := DrawFigureH; WriteField(239, Stream, xDbl, sizeof(xDbl)); // флаг отображения длинны if ShowLength = true then xParam := 0 else xParam := 1; WriteField(99, Stream, xParam, sizeof(xParam)); // флаг отображения усл.обозначения if isShowBlock then xParam := 0 else xParam := 1; WriteField(100, Stream, xParam, sizeof(xParam)); // флаг отображения подписей if ShowCaptions then xParam := 0 else xParam := 1; WriteField(101, Stream, xParam, sizeof(xParam)); // флаг отображения выносок if ShowNotes then xParam := 0 else xParam := 1; WriteField(102, Stream, xParam, sizeof(xParam)); // св-ва измененнных полей if FIsNameChanged then xParam := 0 else xParam := 1; WriteField(103, Stream, xParam, sizeof(xParam)); if FIsCaptionsChanged then xParam := 0 else xParam := 1; WriteField(104, Stream, xParam, sizeof(xParam)); if FIsNoteschanged then xParam := 0 else xParam := 1; WriteField(105, Stream, xParam, sizeof(xParam)); if FIsBlockChanged then xParam := 0 else xParam := 1; WriteField(106, Stream, xParam, sizeof(xParam)); if IsLengthAboveLimit then xParam := 0 else xParam := 1; WriteField(107, Stream, xParam, sizeof(xParam)); if FConnectingLine then xParam := 0 else xParam := 1; WriteField(108, Stream, xParam, sizeof(xParam)); if FCaptionsFontBold then xParam := 0 else xParam := 1; WriteField(109, Stream, xParam, sizeof(xParam)); if FExistOtherObjectType then xParam := 0 else xParam := 1; WriteField(110, Stream, xParam, sizeof(xParam)); if FIsRotated then xParam := 0 else xParam := 1; WriteField(111, Stream, xParam, sizeof(xParam)); // флаг трассировки if FMarkTracing then xParam := 0 else xParam := 1; WriteField(112, Stream, xParam, sizeof(xParam)); // флаг - наличие кабельного канала if FIsCableChannel then xParam := 0 else xParam := 1; WriteField(113, Stream, xParam, sizeof(xParam)); // флаг - статус ортогональности if FOrthoStatus then xParam := 0 else xParam := 1; WriteField(114, Stream, xParam, sizeof(xParam)); // флаг трассировки if FDisableTracing then xParam := 0 else xParam := 1; WriteField(115, Stream, xParam, sizeof(xParam)); // флаг вертикальности if FIsVertical then xParam := 0 else xParam := 1; WriteField(116, Stream, xParam, sizeof(xParam)); except on E: Exception do addExceptionToLogEx('TOrthoLine.WriteToStream', E.Message); end; end; procedure TOrthoLine.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); var xParam: byte; xInt: integer; xStr: string; i: integer; FindCode: integer; DataP: PChar; begin try F_ProjMan.GSCSBase.CurrProject.Setting.FirstTraceCreated := False; inherited; case xCode of 220: GOrthoLinePoints1.x := pDouble(data)^; 221: GOrthoLinePoints1.y := pDouble(data)^; 222: GOrthoLinePoints2.x := pDouble(data)^; 223: GOrthoLinePoints2.y := pDouble(data)^; 224: FLength := pDouble(data)^; 225: UserLength := pDouble(data)^; 226: CalculLength := pDouble(data)^; 227: FGap := pDouble(data)^; 228: ActualZOrder[1] := pDouble(data)^; 229: ActualZOrder[2] := pDouble(data)^; 230: GrpSizeX := pDouble(data)^; 231: GrpSizeY := pDouble(data)^; 232: BlockStep := pDouble(data)^; 233: FDrawFigureAngle := pDouble(data)^; 234: FTraceColor := round(pDouble(data)^); 235: FSingleBlockDelta := pDouble(data)^; 236: FOriginalSizeX := pDouble(data)^; 237: FOriginalSizeY := pDouble(data)^; 238: FDrawFigurePercent := pDouble(data)^; 239: DrawFigureH := pDouble(data)^; 20: begin xInt := pInt(data)^; FJoinFigure1Index := xInt; FCabinetID := -1; tmpParentDupID := -1; FCaptionsFontSize := -1; FNotesFontSize := -1; FCaptionsFontBold := false; FCaptionsFontColor := -1; FNotesFontColor := -1; FGroupObjectIndex := -1; FSingleBlockDelta := 0; FIsRotated := false; // FOriginalSizeX := -1; FOriginalSizeY := -1; FDrawFigurePercent := 100; FCaptionsFontName := GCadForm.FFontName; FNotesFontName := GCadForm.FFontName; FMarkTracing := False; FDisableTracing := False; FIsCableChannel := False; // DrawFigureH := -999999; CaptionsGroupH := -999999; // FJoinFigure1IndexForGrp := -1; FJoinFigure2IndexForGrp := -1; FObjectFromRaisedLineIndexForGrp := -1; FOrthoStatus := False; FDefectDegree := dodNormal; end; 21: begin xInt := pInt(data)^; FJoinFigure2Index := xInt; end; 22: begin xInt := pInt(data)^; FMultilineCaptionBoxIndex := xInt; end; 23: begin xInt := pInt(data)^; FCount := xInt; end; 24: begin xInt := pInt(data)^; FCaptionsGroupIndex := xInt; end; 26: begin xInt := pInt(data)^; FLineRaiseType := TLineRaiseType(xInt); end; 27: begin xInt := pInt(data)^; FObjectFromRaisedLineIndex := xInt; end; 28: begin xInt := pInt(data)^; FCableFullnessSide1 := TComponInterfacesFullness(xInt); end; 29: begin xInt := pInt(data)^; FCableFullnessSide2 := TComponInterfacesFullness(xInt); end; 30: begin xInt := pInt(data)^; FCableChannelFullness := TComponInterfacesFullness(xInt); end; 31: begin xInt := pInt(data)^; FCableChannelClosedSide1 := TComponInterfacesFullness(xInt); end; 32: begin xInt := pInt(data)^; FCableChannelClosedSide2 := TComponInterfacesFullness(xInt); end; 33: begin xInt := pInt(data)^; FLineType := TTraceStyle(xInt); end; 34: begin xInt := pInt(data)^; FDrawFigureIndex := xInt; end; 35: begin xInt := pInt(data)^; FOrthoLineType := TOrthoLineType(xInt); end; 36: begin xInt := pInt(data)^; FSingleBlockIndex := xInt; end; 37: begin xInt := pInt(data)^; FBlockID := xInt; end; 38: begin xInt := pInt(data)^; FObjectType := xInt; end; 39: begin xInt := pInt(data)^; FNotesGroupIndex := xInt; end; 40: begin xInt := pInt(data)^; FNotesRowsType := TNotesRowsType(xInt); end; 41: begin // FNetworkType xInt := pInt(data)^; FNetworkTypes := []; if xInt and cComputer_nt = cComputer_nt then FNetworkTypes := FNetworkTypes + [nt_Computer]; if xInt and cTelephon_nt = cTelephon_nt then FNetworkTypes := FNetworkTypes + [nt_Telephon]; if xInt and cTelevision_nt = cTelevision_nt then FNetworkTypes := FNetworkTypes + [nt_Television]; if xInt and cGas_nt = cGas_nt then FNetworkTypes := FNetworkTypes + [nt_Gas]; if xInt and cElectric_nt = cElectric_nt then FNetworkTypes := FNetworkTypes + [nt_Electric]; end; 42: begin xInt := pInt(data)^; FTraceStyle := TPenStyle(xInt); end; 43: begin xInt := pInt(data)^; FTraceWidth := xInt; end; 44: begin xInt := pInt(data)^; FCaptionsViewType := TLineCaptionsViewType(xInt); end; 45: begin xInt := pInt(data)^; FIndex := xInt; end; 46: begin xInt := pInt(data)^; FCabinetID := xInt; end; 47: begin xInt := pInt(data)^; FConnectingPos := xInt; end; 48: begin xInt := pInt(data)^; FCaptionsFontSize := xInt; end; 49: begin xInt := pInt(data)^; FNotesFontSize := xInt; end; 50: begin xInt := pInt(data)^; FGroupObjectIndex := xInt; end; 51: begin xInt := pInt(data)^; FCaptionsFontColor := xInt; end; 52: begin xInt := pInt(data)^; FNotesFontColor := xInt; end; 53: begin xInt := pInt(data)^; FDefectDegree := TDefectDegree(xInt); end; 87: begin xInt := pInt(data)^; FJoinFigure1IndexForGrp := xInt; end; 88: begin xInt := pInt(data)^; FJoinFigure2IndexForGrp := xInt; end; 89: begin xInt := pInt(data)^; FObjectFromRaisedLineIndexForGrp := xInt; end; 99: begin xParam := pByte(data)^; if xParam = 0 then ShowLength := true else ShowLength := false; end; 100: begin xParam := pByte(data)^; if xParam = 0 then IsShowBlock := true else IsShowBlock := false; end; 101: begin xParam := pByte(data)^; if xParam = 0 then ShowCaptions := true else ShowCaptions := false; end; 102: begin xParam := pByte(data)^; if xParam = 0 then ShowNotes := true else ShowNotes := false; end; 103: begin xParam := pByte(data)^; if xParam = 0 then FIsNameChanged := true else FIsNameChanged := false; end; 104: begin xParam := pByte(data)^; if xParam = 0 then FIsCaptionsChanged := true else FIsCaptionsChanged := false; end; 105: begin xParam := pByte(data)^; if xParam = 0 then FIsNotesChanged := true else FIsNotesChanged := false; end; 106: begin xParam := pByte(data)^; if xParam = 0 then FIsBlockChanged := true else FIsBlockChanged := false; end; 107: begin xParam := pByte(data)^; if xParam = 0 then IsLengthAboveLimit := true else IsLengthAboveLimit := false; end; 108: begin xParam := pByte(data)^; if xParam = 0 then FConnectingLine := true else FConnectingLine := false; end; 109: begin xParam := pByte(data)^; if xParam = 0 then FCaptionsFontBold := true else FCaptionsFontBold := false; end; 110: begin xParam := pByte(data)^; if xParam = 0 then FExistOtherObjectType := true else FExistOtherObjectType := false; end; 111: begin xParam := pByte(data)^; if xParam = 0 then FIsRotated := true else FIsRotated := false; end; 112: begin xParam := pByte(data)^; if xParam = 0 then FMarkTracing := true else FMarkTracing := false; end; 113: begin xParam := pByte(data)^; if xParam = 0 then FIsCableChannel := true else FIsCableChannel := false; end; 114: begin xParam := pByte(data)^; if xParam = 0 then FOrthoStatus := true else FOrthoStatus := false; end; 115: begin xParam := pByte(data)^; if xParam = 0 then FDisableTracing := true else FDisableTracing := false; end; 116: begin xParam := pByte(data)^; if xParam = 0 then FIsVertical := true else FIsVertical := false; end; 211: begin DataP := data; xStr := DataP; FBlockGUID := xStr; end; 212: begin DataP := data; xStr := DataP; FTrunkNumber := xStr; end; 213: begin DataP := data; xStr := DataP; FCaptionsFontName := xStr; end; 214: begin DataP := data; xStr := DataP; FNotesFontName := xStr; end; 215: begin DataP := data; xStr := DataP; CaptionsGroupH := StrToFloatDef_My(xStr, CaptionsGroupH); end; end; FDrawFigure := Nil; if FTraceCaptionsList = nil then FTraceCaptionsList := TStringList.Create; if (xCode >= 180) AND (xCode <= 210) then begin DataP := data; xStr := DataP; FTraceCaptionsList.Add(xStr); end; ActualPoints[1] := GOrthoLinePoints1; ActualPoints[2] := GOrthoLinePoints2; // поднять OutText if OutTextCaptions = nil then OutTextCaptions := TStringList.Create; if OutTextNotes = nil then begin OutTextNotes := TStringList.Create; if ID <> 0 then //08.11.2011 TF_CAD(TPowerCad(Owner).Owner).AddSCSFigure(Self); end; CaptionsGroup := nil; NotesGroup := nil; TF_CAD(TPowerCad(Owner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TOrthoLine.SetPropertyFromStream', E.Message); end; end; function TOrthoLine.GetAngle(AP1x, AP1y, AP2x, AP2y: Double): Double; var Len_X, Len_Y: Double; AngleRad: Double; AddAngle: Double; begin try Result := 0; Len_X := Abs(AP1x - AP2x); Len_Y := Abs(AP1y - AP2y); // проверки и вычиление угла в градусах AddAngle := 0; AngleRad := 0; // для неортогональных линий if (AP1x < AP2x) and (AP1y < AP2y) then // 1 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 0; end; if (AP1x > Ap2x) and (AP1y < AP2y) then //2 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 90; end; if (AP1x > AP2x) and (AP1y > AP2y) then //3 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 180; end; if (AP1x < AP2x) and (AP1y > AP2y) then //4 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 270; end; // Tolik 25/11/2015 -- // Result := Round(AngleRad * 180 / pi) + AddAngle; Result := AngleRad * 180 / pi + AddAngle; // для ортогональных линий if (AP1y = AP2y) and (AP1x < AP2x) then Result := 0; if (AP1y = AP2y) and (AP1x > AP2x) then Result := 180; if (AP1x = AP2x) and (AP1y < AP2y) then Result := 90; if (AP1x = AP2x) and (AP1y > AP2y) then Result := 270; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetAngle', E.Message); end; end; // Tolik 20/10/2015 -- для фигуры отрисовки без округления значения угла, чтобы не сдвинулась в сторону function TOrthoLine.GetAngleDF(AP1x, AP1y, AP2x, AP2y: Double): Double; var Len_X, Len_Y: Double; AngleRad: Double; AddAngle: Double; begin try Result := 0; Len_X := Abs(AP1x - AP2x); Len_Y := Abs(AP1y - AP2y); // проверки и вычисление угла в градусах AddAngle := 0; AngleRad := 0; // для неортогональных линий if (AP1x < AP2x) and (AP1y < AP2y) then // 1 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 0; end; if (AP1x > Ap2x) and (AP1y < AP2y) then //2 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 90; end; if (AP1x > AP2x) and (AP1y > AP2y) then //3 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 180; end; if (AP1x < AP2x) and (AP1y > AP2y) then //4 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 270; end; Result := (AngleRad * 180 / pi) + AddAngle; // для ортогональных линий if (AP1y = AP2y) and (AP1x < AP2x) then Result := 0; if (AP1y = AP2y) and (AP1x > AP2x) then Result := 180; if (AP1x = AP2x) and (AP1y < AP2y) then Result := 90; if (AP1x = AP2x) and (AP1y > AP2y) then Result := 270; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetAngle', E.Message); end; end; procedure TOrthoLine.Select; begin inherited; end; //============================================================================== //============ TConnectorObject ================================================ //============================================================================== // Конструктор для создания обьекта TConnectorObject constructor TConnectorObject.Create(aX, aY, aZ: Double; LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); var CaptionsLHandle: integer; NotesLHandle: integer; NotesRows: TFigureGrpNotMod; NotesCaptions: TRichTextMod; NotesRowsPoints: TDoublePoint; ProgramRegisterPro_2: boolean; addcod: integer; begin try {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IF Defined(FINAL_SCS) or Defined(TRIAL_SCS)} ProgramRegisterPro_2 := ProgProtection.CheckIsVer2(PRO, addcod); {$ELSE} ProgramRegisterPro_2 := True; {$IFEND} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IF Defined(TRIAL_SCS)} addcod := 0; {$IFEND} {$IF Not Defined(FINAL_SCS)} addcod := 0; {$IFEND} {$IF Defined(FINAL_SCS) and Not Defined(TRIAL_SCS)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} if Not ProgramRegisterPro_2 then exit; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IFEND} {$ELSE} addcod := 0; {$IFEND} inherited create(LHandle, aDrawStyle, aOwner); initialize; // Tolik 29/07/2021 -- ByDrawF := -1; // Tolik 09/03/2021 -- FModConnsOtherSides := nil; //Tolik -- 02/04/2018 -- FJoinedOrthoLinesByVerticals := nil; // список присоединенных трасс через другие коннекторы вертикалей в этой точке // нужно при постороении трейсинга всех присоединенных линий к вертикальной конструкции // //Initialize; // Tolik 29/07/2021 -- //Tolik // FModConnsOtherSides := nil; FDrawFigure := nil; // AsEndPoint := False; FConnRaiseType := crt_None; FObjectFromRaise := Nil; FConnFullness := cif_Empty; FDefectDegree := dodNormal; FIndex := -1; RemJoined := TList.Create; JoinedOrtholinesList := TList.Create; JoinedConnectorslist := TList.Create; {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IFEND} ActualPoints[1] := DoublePoint(aX + addcod, aY + addcod); {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IFEND} ActualZOrder[1] := aZ; FLHandle := LHandle; //FDrawStyle := aDrawStyle; if DrawFigure <> nil then FDrawFigureAngle := 0; FID_ListToPassage := -1; FID_ConnToPassage := -1; ShowCaptions := GCadForm.FShowConnectorsCaptions; ShowNotes := GCadForm.FShowConnectorsNotes; FObjectType := 1; FJoinedListIDForBox := -1; FCabinetID := -1; FComponID := -1; FDrawFigureMoved := false; // House FIsApproach := False; FIsHouseJoined := False; FHouse := nil; // Tolik 07/03/2020 -- FHouseIndex := -1; // if DrawStyle = mydsNormal then begin FNotesRowsType := nr_AutoSide; FCaptionsViewType := cv_Right; ConnectorType := ct_clear; FCornerType := GCadForm.FDefaultCornerType; FCornerTypeChangedByUser := False; FDisableTracing := False; FMirrored := False; tmpParentDupID := -1; FOriginalSizeX := 0; FOriginalSizeY := 0; FDrawFigurePercent := 100; FCaptionsFontSize := GCadForm.FConnectorsCaptionsFontSize; FNotesFontSize := GCadForm.FConnectorsNotesFontSize; FCaptionsFontName := GCadForm.FFontName; FNotesFontName := GCadForm.FFontName; FCaptionsFontColor := GCadForm.FConnectorsCaptionsColor; FNotesFontColor := GCadForm.FConnectorsNotesColor; FRaiseShiftX := 1; FRaiseShiftY := 1; FTagPM := 0; // создание подписей OutTextCaptions := TStringList.Create; CaptionsLHandle := GCadForm.PCad.GetLayerHandle(4); CaptionsGroup := TRichTextMod.create(0, 0, 0, 0, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption); CaptionsGroup.RE.Lines.Clear; CaptionsGroup.RE.Font.Size := FCaptionsFontSize; CaptionsGroup.re.Font.Name := FCaptionsFontName; CaptionsGroup.re.Font.Color := FCaptionsFontColor; GCadForm.PCad.AddCustomFigure (GLN(CaptionsLHandle), CaptionsGroup, False); ReCreateCaptionsGroup(True, false); // создание выносок OutTextNotes := TStringList.Create; NotesLHandle := GCadForm.PCad.GetLayerHandle(6); NotesRows := CreateNotesRowGroup(nr_AutoSide); NotesRows.Visible := True; NotesRowsPoints.x := (TLine(NotesRows.InFigures[1]).ActualPoints[1].x + TLine(NotesRows.InFigures[1]).ActualPoints[2].x) / 2; NotesRowsPoints.y := (TLine(NotesRows.InFigures[1]).ActualPoints[1].y + TLine(NotesRows.InFigures[1]).ActualPoints[2].y) / 2; NotesCaptions := TRichTextMod.create(NotesRowsPoints.x, NotesRowsPoints.y, NotesRowsPoints.x, NotesRowsPoints.y, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note); NotesCaptions.RE.Lines.Clear; NotesCaptions.re.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; NotesCaptions.Visible := True; NotesGroup := TFigureGrpNotMod.create(NotesLHandle, aOwner); NotesGroup.AddFigure(NotesRows); NotesGroup.AddFigure(NotesCaptions); NotesGroup.LockModify := True; GCadForm.PCad.AddCustomFigure (GLN(NotesLHandle), NotesGroup, False); FGroupObject := nil; F3DObject := nil; FIsDraw := false; //05.04.2011 end; FIsRotating := false; //11.03.2012 FindSnapTimer := nil; //CreateSnapTimer; //ther test if aDrawStyle <> dsTrace then TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TConnectorObject.Create', E.Message); end; end; //Создает обьект в режиме трейса в указанном месте class function TConnectorObject.CreateShadow(x, y: Double): TFigure; begin try Result := nil; Result := TConnectorObject.Create(x, y, GCadForm.FConnHeight, 0, dsTrace, nil); except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateShadow', E.Message); end; end; (* Procedure TConnectorObject.DrawRaise; // Tolik 16/04/2020 -- var RaiseLine: TOrthoLine; // Tolik 16/04/2020 -- чтобы код не множить.... function CheckCandrawRaise: Boolean; var i: integer; RRaiseLine: TFigure; begin Result := False; RRaiseLine := Nil; for i := 0 to JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(JoinedOrthoLinesList).FisRaiseUPDown then begin RRaiseLine := TFigure(JoinedOrthoLinesList); break; end; end; if RRaiseLine <> nil then Result := IsViewObjectInCurrentNetwork(RRaiseLine); end; begin if deleted then exit; if ConnectorType = ct_NB then exit; if checkCanDrawRaise then begin if FConnRaiseType = crt_OnFloor then begin {$IF (Defined(Final_SCS) or Defined(Trial_SCS))} CheckRaiseType := GetRaiseType(FObjectFromRaise, Self); if CheckRaiseType = lrt_Up then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise); if CheckRaiseType = lrt_Down then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); {$ELSE} RaiseLine := GetRaiseLine(Self); if RaiseLine <> nil then begin if RaiseLine.FLineRaiseType = lrt_Up then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise) else if RaiseLine.FLineRaiseType = lrt_Down then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); end; {$IFEND} end else begin if FConnRaiseType = crt_BetweenFloorUp then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise); if FConnRaiseType = crt_BetweenFloorDown then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); if FConnRaiseType = crt_TrunkUp then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise); if FConnRaiseType = crt_TrunkDown then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); end; end; end; *) //Непосредственная отрисовка обьекта на Канве procedure TConnectorObject.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var //Tolik // Points: array of TDoublePoint; FillConn: TFillConnectConObj; ObjectFromRaise: TConnectorObject; IsDraw: Boolean; BasisPoints: TDoublePoint; CheckRaiseType: TLineRaiseType; RaiseLine: TOrthoLine; //Tolik // BndPoints: TDoublePointArr; Points, BndPoints: TDoublePointArr; ptTest: TDoublePoint; DrawWidth: integer; aZoomScale: Double; adim2: double; adim02: double; adim1: double; adim4: double; aZoomScaleCad: double; function CheckCandrawRaise: Boolean; var i, j: integer; RRaiseLine: TOrthoLine; begin Result := False; RRaiseLine := Nil; if ConnectorType = ct_Clear then begin for i := 0 to JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(JoinedOrthoLinesList[i]).FisRaiseUPDown then begin RRaiseLine := TOrthoLine(JoinedOrthoLinesList[i]); break; end; end; end else if ConnectorType = ct_NB then begin for i := 0 to JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(JoinedConnectorsList[i]).JoinedOrthoLinesList.Count - 1 do begin if not TOrthoLine(TConnectorObject(JoinedConnectorsList[i]).JoinedOrthoLinesList[j]).deleted then if TOrthoLine(TConnectorObject(JoinedConnectorsList[i]).JoinedOrthoLinesList[j]).FisRaiseUpDown then begin RRaiseLine := TOrthoLine(TConnectorObject(JoinedConnectorsList[i]).JoinedOrthoLinesList[j]); break; end; end; if RRaiseLine <> nil then break; end; end; if RRaiseLine <> nil then Result := IsViewObjectInCurrentNetwork(TFigure(RRaiseLine)); end; Procedure DrawRaise; var RType: TConnRaiseType; begin if deleted then exit; //commented By Tolik 05/04/2021- //if ConnectorType = ct_NB then // exit; { RType := FConnRaiseType; if JoinedconnectorsList.Count > 0 then if not TConnectorObject(JoinedconnectorsList[0]).deleted then if TConnectorObject(JoinedconnectorsList[0]).FConnRaiseType <> crt_None then RType := TConnectorObject(JoinedconnectorsList[0]).FConnRaiseType;} // if checkCanDrawRaise then begin if FConnRaiseType = crt_OnFloor then //if RType = crt_OnFloor then begin {$IF (Defined(Final_SCS) or Defined(Trial_SCS))} CheckRaiseType := GetRaiseType(FObjectFromRaise, Self); if CheckRaiseType = lrt_Up then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise); if CheckRaiseType = lrt_Down then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); {$ELSE} RaiseLine := GetRaiseLine(Self); if RaiseLine <> nil then begin // Tolik 17/12/2020 -- if not RaiseLine.Deleted then begin // if RaiseLine.FLineRaiseType = lrt_Up then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise) else if RaiseLine.FLineRaiseType = lrt_Down then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); end; end; {$IFEND} end else begin if FConnRaiseType = crt_BetweenFloorUp then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise); if FConnRaiseType = crt_BetweenFloorDown then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); if FConnRaiseType = crt_TrunkUp then DrawRaiseUp(TPowerCad(Owner).DEngine, FObjectFromRaise); if FConnRaiseType = crt_TrunkDown then DrawRaiseDown(TPowerCad(Owner).DEngine, FObjectFromRaise); end; end; end; // begin try DrawWidth := 1; If Deleted then Exit; if FIsRotating then //11.03.2012 begin DrawFigure.draw(DEngine, isGrayed); Exit; ///// EXIT ///// end; // Tolik 01/04/2017 -- SetLength(Points, 2); SetLength(BndPoints, 4); //точки изначально проинициализируем, чтобы потом не было бяки Points[0].x := ActualPoints[1].x; Points[0].y := ActualPoints[1].y; Points[1].x := ActualPoints[1].x; Points[1].y := ActualPoints[1].y; // //Если в режиме трейса if (DrawStyle = dsTrace) then //11.03.2012 if DrawStyle = dsTrace then begin DEngine.Canvas.Pen.Color := clBlue xor clWhite; DEngine.canvas.pen.mode := pmXor; DEngine.canvas.pen.Style := psSolid; DEngine.canvas.Brush.Color := clNone; DEngine.canvas.Brush.Style := bsClear; //Отрисовать прямоугольник //Tolik -- 10/04/2017 -- вынесено наверх {SetLength(Points, 2); SetLength(BndPoints, 4);} if ConnectorType = ct_Clear then begin // Tolik -- 10/04/2017 -- {Points[0].x := ActualPoints[1].x - GrpSizeX / 2; Points[0].y := ActualPoints[1].y - GrpSizeY / 2; Points[1].x := ActualPoints[1].x + GrpSizeX / 2; Points[1].y := ActualPoints[1].y + GrpSizeY / 2; } if ((DrawFigure <> nil) and (DrawFigure.InFigures.Count > 0)) then begin Points[0].x := ActualPoints[1].x - GrpSizeX / 2; Points[0].y := ActualPoints[1].y - GrpSizeY / 2; Points[1].x := ActualPoints[1].x + GrpSizeX / 2; Points[1].y := ActualPoints[1].y + GrpSizeY / 2; end else begin Points[0].x := ActualPoints[1].x - 0.4; Points[0].y := ActualPoints[1].y - 0.4; Points[1].x := ActualPoints[1].x + 0.4; Points[1].y := ActualPoints[1].y + 0.4; end; // DEngine.DrawRect(Points[0].x, Points[0].y, Points[1].x, Points[1].y, DEngine.canvas.pen.Color, 1, integer(DEngine.canvas.pen.Style), DEngine.canvas.Brush.Color, integer(DEngine.canvas.Brush.Style)); end else begin if DrawFigure.InFigures.Count = 0 then begin // Tolik {Points[0].x := ActualPoints[1].x - GrpSizeX / 2; Points[0].y := ActualPoints[1].y - GrpSizeY / 2; Points[1].x := ActualPoints[1].x + GrpSizeX / 2; Points[1].y := ActualPoints[1].y + GrpSizeY / 2; } Points[0].x := ActualPoints[1].x - 0.4; Points[0].y := ActualPoints[1].y - 0.4; Points[1].x := ActualPoints[1].x + 0.4; Points[1].y := ActualPoints[1].y + 0.4; // DEngine.DrawRect(Points[0].x, Points[0].y, Points[1].x, Points[1].y, DEngine.canvas.pen.Color, 1, integer(DEngine.canvas.pen.Style), DEngine.canvas.Brush.Color, integer(DEngine.canvas.Brush.Style)); end else begin begin {BUG_2015_04_14_1} adim02 := -dim02; aZoomScale := 0; adim2 := dim2; // если сдвинуто УГО или в УГО много разных елементов - рисуем чисто квадратик if (DrawFigure.InFigures.Count > 1) or (self.FDrawFigureMoved) then begin // рисуем тупо квадрат независимо от формы УГО. { проба - так не подходит - нужно чтобы чисто квадрат зависел не от скейла када а от процента УГО //if (GCadForm.PCad <> nil) then // aZoomScale := GCadForm.PCad.ZoomScale; //if (aZoomScale <> 0) then //begin // Points[0].x := ActualPoints[1].x - dim2 / (aZoomScale / 100); // Points[0].y := ActualPoints[1].y - dim2 / (aZoomScale / 100); // Points[1].x := ActualPoints[1].x + dim2 / (aZoomScale / 100); // Points[1].y := ActualPoints[1].y + dim2 / (aZoomScale / 100); //end //else } aZoomScale := self.FDrawFigurePercent; if (aZoomScale <> 0) then begin if aZoomScale < 20 then adim2 := 4 else if aZoomScale < 70 then adim2 := 3; Points[0].x := ActualPoints[1].x - adim2 * (aZoomScale / 100); Points[0].y := ActualPoints[1].y - adim2 * (aZoomScale / 100); Points[1].x := ActualPoints[1].x + adim2 * (aZoomScale / 100); Points[1].y := ActualPoints[1].y + adim2 * (aZoomScale / 100); end else { чисто так вообще было ранее перед рихтовкой BUG_2015_04_14_1} begin Points[0].x := ActualPoints[1].x - adim2 {GrpSizeX / 2}; Points[0].y := ActualPoints[1].y - adim2 {GrpSizeY / 2}; Points[1].x := ActualPoints[1].x + adim2 {GrpSizeX / 2}; Points[1].y := ActualPoints[1].y + adim2 {GrpSizeY / 2}; end; end else begin Points[0].x := ActualPoints[1].x - (GrpSizeX / 2 + adim02); Points[0].y := ActualPoints[1].y - (GrpSizeY / 2 + adim02); Points[1].x := ActualPoints[1].x + (GrpSizeX / 2 + adim02); Points[1].y := ActualPoints[1].y + (GrpSizeY / 2 + adim02); end; end; DEngine.DrawRect(Points[0].x, Points[0].y, Points[1].x, Points[1].y, DEngine.canvas.pen.Color, 1, integer(DEngine.canvas.pen.Style), DEngine.canvas.Brush.Color, integer(DEngine.canvas.Brush.Style)); end; end; end else // Если в нормальном режиме (Обьект уже создан) begin if DrawFigure <> nil then begin if AsEndPoint then begin //{$IF Not Defined(SCS_PE) and not Defined(SCS_PANDUIT)} // DrawFigure.Visible := False; // SetAllInFiguresVisible(DrawFigure, False); //{$ELSE} if Not DrawFigure.Deleted then if Not DrawFigure.Visible then begin DrawFigure.Visible := True; SetAllInFiguresVisible(DrawFigure, True); end; //{$IFEND} end else begin if Not DrawFigure.Deleted then begin DrawFigure.Visible := True; SetAllInFiguresVisible(DrawFigure, True); end; end; end; // типы сетей IsDraw := IsViewObjectInCurrentNetwork(Self); FIsDraw := IsDraw; //05.04.2011 if IsDraw then begin if CaptionsGroup <> nil then CaptionsGroup.Visible := ShowCaptions; if NotesGroup <> nil then begin if IsNoteExist(NotesGroup) then NotesGroup.Visible := ShowNotes else NotesGroup.Visible := False; end; if DrawFigure <> nil then begin if AsEndPoint then begin //{$IF Not Defined(SCS_PE) and not Defined(SCS_PANDUIT)} // DrawFigure.Visible := False; // SetAllInFiguresVisible(DrawFigure, False); //{$ELSE} if Not DrawFigure.Deleted then if Not DrawFigure.Visible then begin DrawFigure.Visible := True; SetAllInFiguresVisible(DrawFigure, True); end; //{$IFEND} end else begin if Not DrawFigure.Deleted then begin DrawFigure.Visible := True; SetAllInFiguresVisible(DrawFigure, True); end; end; end; end else begin if CaptionsGroup <> nil then CaptionsGroup.Visible := False; if NotesGroup <> nil then NotesGroup.Visible := False; if DrawFigure <> nil then begin DrawFigure.Visible := False; SetAllInFiguresVisible(DrawFigure, False); end; end; if ConnectorType = ct_clear then begin if CaptionsGroup <> nil then CaptionsGroup.Visible := False; if NotesGroup <> nil then NotesGroup.Visible := False; //05.04.2011 //if not IsDraw then end; //if not IsDraw then // Toilk -- 10/04/2017 -- // Exit; if FConnRaiseType <> crt_None then begin SetLength(Points, 0); SetLength(BndPoints, 0); if FConnRaiseType <> crt_None then // Tolik 16/04/2020 -- DrawRaise; // Tolik 16/04/2020 -- Exit; end; // if GCadForm.FShowCableChannelsOnly then begin DrawFigure.Visible := False; SetAllInFiguresVisible(DrawFigure, False); // Tolik 10/04/2017 -- SetLength(Points, 0); SetLength(BndPoints, 0); // Exit; end; // обложка if isGrayed then begin if ConnectorType = ct_Clear then begin DEngine.Canvas.Pen.Color := clGray; DEngine.Canvas.Pen.Style := psSolid; end; if ConnectorType <> ct_Clear then begin DEngine.Canvas.Pen.Color := clGray; DEngine.Canvas.Pen.Style := psSolid; end; end else {*****************************************************************} // нормальный begin DEngine.Canvas.Pen.Color := clBlack; DEngine.Canvas.brush.Style := bsClear; // Пустой if ConnectorType = ct_Clear then begin if AsEndPoint then begin DEngine.Canvas.Pen.Color := clGreen; DEngine.canvas.Brush.Color := clGreen; DEngine.canvas.Brush.Style := bsClear; DEngine.Canvas.Pen.Style := psSolid; end else begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then DEngine.Canvas.Pen.Color := GCadForm.PCad.PageColor; // IGOR - уже не нужно зарисовывать ранее отображенные рамки снепа D0000006113 //if (Self = GPrevFigureSnap) or (Self = GPrevFigureTraceTo) then // DEngine.Canvas.Pen.Style := psSolid //else DEngine.Canvas.Pen.Style := psClear; end; end else // РТ begin if (AsEndPoint)or(InsideCabinet) then begin DEngine.canvas.Brush.Color := clRed; DEngine.canvas.Brush.Style := bsSolid; // IGOR - уже не нужно зарисовывать ранее отображенные рамки снепа D0000006113 //if (Self = GPrevFigureSnap) or (Self = GPrevFigureTraceTo) then // DEngine.Canvas.Pen.Style := psSolid //else // DEngine.Canvas.Pen.Style := psClear; //{$IF Defined (SCS_PE)} DEngine.Canvas.Pen.Style := psSolid; if InsideCabinet then begin DrawWidth := 3; DEngine.Canvas.Pen.Color := $1f7ffa; DEngine.canvas.Brush.Color := $1f7ffa; end else begin DrawWidth := 1; DEngine.Canvas.Brush.Color := $EE82EE; end; DEngine.Canvas.Brush.Style := bsDiagCross; //{$IFEND} end else begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then DEngine.Canvas.Pen.Color := GCadForm.PCad.PageColor; DEngine.canvas.Brush.Color := clNone; DEngine.canvas.Brush.Style := bsClear; // IGOR - уже не нужно зарисовывать ранее отображенные рамки снепа D0000006113 //if (Self = GPrevFigureSnap) or (Self = GPrevFigureTraceTo) then // DEngine.Canvas.Pen.Style := psSolid //else DEngine.Canvas.Pen.Style := psClear; end; if Drawstyle = mydsNormal then if FConnRaiseType <> crt_None then // Tolik 16/04/2020 -- DRAWRAISE; // Tolik 16/04/2020 -- end; end; DEngine.canvas.pen.mode := pmCopy; //Отрисовать прямоугольник // Tolik -- 10/04/2017 -- это вынесено наверх // SetLength(Points, 2); if ConnectorType = ct_clear then begin adim1 := dim1; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin if GCadForm.PCad.ZoomScale > 700 then aZoomScaleCad := GCadForm.PCad.ZoomScale / 3 else aZoomScaleCad := GCadForm.PCad.ZoomScale / 2; end; if (aZoomScaleCad > 50) then adim1 := adim1 / (aZoomScaleCad / 100); Points[0].x := ActualPoints[1].x - (GrpSizeX / 2 + adim1); Points[0].y := ActualPoints[1].y - (GrpSizeY / 2 + adim1); Points[1].x := ActualPoints[1].x + (GrpSizeX / 2 + adim1); Points[1].y := ActualPoints[1].y + (GrpSizeY / 2 + adim1); end else begin adim02 := dim02; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; end; if (aZoomScaleCad > 100) then adim02 := adim02 / (aZoomScaleCad / 100); if (AsEndPoint)or(InsideCabinet) then begin if DrawFigure <> nil then begin // Tolik -- 10/04/2017 -- {Points[0].x := DrawFigure.CenterPoint.x - (GrpSizeX / 2 + adim02); Points[0].y := DrawFigure.CenterPoint.y - (GrpSizeY / 2 + adim02); Points[1].x := DrawFigure.CenterPoint.x + (GrpSizeX / 2 + adim02); Points[1].y := DrawFigure.CenterPoint.y + (GrpSizeY / 2 + adim02);} //if ((GrpSizeX <> 0) and (GrpSizeY <> 0)) then if DrawFigure.InFigures.Count > 0 then begin Points[0].x := DrawFigure.CenterPoint.x - (GrpSizeX / 2 + adim02); Points[0].y := DrawFigure.CenterPoint.y - (GrpSizeY / 2 + adim02); Points[1].x := DrawFigure.CenterPoint.x + (GrpSizeX / 2 + adim02); Points[1].y := DrawFigure.CenterPoint.y + (GrpSizeY / 2 + adim02); end else begin Points[0].x := ActualPoints[1].x - 0.4; Points[0].y := ActualPoints[1].y - 0.4; Points[1].x := ActualPoints[1].x + 0.4; Points[1].y := ActualPoints[1].y + 0.4; end; // end else begin // Tolik -- 10/04/2017 -- если нет финуры отрисовки, какой нахер GRPSize? { Points[0].x := ActualPoints[1].x - (GrpSizeX / 2 + adim02); Points[0].y := ActualPoints[1].y - (GrpSizeY / 2 + adim02); Points[1].x := ActualPoints[1].x + (GrpSizeX / 2 + adim02); Points[1].y := ActualPoints[1].y + (GrpSizeY / 2 + adim02); } Points[0].x := ActualPoints[1].x - 0.4; Points[0].y := ActualPoints[1].y - 0.4; Points[1].x := ActualPoints[1].x + 0.4; Points[1].y := ActualPoints[1].y + 0.4; end; end else begin if DrawFigure <> nil then begin // Tolik -- 10/04/2017 -- { Points[0].x := DrawFigure.ActualPoints[1].x; Points[0].y := DrawFigure.ActualPoints[1].y; Points[1].x := DrawFigure.ActualPoints[1].x + (GrpSizeX + adim02); Points[1].y := DrawFigure.ActualPoints[1].y + (GrpSizeY + adim02); } if DrawFigure.InFigures.Count > 0 then begin Points[0].x := DrawFigure.ActualPoints[1].x; Points[0].y := DrawFigure.ActualPoints[1].y; Points[1].x := DrawFigure.ActualPoints[1].x + (GrpSizeX + adim02); Points[1].y := DrawFigure.ActualPoints[1].y + (GrpSizeY + adim02); end else begin {Points[0].x := DrawFigure.ActualPoints[1].x - 0.4; Points[0].y := DrawFigure.ActualPoints[1].y - 0.4; Points[1].x := DrawFigure.ActualPoints[1].x + 0.4; Points[1].y := DrawFigure.ActualPoints[1].y + 0.4;} Points[0].x := ActualPoints[1].x - 0.4; Points[0].y := ActualPoints[1].y - 0.4; Points[1].x := ActualPoints[1].x + 0.4; Points[1].y := ActualPoints[1].y + 0.4; end; // end else begin // Tolik -- 10/04/2017 -- { Points[0].x := ActualPoints[1].x - (GrpSizeX / 2 + adim02); Points[0].y := ActualPoints[1].y - (GrpSizeY / 2 + adim02); Points[1].x := ActualPoints[1].x + (GrpSizeX / 2 + adim02); Points[1].y := ActualPoints[1].y + (GrpSizeY / 2 + adim02); } // IGOR // низя так ибо DrawFigure NIL //Points[0].x := DrawFigure.ActualPoints[1].x - 0.4; //Points[0].y := DrawFigure.ActualPoints[1].y - 0.4; //Points[1].x := DrawFigure.ActualPoints[1].x + 0.4; //Points[1].y := DrawFigure.ActualPoints[1].y + 0.4; // // нужно так: Points[0].x := ActualPoints[1].x - 0.4; Points[0].y := ActualPoints[1].y - 0.4; Points[1].x := ActualPoints[1].x + 0.4; Points[1].y := ActualPoints[1].y + 0.4; end; end; end; {***********************************************} // отобразить заполненность объектов if GCadForm.FShowConnFullness then begin if ConnectorType <> ct_Clear then begin DEngine.Canvas.Pen.Style := psSolid; if FConnFullness = cif_Empty then DEngine.Canvas.Brush.Color := clRed; if FConnFullness = cif_Full then DEngine.Canvas.Brush.Color := clGreen; if FConnFullness = cif_HalfEmpty then DEngine.Canvas.Brush.Color := clYellow; DEngine.Canvas.Brush.Style := bsDiagCross; end; end; // отобразить степень дефекта if GCadForm.FShowDefectObjects then begin if ConnectorType <> ct_Clear then begin DEngine.Canvas.Pen.Style := psSolid; if FDefectDegree = dodDefect then DEngine.Canvas.Brush.Color := clRed; if FDefectDegree = dodPartDefect then DEngine.Canvas.Brush.Color := clYellow; DEngine.Canvas.Brush.Style := bsCross; end; end; // отобразить объекты, которые ни к чему не присоединены if GCadForm.FShowDisconnectedObjects then begin if ConnectorType <> ct_Clear then begin if JoinedConnectorsList.Count = 0 then begin DEngine.Canvas.Pen.Style := psSolid; //DEngine.Canvas.Brush.Color := clPurple; DEngine.Canvas.Brush.Color := RGB($80, 0, $FF); DEngine.Canvas.Brush.Style := bsDiagCross; end; end; end; {***********************************************} // в режиме подвязки if isSnap then begin DEngine.Canvas.Pen.Color := clRed; DEngine.Canvas.Pen.Style := psSolid; adim1 := dim1; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; end; if (aZoomScaleCad > 100) then adim1 := adim1 / (aZoomScaleCad / 100); DrawWidth := 3; { //if Not AsEndPoint then begin Points[0].x := Points[0].x - adim1; Points[0].y := Points[0].y - adim1; Points[1].x := Points[1].x + adim1; Points[1].y := Points[1].y + adim1; end; } if (DrawFigure <> nil) and (DrawFigure.InFigures.Count > 0) then begin if ByDrawF = -1 then ByDrawF := CheckConnectorUseUGOBounds(Self); if (ByDrawF = biFalse) and ((DrawFigure.InFigures.Count > 1) or (Not EQDP(Self.CenterPoint, DrawFigure.CenterPoint))) then //if (ByDrawF = biTrue) and ((DrawFigure.InFigures.Count > 1) or (Not EQDP(Self.CenterPoint, DrawFigure.CenterPoint))) then begin // Здесь желательно отрисовать просто квадратик (как на трейсе) { это по форме УГО отрисовка Points[0].x := Points[0].x - adim1; Points[0].y := Points[0].y - adim1; Points[1].x := Points[1].x + adim1; Points[1].y := Points[1].y + adim1; } // рисуем тупо квадрат независимо от формы УГО. aZoomScale := self.FDrawFigurePercent; adim2 := dim2; if (aZoomScale <> 0) then begin if aZoomScale < 20 then adim2 := 4 else if aZoomScale < 70 then adim2 := 3; Points[0].x := ActualPoints[1].x - adim2 * (aZoomScale / 100); Points[0].y := ActualPoints[1].y - adim2 * (aZoomScale / 100); Points[1].x := ActualPoints[1].x + adim2 * (aZoomScale / 100); Points[1].y := ActualPoints[1].y + adim2 * (aZoomScale / 100); end else { чисто так вообще было ранее перед рихтовкой } begin Points[0].x := Points[0].x - adim1; Points[0].y := Points[0].y - adim1; Points[1].x := Points[1].x + adim1; Points[1].y := Points[1].y + adim1; end; end else begin // здесь отрисуем полное очертание Points[0].x := Points[0].x - adim1; Points[0].y := Points[0].y - adim1; Points[1].x := Points[1].x + adim1; Points[1].y := Points[1].y + adim1; end; end else begin // здесь для пустых коннекторов adim1 := 0.7; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; end; if (aZoomScaleCad > 100) then adim1 := adim1 / (aZoomScaleCad / 100); Points[0].x := Points[0].x - adim1; Points[0].y := Points[0].y - adim1; Points[1].x := Points[1].x + adim1; Points[1].y := Points[1].y + adim1; end; end else begin // IGOR - уже не нужно зарисовывать ранее отображенные рамки снепа D0000006113 //if (Self = GPrevFigureSnap) or (Self = GPrevFigureTraceTo) then //begin // DrawWidth := 3; // if Not AsEndPoint then // begin // Points[0].x := Points[0].x - 1; // Points[0].y := Points[0].y - 1; // Points[1].x := Points[1].x + 1; // Points[1].y := Points[1].y + 1; // end; //end; end; if DEngine.Canvas.Brush.Style = bsClear then begin if DrawFigure <> nil then begin end else begin adim1 := 1.2; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; end; if (aZoomScaleCad > 100) then adim1 := adim1 / (aZoomScaleCad / 100); Points[0].x := ActualPoints[1].x - (GrpSizeX / 2 + adim1); Points[0].y := ActualPoints[1].y - (GrpSizeY / 2 + adim1); Points[1].x := ActualPoints[1].x + (GrpSizeX / 2 + adim1); Points[1].y := ActualPoints[1].y + (GrpSizeY / 2 + adim1); end; end; if FConnRaiseType <> crt_None then begin if (FObjectFromRaise <> nil) and (ConnectorDetect(FObjectFromRaise)) then begin if FObjectFromRaise.DrawFigure.InFigures.Count = 0 then begin BasisPoints.x := FObjectFromRaise.ActualPoints[1].x + FObjectFromRaise.GrpSizeX / 2; BasisPoints.y := FObjectFromRaise.ActualPoints[1].y - FObjectFromRaise.GrpSizeY / 2; end else begin BasisPoints.x := FObjectFromRaise.DrawFigure.CenterPoint.x + FObjectFromRaise.GrpSizeX / 2; BasisPoints.y := FObjectFromRaise.DrawFigure.CenterPoint.y - FObjectFromRaise.GrpSizeY / 2; end; RaiseLine := GetRaiseLine(Self); //так нельзя иначе вообще на с/п хрен что отрисуется если вдруг изменятся dim2 и dim4 //adim2 := dim2; //adim4 := dim4; // отрисовка квадратиков на с/п (снеп, КО) adim2 := 2; adim4 := 4; if FObjectFromRaise.DrawFigure.InFigures.Count > 0 then begin adim2 := 1.5; //1.5 adim4 := 3.5; //3.5 end; if (RaiseLine <> nil) and (OrtholineDetect(RaiseLine)) then begin aZoomScale := RaiseLine.FDrawFigurePercent; if (aZoomScale <> 0) then begin if (FObjectFromRaise.DrawFigure.InFigures.Count > 0) and (aZoomScale <= 30) then begin adim2 := 0.5; //1.5 adim4 := 2.5; //3.5 end; if (FObjectFromRaise.DrawFigure.InFigures.Count > 0) and (aZoomScale <= 20) then begin adim2 := 0; //1.5 adim4 := 2; //3.5 end; adim2 := adim2 * (aZoomScale / 100); adim4 := adim4 * (aZoomScale / 100); end; if RaiseLine.FLineRaiseType = lrt_Up then begin Points[0].x := BasisPoints.x + adim2; Points[0].y := BasisPoints.y - adim4; Points[1].x := BasisPoints.x + adim4; Points[1].y := BasisPoints.y - adim2; end; // спуск if RaiseLine.FLineRaiseType = lrt_Down then begin Points[0].x := BasisPoints.x + adim2; Points[0].y := BasisPoints.y - adim4; Points[1].x := BasisPoints.x + adim4; Points[1].y := BasisPoints.y - adim2; end; end; end; end; // ОТРИСОВАТЬ ОЧЕРТАНИЯ ЕСЛИ СТИЛЬ НЕ "ПУСТОЙ" // ИЛИ ОБЪЕКТ - КОНЕЧНЫЙ ОБЪЕКТ if (DEngine.canvas.pen.Style <> psClear) or (AsEndPoint)or(InsideCabinet) then begin // D0000006113 // IGOR - не нужна здесь эта проверка //if (isSnap) then //01.11.2013 самыков //SetConnBringToFront(self); // Tolik 24/05/2017 -- if asEndPoint then begin DEngine.canvas.Brush.Color := clRed; DEngine.canvas.Brush.Style := bsSolid; DEngine.Canvas.Pen.Style := psSolid; if InsideCabinet then begin DrawWidth := 3; DEngine.Canvas.Pen.Color := $1f7ffa; DEngine.canvas.Brush.Color := $1f7ffa; end else begin DrawWidth := 1; DEngine.Canvas.Brush.Color := $EE82EE; end; DEngine.Canvas.Brush.Style := bsDiagCross; end; // Tolik -- 30/05/2017 -- тут такое делать низзя, потому что, если перед рефрешем КАДа // какой-нибудь объект (особенно закрашенный) вынесется на передний план, то он не отрисуется // вынесено в рефреш КАДа -- там порядок фигур выставится до отрисовки и все будет ок {if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then TPowerCad(Owner).OrderFigureToFront(self);} // DEngine.DrawRect(Points[0].x, Points[0].y, Points[1].x, Points[1].y, DEngine.canvas.pen.Color, DrawWidth, integer(DEngine.canvas.pen.Style), DEngine.canvas.Brush.Color, integer(DEngine.canvas.Brush.Style)); //Tolik 08/11/2017 -*- RedRect[1].x := Points[0].x; RedRect[1].y := Points[0].y; RedRect[1].z := 0; RedRect[2].x := Points[1].x; RedRect[2].y := Points[1].y; RedRect[2].z := 0; // end; // Дорисовать усл. обозначение поднятия на высоту if (FObjectFromRaise <> nil) and (ConnectorDetect(FObjectFromRaise)) then begin if FConnRaiseType = crt_OnFloor then begin DEngine.Canvas.Pen.Width := 1; DEngine.Canvas.Brush.Color := clBlack; DEngine.Canvas.Brush.Style := bsSolid; end; if (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_BetweenFloorDown) then begin DEngine.Canvas.Pen.Width := 2; DEngine.Canvas.Brush.Color := clBlue; DEngine.Canvas.Brush.Style := bsSolid; end; if (FConnRaiseType = crt_TrunkUp) or (FConnRaiseType = crt_TrunkDown) then begin DEngine.Canvas.Pen.Width := 2; DEngine.Canvas.Brush.Color := clGreen; DEngine.Canvas.Brush.Style := bsSolid; end; if FConnRaiseType <> crt_None then // Tolik 16/04/2020 -- DRAWRAISE; // Tolik 16/04/2020 -- // DRAW RAISE (* if FConnRaiseType = crt_OnFloor then begin {$IF (Defined(Final_SCS) or Defined(Trial_SCS))} CheckRaiseType := GetRaiseType(FObjectFromRaise, Self); if CheckRaiseType = lrt_Up then DrawRaiseUp(DEngine, FObjectFromRaise); if CheckRaiseType = lrt_Down then DrawRaiseDown(DEngine, FObjectFromRaise); {$ELSE} RaiseLine := GetRaiseLine(Self); if RaiseLine <> nil then begin if RaiseLine.FLineRaiseType = lrt_Up then DrawRaiseUp(DEngine, FObjectFromRaise) else if RaiseLine.FLineRaiseType = lrt_Down then DrawRaiseDown(DEngine, FObjectFromRaise); end; {$IFEND} end else begin if FConnRaiseType = crt_BetweenFloorUp then DrawRaiseUp(DEngine, FObjectFromRaise); if FConnRaiseType = crt_BetweenFloorDown then DrawRaiseDown(DEngine, FObjectFromRaise); if FConnRaiseType = crt_TrunkUp then DrawRaiseUp(DEngine, FObjectFromRaise); if FConnRaiseType = crt_TrunkDown then DrawRaiseDown(DEngine, FObjectFromRaise); end; *) end; end; //Tolik SetLength(Points, 0); SetLength(BndPoints, 0); // except // on E: Exception do addExceptionToLogEx('TConnectorObject.Draw', E.Message); on E: Exception do addExceptionToLogEx('TConnectorObject.Draw ' + 'ID = '+ inttostr(Self.ID), E.Message); end; end; //Создание РЕАЛЬНОГО обьекта class function TConnectorObject.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; begin try // Вызвать конструктор, который создаст обьект Result := nil; Result := TConnectorObject.Create(Shadow.ActualPoints[1].x, Shadow.ActualPoints[1].y, TConnectorObject(Shadow).ActualZOrder[1], LHandle, mydsNormal, aOwner); TConnectorObject(Result).ConnectorType := GCurrentConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LHandle), Result, False); Result := nil; except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateFromShadow', E.Message); end; end; procedure TConnectorObject.Initialize; begin inherited; FClassIndex := ciConnectorObject; //04.11.2011 RedRect[1].x := ActualPoints[1].x; RedRect[1].y := ActualPoints[1].y; RedRect[1].z := 0; RedRect[2].x := ActualPoints[1].x; RedRect[2].y := ActualPoints[1].y; RedRect[2].z := 0; ByDrawF := -1; // Tolik 09/03/2021 -- end; function TConnectorObject.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; begin try Result := True; except on E: Exception do addExceptionToLogEx('TConnectorObject.ShadowTrace', E.Message); end; end; //Отрабатывает при нажатие мышки, после свойства CreateShadow function TConnectorObject.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; begin try Result := false; //Создаем обьект после первого клика //не отрабатывая CreateFromShadow if ClickIndex = 1 then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('TConnectorObject.ShadowClick', E.Message); end; end; //Задает крайние точки фигуры, нужен для дальнейшей проверки на вхождение //точек в область обьекта procedure TConnectorObject.GetBoundsDef(var figMaxX, figMaxY, figMinX, figMinY: Double); // Tolik 09/03/2021 -- begin try figMinX := ActualPoints[1].x - GrpSizeX / 2; figMinY := ActualPoints[1].y - GrpSizeY / 2; figMaxX := ActualPoints[1].x + GrpSizeX / 2; figMaxY := ActualPoints[1].y + GrpSizeY / 2; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetBoundsDef', E.Message); end; end; // Tolik 09/03/2021 -- старая закомменчена - см. ниже procedure TConnectorObject.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); var Cp: TDoublePoint; figMaxX1,figMaxY1,figMinX1,figMinY1: Double; begin try figMinX := ActualPoints[1].x - GrpSizeX / 2; figMinY := ActualPoints[1].y - GrpSizeY / 2; figMaxX := ActualPoints[1].x + GrpSizeX / 2; figMaxY := ActualPoints[1].y + GrpSizeY / 2; //Cp := DoublePoint((figMaxX1 + figMinX1)/2, (figMaxY1 + figMinY1)/2); //Cp := DoublePoint((figMaxX + figMinX)/2, (figMaxY + figMinY)/2); Cp := DoublePoint(ActualPoints[1].x + GrpSizeX/2, ActualPoints[1].y + GrpSizeY/2); figMinX := ActualPoints[1].x - 1; figMinY := ActualPoints[1].y - 1; figMaxX := ActualPoints[1].x + 1; figMaxY := ActualPoints[1].y + 1; if (DrawFigure = nil) or (DrawFigure.InFigures.Count = 0) then begin figMinX := ActualPoints[1].x - GrpSizeX / 2; figMinY := ActualPoints[1].y - GrpSizeY / 2; figMaxX := ActualPoints[1].x + GrpSizeX / 2; figMaxY := ActualPoints[1].y + GrpSizeY / 2; end else // есть изображение begin if ByDrawF = -1 then ByDrawF := CheckConnectorUseUGOBounds(Self); {TODO} // check for - ByCenterConnectPoint if ByCenterConnectPoint - then ByDrawF := False; // prop ByCenterConnectPoint in TConnectorObject - def = -1 // if ConnectorObject.ByCenterConnectPoint = -1 - get prop from top component // prop in component ByCenterConnectPoint - Не учитывать УГО для границ объекта // чекбокс под уго в свойствах комп. // изменять само свойство / или состояние чекбокса после изменения чекбокса / свойства соотв. // на DefineObjectParams или даже внутри DefineOjectIcon - прописывть в ConnectorObject.ByCenterConnectPoint from top component if (ByDrawF = biTrue) and ((DrawFigure.InFigures.Count > 1) or (Not EQDP(Cp, DrawFigure.CenterPoint))) then begin try figMinX := DrawFigure.CenterPoint.x - GrpSizeX / 2; figMinY := DrawFigure.CenterPoint.y - GrpSizeY / 2; figMaxX := DrawFigure.CenterPoint.x + GrpSizeX / 2; figMaxY := DrawFigure.CenterPoint.y + GrpSizeY / 2; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetBounds', E.Message); end; end else begin try figMinX := ActualPoints[1].x - GrpSizeX / 2; figMinY := ActualPoints[1].y - GrpSizeY / 2; figMaxX := ActualPoints[1].x + GrpSizeX / 2; figMaxY := ActualPoints[1].y + GrpSizeY / 2; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetBounds', E.Message); end; end; end; /// except on E: Exception do addExceptionToLogEx('TConnectorObject.GetBounds', E.Message); end; end; { procedure TConnectorObject.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); begin try figMinX := ActualPoints[1].x - GrpSizeX / 2; figMinY := ActualPoints[1].y - GrpSizeY / 2; figMaxX := ActualPoints[1].x + GrpSizeX / 2; figMaxY := ActualPoints[1].y + GrpSizeY / 2; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetBounds', E.Message); end; end; } procedure TConnectorObject.getboundsWithoutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); begin try figMinX := ActualPoints[1].x; figMinY := ActualPoints[1].y; figMaxX := ActualPoints[1].x; figMaxY := ActualPoints[1].y; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetBounds', E.Message); end; end; //Tolik 30/10/2018 -- старая закомменчена -- см ниже (* //Проверка на вхождение точек в область обьекта function TConnectorObject.IsPointIn(x, y: Double): Boolean; var RaiseMinX, RaiseMinY, RaiseMaxX, RaiseMaxY: Double; ObjectFromRaise: TConnectorObject; BasisPoints: TDoublePoint; RaiseLine: TOrthoLine; adim25: double; adim4: double; aZoomScale: double; adim2: double; adim1: double; aZoomScaleCad: double; begin try Result := False; {************************************************************************} // ПОДЪЕМ - СПУСК if ((FObjectFromRaise <> nil) and (ConnectorDetect(FObjectFromRaise)) and (ConnectorType = ct_Clear)) then begin if FObjectFromRaise.DrawFigure.InFigures.Count = 0 then begin BasisPoints.x := FObjectFromRaise.ActualPoints[1].x + FObjectFromRaise.GrpSizeX / 2; BasisPoints.y := FObjectFromRaise.ActualPoints[1].y - FObjectFromRaise.GrpSizeY / 2; end else begin BasisPoints.x := FObjectFromRaise.DrawFigure.CenterPoint.x + FObjectFromRaise.GrpSizeX / 2; BasisPoints.y := FObjectFromRaise.DrawFigure.CenterPoint.y - FObjectFromRaise.GrpSizeY / 2; end; // подъем RaiseLine := GetRaiseLine(Self); if (RaiseLine <> nil) and (OrtholineDetect(RaiseLine)) then begin adim25 := 2.5; adim4 := 4; aZoomScale := RaiseLine.FDrawFigurePercent; if FObjectFromRaise <> nil then begin if FObjectFromRaise.DrawFigure.InFigures.Count > 0 then begin adim25 := 2.0; adim4 := 3.5; end; if (FObjectFromRaise.DrawFigure.InFigures.Count > 0) and (aZoomScale <= 30) then begin adim25 := 1.5; adim4 := 2.5; end; if (FObjectFromRaise.DrawFigure.InFigures.Count > 0) and (aZoomScale <= 20) then begin adim25 := 0.5; adim4 := 2.5; end; end; if (aZoomScale <> 0) then begin adim25 := adim25 * (aZoomScale / 100); adim4 := adim4 * (aZoomScale / 100); end; if RaiseLine.FLineRaiseType = lrt_Up then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; // спуск if RaiseLine.FLineRaiseType = lrt_Down then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; if ActualZOrder[1] = FObjectFromRaise.ActualZOrder[1] then begin if (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_TrunkUp) then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; if (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_TrunkDown) then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; end; if (x >= RaiseMinX) AND (x <= RaiseMaxX) AND (y >= RaiseMinY) AND (y <= RaiseMaxY) then Result := True; end; end else // ОБЫЧНЫЙ begin // ПУСТОЙ if ConnectorType = ct_Clear then begin adim1 := 2; //1; adim4 := 4; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; if (GCadForm.PCad.ZoomScale >= 500) and (GCadForm.PCad.ZoomScale < 1000) then aZoomScaleCad := GCadForm.PCad.ZoomScale / 2 else if GCadForm.PCad.ZoomScale >= 1000 then aZoomScaleCad := GCadForm.PCad.ZoomScale / 3; end; if aZoomScaleCad > 0 then begin adim1 := adim1 / (aZoomScaleCad / 100); adim4 := adim4 / (aZoomScaleCad / 100); end; if FIsHouseJoined then begin if (x >= ActualPoints[1].x - (GrpSizeX + adim4) / 2) AND (x <= ActualPoints[1].x + (GrpSizeX + adim4) / 2) AND (y >= ActualPoints[1].y - (GrpSizeY + adim4) / 2) AND (y <= ActualPoints[1].y + (GrpSizeY + adim4) / 2) then Result := True; end else begin if (x >= ActualPoints[1].x - (GrpSizeX + adim1) / 2) AND (x <= ActualPoints[1].x + (GrpSizeX + adim1) / 2) AND (y >= ActualPoints[1].y - (GrpSizeY + adim1) / 2) AND (y <= ActualPoints[1].y + (GrpSizeY + adim1) / 2) then Result := True; end; end else // ТОЧЕЧНЫЙ ОБЪЕКТ begin // нет изображения // Tolik -- 11/01/2017 -- // Фигуры отрисовки может и не быть, если пользователь создал компонент, а УГО не задал ... //if DrawFigure.InFigures.Count = 0 then if (DrawFigure = nil) or (DrawFigure.InFigures.Count = 0) then begin // тупо по квадрату независимо от формы УГО. aZoomScale := self.FDrawFigurePercent; adim2 := dim2; if (aZoomScale <> 0) then begin if aZoomScale < 20 then adim2 := 4 else if aZoomScale < 70 then adim2 := 3; adim2 := adim2 * (aZoomScale / 100); if (x >= ActualPoints[1].x - adim2) AND (x <= ActualPoints[1].x + adim2) AND (y >= ActualPoints[1].y - adim2) AND (y <= ActualPoints[1].y + adim2) then Result := True; end else begin { это по форме УГО проверка вхождения} if (x >= DrawFigure.CenterPoint.x - GrpSizeX / 2) AND (x <= DrawFigure.CenterPoint.x + GrpSizeX / 2) AND (y >= DrawFigure.CenterPoint.y - GrpSizeY / 2) AND (y <= DrawFigure.CenterPoint.y + GrpSizeY / 2) then Result := True; end; end else // есть изображение begin { это по форме УГО проверка вхождения} if ( x >= DrawFigure.CenterPoint.x - GrpSizeX / 2) AND (x <= DrawFigure.CenterPoint.x + GrpSizeX / 2) AND (y >= DrawFigure.CenterPoint.y - GrpSizeY / 2) AND (y <= DrawFigure.CenterPoint.y + GrpSizeY / 2) then // if IsPointInDrawFigure(x, y) then Result := True; end; end; end; //05.04.2011 - Если объект скрыт от прорисовки, значит не даем его выделить мышкой if Not FIsDraw and (ConnectorType = ct_Clear) and Not Selected and (Not(ssShift in GGlobalShiftState)) then Result := false; except on E: Exception do addExceptionToLogEx('TConnectorObject.IsPointIn', E.Message); end; end; *) // //Проверка на вхождение точек в область обьекта function TConnectorObject.IsPointIn(x, y: Double): Boolean; var RaiseMinX, RaiseMinY, RaiseMaxX, RaiseMaxY: Double; ObjectFromRaise: TConnectorObject; BasisPoints: TDoublePoint; RaiseLine: TOrthoLine; adim25: double; adim4: double; aZoomScale: double; adim2: double; adim1: double; aZoomScaleCad: double; begin try Result := False; {************************************************************************} // ПОДЪЕМ - СПУСК if (FObjectFromRaise <> nil) and (ConnectorDetect(FObjectFromRaise)) then begin if FObjectFromRaise.DrawFigure.InFigures.Count = 0 then begin BasisPoints.x := FObjectFromRaise.ActualPoints[1].x + FObjectFromRaise.GrpSizeX / 2; BasisPoints.y := FObjectFromRaise.ActualPoints[1].y - FObjectFromRaise.GrpSizeY / 2; end else begin BasisPoints.x := FObjectFromRaise.DrawFigure.CenterPoint.x + FObjectFromRaise.GrpSizeX / 2; BasisPoints.y := FObjectFromRaise.DrawFigure.CenterPoint.y - FObjectFromRaise.GrpSizeY / 2; end; // подъем RaiseLine := GetRaiseLine(Self); if (RaiseLine <> nil) and (OrtholineDetect(RaiseLine)) then begin adim25 := 2.5; adim4 := 4; aZoomScale := RaiseLine.FDrawFigurePercent; if FObjectFromRaise <> nil then begin if FObjectFromRaise.DrawFigure.InFigures.Count > 0 then begin adim25 := 2.0; adim4 := 3.5; end; if (FObjectFromRaise.DrawFigure.InFigures.Count > 0) and (aZoomScale <= 30) then begin adim25 := 1.5; adim4 := 2.5; end; if (FObjectFromRaise.DrawFigure.InFigures.Count > 0) and (aZoomScale <= 20) then begin adim25 := 0.5; adim4 := 2.5; end; end; if (aZoomScale <> 0) then begin adim25 := adim25 * (aZoomScale / 100); adim4 := adim4 * (aZoomScale / 100); end; if RaiseLine.FLineRaiseType = lrt_Up then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; // спуск if RaiseLine.FLineRaiseType = lrt_Down then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; if ActualZOrder[1] = FObjectFromRaise.ActualZOrder[1] then begin if (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_TrunkUp) then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; if (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_TrunkDown) then begin RaiseMinX := BasisPoints.x + adim25; RaiseMinY := BasisPoints.y - adim4; RaiseMaxX := BasisPoints.x + adim4; RaiseMaxY := BasisPoints.y - adim25; end; end; if (x >= RaiseMinX) AND (x <= RaiseMaxX) AND (y >= RaiseMinY) AND (y <= RaiseMaxY) then Result := True; end; end else // ОБЫЧНЫЙ begin // ПУСТОЙ if ConnectorType = ct_Clear then begin adim1 := 2; //1; adim4 := 4; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; if (GCadForm.PCad.ZoomScale >= 500) and (GCadForm.PCad.ZoomScale < 1000) then aZoomScaleCad := GCadForm.PCad.ZoomScale / 2 else if GCadForm.PCad.ZoomScale >= 1000 then aZoomScaleCad := GCadForm.PCad.ZoomScale / 3; end; if aZoomScaleCad > 0 then begin adim1 := adim1 / (aZoomScaleCad / 100); adim4 := adim4 / (aZoomScaleCad / 100); end; if FIsHouseJoined then begin if (x >= ActualPoints[1].x - (GrpSizeX + adim4) / 2) AND (x <= ActualPoints[1].x + (GrpSizeX + adim4) / 2) AND (y >= ActualPoints[1].y - (GrpSizeY + adim4) / 2) AND (y <= ActualPoints[1].y + (GrpSizeY + adim4) / 2) then Result := True; end else begin if (x >= ActualPoints[1].x - (GrpSizeX + adim1) / 2) AND (x <= ActualPoints[1].x + (GrpSizeX + adim1) / 2) AND (y >= ActualPoints[1].y - (GrpSizeY + adim1) / 2) AND (y <= ActualPoints[1].y + (GrpSizeY + adim1) / 2) then Result := True; end; end else // ТОЧЕЧНЫЙ ОБЪЕКТ begin // нет изображения // Tolik -- 11/01/2017 -- // Фигуры отрисовки может и не быть, если пользователь создал компонент, а УГО не задал ... //if DrawFigure.InFigures.Count = 0 then if (DrawFigure = nil) or (DrawFigure.InFigures.Count = 0) then begin if (x >= ActualPoints[1].x - (GrpSizeX + 1) / 2) AND (x <= ActualPoints[1].x + (GrpSizeX + 1) / 2) AND (y >= ActualPoints[1].y - (GrpSizeY + 1) / 2) AND (y <= ActualPoints[1].y + (GrpSizeY + 1) / 2) then Result := True; end else // есть изображение begin //Tolik 09/03/2021 if ByDrawF = -1 then ByDrawF := CheckConnectorUseUGOBounds(Self); if (ByDrawF = biFalse) and ((DrawFigure.InFigures.Count > 1) or (Not EQDP(Self.CenterPoint, DrawFigure.CenterPoint))) then begin // тупо по квадрату независимо от формы УГО. aZoomScale := self.FDrawFigurePercent; adim2 := dim2; if (aZoomScale <> 0) then begin if aZoomScale < 20 then adim2 := 4 else if aZoomScale < 70 then adim2 := 3; adim2 := adim2 * (aZoomScale / 100); if (x >= ActualPoints[1].x - adim2) AND (x <= ActualPoints[1].x + adim2) AND (y >= ActualPoints[1].y - adim2) AND (y <= ActualPoints[1].y + adim2) then Result := True; end else begin { это по форме УГО проверка вхождения} if (x >= DrawFigure.CenterPoint.x - GrpSizeX / 2) AND (x <= DrawFigure.CenterPoint.x + GrpSizeX / 2) AND (y >= DrawFigure.CenterPoint.y - GrpSizeY / 2) AND (y <= DrawFigure.CenterPoint.y + GrpSizeY / 2) then Result := True; end; end else begin { это по форме УГО проверка вхождения} if (x >= DrawFigure.CenterPoint.x - GrpSizeX / 2) AND (x <= DrawFigure.CenterPoint.x + GrpSizeX / 2) AND (y >= DrawFigure.CenterPoint.y - GrpSizeY / 2) AND (y <= DrawFigure.CenterPoint.y + GrpSizeY / 2) then // if IsPointInDrawFigure(x, y) then Result := True; end; end; end; end; //05.04.2011 - Если объект скрыт от прорисовки, значит не даем его выделить мышкой if Not FIsDraw and (ConnectorType = ct_Clear) and Not Selected and (Not(ssShift in GGlobalShiftState)) then Result := false; except on E: Exception do addExceptionToLogEx('TConnectorObject.IsPointIn', E.Message); end; end; function TConnectorObject.IsPointInDrawFigure(x, y: Double): Boolean; var i: Integer; InFigure: TFigure; Points: TDoublePointArr; ptTest: TDoublePoint; MinX, MinY, MaxX, MaxY: double; begin try Result := False; SetLength(Points, 4); ptTest := DoublePoint(x, y); if DrawFigure <> nil then begin for i := 0 to DrawFigure.InFigures.Count - 1 do begin InFigure := TFigure(DrawFigure.InFigures[i]); Points[0].x := round(InFigure.ap1.x); Points[0].y := round(InFigure.ap1.y); Points[1].x := round(InFigure.ap2.x); Points[1].y := round(InFigure.ap2.y); Points[2].x := round(InFigure.ap3.x); Points[2].y := round(InFigure.ap3.y); Points[3].x := round(InFigure.ap4.x); Points[3].y := round(InFigure.ap4.y); Result := PtInPolygon(Points, ptTest); end; if (x >= MinX) and (x <= MaxX) and (y >= MinY) and (y <= MaxY) then Result := True; end; //Tolik SetLength(Points, 0); // except on E: Exception do addExceptionToLogEx('TConnectorObject.IsPointInDrawFigure', E.Message); end; end; Function TConnectorObject.isToRaise: Boolean; var i: Integer; begin Result := False; if FConnRaiseType = crt_None then begin for i := 0 to JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedOrtholinesList[i]).FIsRaiseUpDown then if JoinedConnectorsList.Count > 0 then Result := True; end; end; //Function TConnectorObject.GetSelPoints: TList; Function TConnectorObject.GetSelPoints: TMyList; // Tolik 24/12/2019 -- begin result := selPoints; end; //Получить модификационные точки //procedure TConnectorObject.GetModPoints(ModList: TList); procedure TConnectorObject.GetModPoints(ModList: TMyList); var cp: TDoublePoint; i: integer; // isToRaise: Boolean; MT,MR,MB,ML: TDoublePoint; p1, p2, p3, p4: TDoublePoint; aScaleCad: double; adim1: double; begin try { if FIsApproach then begin if DrawFigure <> nil then begin p1 := DoublePoint(DrawFigure.ap1.x, DrawFigure.ap1.y); p2 := DoublePoint(DrawFigure.ap2.x, DrawFigure.ap2.y); p3 := DoublePoint(DrawFigure.ap3.x, DrawFigure.ap3.y); p4 := DoublePoint(DrawFigure.ap4.x, DrawFigure.ap4.y); end else begin p1 := ActualPoints[1]; p2 := ActualPoints[1]; p3 := ActualPoints[1]; p4 := ActualPoints[1]; end; MT := MPoint(p1, p2); MR := MPoint(p2, p3); MB := MPoint(p3, p4); ML := MPoint(p4, p1); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,p1.x,p1.y,1)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,p2.x,p2.y,3)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,p3.x,p3.y,5)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,p4.x,p4.y,7)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MT.x,MT.y,2)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MR.x,MR.y,4)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MB.x,MB.y,6)); ModList.Add(GCadForm.PCad.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ML.x,ML.y,8)); exit; end; } // Tolik 06/08/2018 -- вынесено отдельной функцией cp := ActualPoints[1]; { isToRaise := false; cp := ActualPoints[1]; if FConnRaiseType = crt_None then begin for i := 0 to JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedOrtholinesList[i]).FIsRaiseUpDown then if JoinedConnectorsList.Count > 0 then isToRaise := True; end; } //Занесение мод.точки обьекта в мод.лист if not isToRaise then begin if ConnectorType <> ct_Clear then begin // Tolik -- 11/04/2017 -- нельзя через GCadForm, так как это не всегда -- владелец фигуры, // НЕЛЬЗЯ ТАК ДЕЛАТЬ!!!!! БУДУТ ТРАБЛЫ ПРИ ЗАКРЫТИИ ПРОЕКТА!!! (* if GCadForm.PCad.Focused then ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptRectPoint, ptRect, clGreen, pointdim + dimp_add, cp.x, cp.y, 0)) else ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptRectPoint, ptRect, $008040 {clGray}, pointdim + dimp_add, cp.x, cp.y, 0)) *) if TPCDrawing(Self.Owner).Focused then ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptRect, clGreen, pointdim + dimp_add, cp.x, cp.y, 0)) else ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptRect, $008040 {clGray}, pointdim + dimp_add, cp.x, cp.y, 0)) end else begin if JoinedConnectorslist.Count = 0 then begin // Tolik -- 11/04/2017 -- нельзя через GCadForm, так как это не всегда -- владелец фигуры, // НЕЛЬЗЯ ТАК ДЕЛАТЬ!!!!! БУДУТ ТРАБЛЫ ПРИ ЗАКРЫТИИ ПРОЕКТА!!! (* if GCadForm.PCad.Focused then ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptRectPoint, ptRect, clGreen, pointdim + dimp_add, cp.x, cp.y, 0)) else ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptRectPoint, ptRect, $008040 {clGray}, pointdim + dimp_add, cp.x, cp.y, 0)); *) if TPCDrawing(Self.Owner).Focused then ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptRect, clGreen, pointdim + dimp_add, cp.x, cp.y, 0)) else ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptRect, $008040 {clGray}, pointdim + dimp_add, cp.x, cp.y, 0)); end else begin // Tolik -- 11/04/2017 -- нельзя через GCadForm, так как это не всегда -- владелец фигуры, // НЕЛЬЗЯ ТАК ДЕЛАТЬ!!!!! БУДУТ ТРАБЛЫ ПРИ ЗАКРЫТИИ ПРОЕКТА!!! (* if GCadForm.PCad.Focused then ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptRectPoint, ptCircle, clRed, pointdim + dimp_add, cp.x, cp.y, 0)) else ModList.Add(GCadForm.PCad.RegisterModPoint(self, ptRectPoint, ptCircle, $008040 {clGray}, pointdim + dimp_add, cp.x, cp.y, 0)); *) if TPCDrawing(Self.Owner).Focused then begin // pointdim всегда 3 // dimp_add 1 //ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptCircle, clRed, pointdim + dimp_add, cp.x, cp.y, 0)); //сделаем чуть большим красный кружочек //ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptCircle, clRed, pointdim + 3, cp.x, cp.y, 0)); //aScaleCad := 1; ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptCircle, clRed, pointdim + 2, cp.x, cp.y, 0)); end else ModList.Add(TPCDrawing(Self.Owner).RegisterModPoint(self, ptRectPoint, ptCircle, $008040 {clGray}, pointdim + dimp_add, cp.x, cp.y, 0)); end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetModPoints', E.Message); end; end; // Tolik -- 13/04/2018 -- переписана...немножко...совсем...старая --ниже закомменчена ... // проблема была в том, что неправильно определен список присоединенных трасс для перемещения коннектора - не учтены подключенные через вертикальныю конструкцию function TConnectorObject.CreateModification: TFigure; var i, j: integer; JoinedCon: TConnectorObject; ClickedX, ClickedY: Double; MovedP: TPoint; MovedZ, MovedX, MovedY: Double; SetCur: TPoint; InFigure: TFigure; vLine1, vLine2: TOrthoLine; PassedList: TList; NextVConn, LineConn: TConnectorObject; JoinedLine : TOrthoLine; Procedure CheckAddJoinedLinesByVerticals(aConn: TConnectorObject); var JoinedLine: TOrthoLine; i, j: Integer; JoinedConn, jConn, NextConn: TConnectorObject; begin NextConn := Nil; if aConn.ConnectorType = ct_Clear then begin for i := 0 to aConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(aConn.JoinedOrthoLinesList[i]); if not JoinedLine.FisRaiseUpDown then if not JoinedLine.FisVertical then begin if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then FJoinedOrthoLinesByVerticals.Add(JoinedLine); JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); if JoinedConn.ID = aConn.ID then JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); if FModConnsOtherSides.IndexOf(JoinedConn) = -1 then FModConnsOtherSides.Add(JoinedConn); if JoinedConn.JoinedConnectorsList.Count > 0 then JoinedConn := TConnectorObject(JoinedConn.JoinedConnectorsList[0]); end; end; for i := 0 to AConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(aConn.JoinedOrthoLinesList[i]); if JoinedLine.FisVertical then if PassedList.IndexOf(JoinedLine) = -1 then begin PassedList.Add(JoinedLine); if JoinedLine.JoinConnector1.ID = aConn.ID then NextConn := TConnectorObject(JoinedLine.JoinConnector2) else if JoinedLine.JoinConnector2.ID = aConn.ID then NextConn := TConnectorObject(JoinedLine.JoinConnector1); break; end end; end else if aConn.ConnectorType = ct_NB then begin for i := 0 to aConn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aConn.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]); if not JoinedLine.FisRaiseUpDown then if not JoinedLine.FisVertical then if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin FJoinedOrthoLinesByVerticals.Add(JoinedLine); JConn := TConnectorObject(JoinedLine.JoinConnector1); if JConn.ID = JoinedConn.ID then JConn := TConnectorObject(JoinedLine.JoinConnector2); if FModConnsOtherSides.IndexOf(JConn) = -1 then FModConnsOtherSides.Add(jConn); if JConn.JoinedConnectorsList.Count > 0 then JConn := TConnectorObject(JConn.JoinedConnectorsList[0]); end; end; end; for i := 0 to aConn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aConn.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]); if JoinedLine.FIsVertical then if PassedList.IndexOf(JoinedLine) = -1 then begin PassedList.Add(JoinedLine); if TConnectorObject(JoinedLine.JoinConnector1).ID = JoinedConn.ID then NextConn := TConnectorObject(JoinedLine.JoinConnector2) else if TConnectorObject(JoinedLine.JoinConnector2).ID = JoinedConn.ID then NextConn := TConnectorObject(JoinedLine.JoinConnector1); break; end; end; if NextConn <> nil then break; end; end; if NextConn <> nil then begin if NextConn.JoinedConnectorsList.Count > 0 then NextConn := TConnectorObject(NextConn.JoinedConnectorsList[0]); CheckAddJoinedLinesByVerticals(NextConn); end; end; begin try if assigned(owner) and assigned(owner.Owner) then begin if TPowerCad(Owner).Selection.Count > 1 then begin for i := 0 to TF_Cad(TPowerCad(Owner).Owner).FSCSFigures.Count - 1 do if TFigure(TF_Cad(TPowerCad(Owner).Owner).FSCSFigures[i]).Selected and (TFigure(TF_Cad(TPowerCad(Owner).Owner).FSCSFigures[i]) <> self ) then TFigure(TF_Cad(TPowerCad(Owner).Owner).FSCSFigures[i]).Deselect; end; end; Result := nil; FModPosOffset.x := 0; FModPosOffset.y := 0; if FModConnsOtherSides <> nil then FreeAndNil(FModConnsOtherSides); // FModConnsOtherSides := GetConnectorsOtherSides(Self); FModConnsOtherSides := TList.Create; MovedZ := 0; Select; if not FIsApproach then begin MovedX := ActualPoints[1].x + 0.5 / (GCadForm.PCad.ZoomScale / 100); MovedY := ActualPoints[1].y + 0.5 / (GCadForm.PCad.ZoomScale / 100); GCadForm.PCad.ConvertXY(MovedX, MovedY, MovedZ); SetCur.X := round(MovedX); SetCur.Y := round(MovedY); ClientToScreen(GCadForm.PCad.Handle, SetCur); SetCursorPos(SetCur.X, SetCur.Y); end; // сохранить лист подключенных фигур // Tolik 16/04/2018 -- херня... //GTempJoinedOrtholinesList := JoinedOrtholinesList; //GTempJoinedConnectorsList := JoinedConnectorsList; if GTempJoinedOrtholinesList = nil then GTempJoinedOrtholinesList := TList.Create else GTempJoinedOrtholinesList.Clear; if GTempJoinedConnectorsList <> nil then GTempJoinedConnectorsList.Clear else GTempJoinedConnectorsList := TList.Create; if GTempJoinedLinesConnectors = nil then GTempJoinedLinesConnectors := TList.Create else GTempJoinedLinesConnectors.Clear; if Self.ConnectorType = ct_Clear then if JoinedOrthoLinesList.Count > 0 then GTempJoinedOrtholinesList.Assign(JoinedOrthoLinesList, LaCopy); if Self.ConnectorType = ct_NB then begin for i := 0 to JoinedConnectorsList.Count - 1 do begin JoinedCon := TConnectorObject(JoinedConnectorsList[i]); if GTempJoinedConnectorsList.IndexOf(JoinedCon) = -1 then GTempJoinedConnectorsList.Add(JoinedCon); for j := 0 to JoinedCon.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedCon.JoinedOrtholinesList[j]); if GTempJoinedOrtholinesList.IndexOf(JoinedLine) = -1 then GTempJoinedOrtholinesList.Add(JoinedLine); if JoinedLine.JoinConnector2.ID = JoinedCon.ID then LineConn := TConnectorObject(JoinedLine.JoinConnector1) else LineConn := TConnectorObject(JoinedLine.JoinConnector2); {if LineConn.JoinedConnectorsList.Count > 0 then LineConn := TConnectorObject(LineConn.JoinedConnectorsList[0]);} if GTempJoinedLinesConnectors.IndexOf(LineConn) = -1 then GTempJoinedLinesConnectors.Add(LineConn); end; end; end // // сохранить конекторы - начальные точки присоединенных линий // Tolik 25/03/2016 -- // GTempJoinedLinesConnectors.Clear; {for i := 0 to JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> Self then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> Self then GTempJoinedLinesConnectors.Add(JoinedCon); end;} else begin for i := 0 to JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon.Id = Self.Id then JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector2); {if JoinedCon.JoinedConnectorsList.Count > 0 then JoinedCon := TConnectorObject(JoinedCon.JoinedConnectorsList[0]);} if GTempJoinedLinesConnectors.IndexOf(JoinedCon) = -1 then GTempJoinedLinesConnectors.Add(JoinedCon); end; end; // Tolik 13/04/2018 -- vLine1 := Nil; vLine2 := Nil; if Self.ConnectorType = ct_Clear then begin for i := 0 to JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(JoinedOrthoLinesList[i]).FIsVertical then begin if vLine1 = nil then vLine1 := TOrthoLine(JoinedOrthoLinesList[i]) else begin vLine2 := TOrthoLine(JoinedOrthoLinesList[i]); break; end; end; end; end else if Self.ConnectorType = ct_Nb then begin for i := 0 to JoinedconnectorsList.Count - 1 do begin Joinedcon := TConnectorObject(JoinedConnectorsList[i]); for j := 0 to Joinedcon.JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(Joinedcon.JoinedOrthoLinesList[j]).FIsVertical then begin if vLine1 = nil then vLine1 := TOrthoLine(Joinedcon.JoinedOrthoLinesList[j]) else begin vLine2 := TOrthoLine(Joinedcon.JoinedOrthoLinesList[j]); break; end; end; end; if vLine2 <> nil then break; end; end; if FJoinedOrthoLinesByVerticals = nil then FJoinedOrthoLinesByVerticals := TList.Create else FJoinedOrthoLinesByVerticals.Clear; if Self.ConnectorType = ct_Nb then begin for i := 0 to JoinedConnectorsList.Count - 1 do begin JoinedCon := TConnectorObject(JoinedConnectorsList[i]); for j := 0 to JoinedCon.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedCon.JoinedOrthoLinesList[j]); if not JoinedLine.FisRaiseUpDown then if not JoinedLine.FisVertical then begin //if GTempJoinedOrtholinesList.IndexOf(JoinedLine) = -1 then if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin FJoinedOrthoLinesByVerticals.Add(JoinedLine); LineConn := TConnectorObject(JoinedLine.JoinConnector1); if LineConn.Id = JoinedCon.Id then LineConn := TConnectorObject(JoinedLine.JoinConnector2); if FModConnsOtherSides.IndexOf(LineConn) = -1 then FModConnsOtherSides.Add(LineConn); if LineConn.JoinedConnectorsList.Count > 0 then LineConn := TConnectorObject(LineConn.JoinedConnectorsList[0]); end; end; end; end; end else if Self.ConnectorType = ct_Clear then begin for i := 0 to JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedOrthoLinesList[i]); if not JoinedLine.FisRaiseUpDown then if not JoinedLine.FisVertical then // if GTempJoinedOrtholinesList.IndexOf(JoinedLine) = -1 then if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin FJoinedOrthoLinesByVerticals.Add(JoinedLine); if JoinedLine.JoinConnector1.ID = Self.ID then JoinedCon := TConnectorObject(JoinedLine.JoinConnector2) else JoinedCon := TConnectorObject(JoinedLine.JoinConnector1); if FModConnsOtherSides.IndexOf(JoinedCon) = -1 then FModConnsOtherSides.Add(JoinedCon); if JoinedCon.JoinedConnectorsList.Count > 0 then JoinedCon := TConnectorObject(JoinedCon.JoinedConnectorsList[0]); end; end; end; JoinedCon := nil; if vLine1 <> nil then begin PassedList := TList.Create; PassedList.Add(vLine1); if self.ConnectorType = ct_Clear then begin if vLine1.JoinConnector1.ID = self.Id then Joinedcon := TConnectorObject(vLine1.JoinConnector2) else if vLine1.JoinConnector2.ID = self.Id then Joinedcon := TConnectorObject(vLine1.JoinConnector1); end else if Self.ConnectorType = ct_Nb then begin if JoinedConnectorsList.IndexOf(TConnectorObject(vLine1.JoinConnector1)) = -1 then Joinedcon := TConnectorObject(vLine1.JoinConnector1) else if JoinedConnectorsList.IndexOf(TConnectorObject(vLine1.JoinConnector2)) = -1 then JoinedCon := TConnectorObject(vLine1.JoinConnector2) end; if JoinedCon <> nil then begin if JoinedCon.JoinedconnectorsList.Count > 0 then JoinedCon := TConnectorObject(JoinedCon.JoinedConnectorsList[0]); CheckAddJoinedLinesByVerticals(JoinedCon); end; if vLine2 <> nil then begin Joinedcon := Nil; PassedList.Add(vLine2); if self.ConnectorType = ct_Clear then begin if vLine2.JoinConnector1.ID = self.Id then Joinedcon := TConnectorObject(vLine2.JoinConnector2) else if vLine2.JoinConnector2.ID = self.Id then Joinedcon := TConnectorObject(vLine2.JoinConnector1); end else if Self.ConnectorType = ct_Nb then begin if JoinedConnectorsList.IndexOf(TConnectorObject(vLine2.JoinConnector1)) = -1 then Joinedcon := TConnectorObject(vLine2.JoinConnector1) else if JoinedConnectorsList.IndexOf(TConnectorObject(vLine2.JoinConnector2)) = -1 then Joinedcon := TConnectorObject(vLine2.JoinConnector2) end; if JoinedCon <> nil then begin if JoinedCon.JoinedconnectorsList.Count > 0 then JoinedCon := TconnectorObject(JoinedCon.JoinedConnectorsList[0]); CheckAddJoinedLinesByVerticals(JoinedCon); end; end; PassedList.free; end; // // Tolik 30/03/2018 { for i := 0 to FModConnsOtherSides.Count - 1 do begin if GTempJoinedLinesConnectors.IndexOf(TConnectorObject(FModConnsOtherSides[i])) = -1 then GTempJoinedLinesConnectors.Add(TConnectorObject(FModConnsOtherSides[i])); end;} // // убрать выделение if JoinedConnectorslist.Count > 0 then begin for i := 0 to JoinedConnectorslist.Count - 1 do if TConnectorObject(JoinedConnectorslist[i]).Selected then TConnectorObject(JoinedConnectorslist[i]).Deselect; end; if (DrawFigure <> nil) And DrawFigure.Selected then DrawFigure.Deselect; Result := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], 0, dsTrace, nil); TConnectorObject(REsult).FIsApproach := FIsApproach; TConnectorObject(REsult).FHouse := FHouse; TConnectorObject(REsult).rMode := rMode; if FIsApproach then begin appdeltax := 0; appdeltay := 0; fMoveByApproach := True; end; GTraceNotMove := True; GNormalNotMove := True; GAddDeltaX := 0; GAddDeltaY := 0; // Задать точки для отрисовки прямоугольника, верхнюю левую и нижнюю правую if GrpSizeX < 1 then begin //TConnectorObject(result).GrpSizeX := GrpSizeX + 3; //TConnectorObject(result).GrpSizeY := GrpSizeY + 3; {BUG_2015_04_14_1} if (GCadForm.PCad.ZoomScale <> 0) then begin TConnectorObject(result).GrpSizeX := GrpSizeX + 3 / (GCadForm.PCad.ZoomScale / 100); TConnectorObject(result).GrpSizeY := GrpSizeY + 3 / (GCadForm.PCad.ZoomScale / 100); end else begin TConnectorObject(result).GrpSizeX := GrpSizeX + 3; TConnectorObject(result).GrpSizeY := GrpSizeY + 3; end; {} //TConnectorObject(result).GrpSizeX := GrpSizeX + 3 * Self.FDrawFigurePercent / 100; //TConnectorObject(result).GrpSizeY := GrpSizeY + 3 * Self.FDrawFigurePercent / 100; end else begin TConnectorObject(result).GrpSizeX := GrpSizeX; TConnectorObject(result).GrpSizeY := GrpSizeY; //TConnectorObject(result).GrpSizeX := GrpSizeX * Self.FDrawFigurePercent / 100; //TConnectorObject(result).GrpSizeY := GrpSizeY * Self.FDrawFigurePercent / 100; end; TConnectorObject(result).FDrawFigure := DrawFigure; TConnectorObject(result).FDrawFigureMoved := True; if EQDP(Self.CenterPoint, DrawFigure.CenterPoint) then TConnectorObject(result).FDrawFigureMoved := False; TConnectorObject(result).FDrawFigurePercent := TConnectorObject(self).FDrawFigurePercent; TConnectorObject(result).FConnectorType := ConnectorType; GIsConnMoved := False; GBeforeDragConnectorPoints := ActualPoints[1]; // DrawFigure ActualPoints if (DrawFigure <> nil) and (DrawFigure.InFigures.Count > 0) then begin InFigure := TFigure(DrawFigure.InFigures[0]); GTempDrawFigureAP[0] := InFigure.ap1; GTempDrawFigureAP[1] := InFigure.ap2; GTempDrawFigureAP[2] := InFigure.ap3; GTempDrawFigureAP[3] := InFigure.ap4; end; GLastConnector := Self; except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateModification', E.Message); end; end; // Срабатывает когда кликаешь на обьект с целью дальнейшего его перемещения (* function TConnectorObject.CreateModification: TFigure; var i: integer; JoinedCon: TConnectorObject; ClickedX, ClickedY: Double; MovedP: TPoint; MovedZ, MovedX, MovedY: Double; SetCur: TPoint; InFigure: TFigure; begin try Result := nil; FModPosOffset.x := 0; FModPosOffset.y := 0; if FModConnsOtherSides <> nil then FreeAndNil(FModConnsOtherSides); FModConnsOtherSides := GetConnectorsOtherSides(Self); MovedZ := 0; Select; if not FIsApproach then begin MovedX := ActualPoints[1].x + 0.5 / (GCadForm.PCad.ZoomScale / 100); MovedY := ActualPoints[1].y + 0.5 / (GCadForm.PCad.ZoomScale / 100); GCadForm.PCad.ConvertXY(MovedX, MovedY, MovedZ); SetCur.X := round(MovedX); SetCur.Y := round(MovedY); ClientToScreen(GCadForm.PCad.Handle, SetCur); SetCursorPos(SetCur.X, SetCur.Y); end; // сохранить лист подключенных фигур GTempJoinedOrtholinesList := JoinedOrtholinesList; GTempJoinedConnectorsList := JoinedConnectorsList; // сохранить конекторы - начальные точки присоединенных линий // Tolik 25/03/2016 -- // GTempJoinedLinesConnectors.Clear; if GTempJoinedLinesConnectors <> nil then GTempJoinedLinesConnectors.Clear else GTempJoinedLinesConnectors := TList.Create; for i := 0 to JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> Self then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> Self then GTempJoinedLinesConnectors.Add(JoinedCon); end; // Tolik 30/03/2018 { for i := 0 to FModConnsOtherSides.Count - 1 do begin if GTempJoinedLinesConnectors.IndexOf(TConnectorObject(FModConnsOtherSides[i])) = -1 then GTempJoinedLinesConnectors.Add(TConnectorObject(FModConnsOtherSides[i])); end;} // // убрать выделение if JoinedConnectorslist.Count > 0 then begin for i := 0 to JoinedConnectorslist.Count - 1 do if TConnectorObject(JoinedConnectorslist[i]).Selected then TConnectorObject(JoinedConnectorslist[i]).Deselect; end; if (DrawFigure <> nil) And DrawFigure.Selected then DrawFigure.Deselect; Result := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], 0, dsTrace, nil); TConnectorObject(REsult).FIsApproach := FIsApproach; TConnectorObject(REsult).FHouse := FHouse; TConnectorObject(REsult).rMode := rMode; if FIsApproach then begin appdeltax := 0; appdeltay := 0; fMoveByApproach := True; end; GTraceNotMove := True; GNormalNotMove := True; GAddDeltaX := 0; GAddDeltaY := 0; // Задать точки для отрисовки прямоугольника, верхнюю левую и нижнюю правую if GrpSizeX < 1 then begin //TConnectorObject(result).GrpSizeX := GrpSizeX + 3; //TConnectorObject(result).GrpSizeY := GrpSizeY + 3; {BUG_2015_04_14_1} if (GCadForm.PCad.ZoomScale <> 0) then begin TConnectorObject(result).GrpSizeX := GrpSizeX + 3 / (GCadForm.PCad.ZoomScale / 100); TConnectorObject(result).GrpSizeY := GrpSizeY + 3 / (GCadForm.PCad.ZoomScale / 100); end else begin TConnectorObject(result).GrpSizeX := GrpSizeX + 3; TConnectorObject(result).GrpSizeY := GrpSizeY + 3; end; {} //TConnectorObject(result).GrpSizeX := GrpSizeX + 3 * Self.FDrawFigurePercent / 100; //TConnectorObject(result).GrpSizeY := GrpSizeY + 3 * Self.FDrawFigurePercent / 100; end else begin TConnectorObject(result).GrpSizeX := GrpSizeX; TConnectorObject(result).GrpSizeY := GrpSizeY; //TConnectorObject(result).GrpSizeX := GrpSizeX * Self.FDrawFigurePercent / 100; //TConnectorObject(result).GrpSizeY := GrpSizeY * Self.FDrawFigurePercent / 100; end; TConnectorObject(result).FDrawFigure := DrawFigure; TConnectorObject(result).FDrawFigureMoved := True; if EQDP(Self.CenterPoint, DrawFigure.CenterPoint) then TConnectorObject(result).FDrawFigureMoved := False; TConnectorObject(result).FDrawFigurePercent := TConnectorObject(self).FDrawFigurePercent; TConnectorObject(result).FConnectorType := ConnectorType; GIsConnMoved := False; GBeforeDragConnectorPoints := ActualPoints[1]; // DrawFigure ActualPoints if (DrawFigure <> nil) and (DrawFigure.InFigures.Count > 0) then begin InFigure := TFigure(DrawFigure.InFigures[0]); GTempDrawFigureAP[0] := InFigure.ap1; GTempDrawFigureAP[1] := InFigure.ap2; GTempDrawFigureAP[2] := InFigure.ap3; GTempDrawFigureAP[3] := InFigure.ap4; end; GLastConnector := Self; except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateModification', E.Message); end; end; *) function TConnectorObject.CreateRotModification: TFigure; var i: integer; JoinedCon: TConnectorObject; ClickedX, ClickedY: Double; MovedP: TPoint; MovedZ, MovedX, MovedY: Double; SetCur: TPoint; InFigure: TFigure; begin try Result := nil; MovedZ := 0; { Select; if not FIsApproach then begin MovedX := ActualPoints[1].x + 0.5 / (GCadForm.PCad.ZoomScale / 100); MovedY := ActualPoints[1].y + 0.5 / (GCadForm.PCad.ZoomScale / 100); GCadForm.PCad.ConvertXY(MovedX, MovedY, MovedZ); SetCur.X := round(MovedX); SetCur.Y := round(MovedY); //ClientToScreen(GCadForm.PCad.Handle, SetCur); //SetCursorPos(SetCur.X, SetCur.Y); end; // сохранить лист подключенных фигур GTempJoinedOrtholinesList := JoinedOrtholinesList; GTempJoinedConnectorsList := JoinedConnectorsList; // сохранить конекторы - начальные точки присоединенных линий GTempJoinedLinesConnectors.Clear; for i := 0 to JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> Self then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> Self then GTempJoinedLinesConnectors.Add(JoinedCon); end; // убрать выделение if JoinedConnectorslist.Count > 0 then begin for i := 0 to JoinedConnectorslist.Count - 1 do if TConnectorObject(JoinedConnectorslist[i]).Selected then TConnectorObject(JoinedConnectorslist[i]).Deselect; end;} if (DrawFigure <> nil) And DrawFigure.Selected then DrawFigure.Deselect; Result := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], 0, dsTrace, nil); TConnectorObject(REsult).FIsRotating := true; TConnectorObject(REsult).FIsApproach := FIsApproach; TConnectorObject(REsult).FHouse := FHouse; TConnectorObject(REsult).rMode := rMode; if FIsApproach then begin appdeltax := 0; appdeltay := 0; fMoveByApproach := True; end; GTraceNotMove := True; GNormalNotMove := True; GAddDeltaX := 0; GAddDeltaY := 0; // Задать точки для отрисовки прямоугольника, верхнюю левую и нижнюю правую if GrpSizeX < 1 then begin TConnectorObject(result).GrpSizeX := GrpSizeX + 3; TConnectorObject(result).GrpSizeY := GrpSizeY + 3; end else begin TConnectorObject(result).GrpSizeX := GrpSizeX; TConnectorObject(result).GrpSizeY := GrpSizeY; end; TConnectorObject(result).FDrawFigure := TFigureGrpMod(DrawFigure.CreateModification); TConnectorObject(result).FConnectorType := ConnectorType; GIsConnMoved := False; {//11.03.2012 GBeforeDragConnectorPoints := ActualPoints[1]; // DrawFigure ActualPoints if (DrawFigure <> nil) and (DrawFigure.InFigures.Count > 0) then begin InFigure := TFigure(DrawFigure.InFigures[0]); GTempDrawFigureAP[0] := InFigure.ap1; GTempDrawFigureAP[1] := InFigure.ap2; GTempDrawFigureAP[2] := InFigure.ap3; GTempDrawFigureAP[3] := InFigure.ap4; end; GLastConnector := Self;} except on E: Exception do AddExceptionToLogExt(ClassName, 'CreateRotModification', E.Message); end; end; // Трейс во время перемещения function TConnectorObject.TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): Boolean; var i: integer; deltax, deltay: double; fulldeltax, fulldeltay: double; pos: TDoublePoint; p1_in: boolean; p2_in: boolean; //23.07.2013 PtMoved: Boolean; Conn1, Conn2: TConnectorObject; op1, op2, CurrPt: TDoublePoint; op: PDoublePoint; adim75: double; aZoomScaleCad: double; begin try if FIsApproach then begin { If MP.SeqNbr in [3,4,5] then begin p1_in := fHouse.IsPointInRegion(x,DrawFigure.ap2.y); p2_in := fHouse.IsPointInRegion(x,DrawFigure.ap3.y); if p1_in and p2_in then begin TConnectorObject(TraceFigure).DrawFigure.ActualPoints[2] := DoublePoint(x, DrawFigure.ap2.y); TConnectorObject(TraceFigure).DrawFigure.ActualPoints[3] := DoublePoint(x, DrawFigure.ap3.y); end; end else if MP.SeqNbr in [1,8,7] then begin p1_in := fHouse.IsPointInRegion(x,DrawFigure.ap1.y); p2_in := fHouse.IsPointInRegion(x,DrawFigure.ap4.y); if p1_in and p2_in then begin TConnectorObject(TraceFigure).DrawFigure.ActualPoints[1] := DoublePoint(x,DrawFigure.ap1.y); TConnectorObject(TraceFigure).DrawFigure.ActualPoints[4] := DoublePoint(x,DrawFigure.ap4.y); end; end; If mp.SeqNbr in [1,2,3] then begin p1_in := fHouse.IsPointInRegion(DrawFigure.ap1.x,y); p2_in := fHouse.IsPointInRegion(DrawFigure.ap2.x,y); if p1_in and p2_in then begin TConnectorObject(TraceFigure).DrawFigure.ActualPoints[1] := DoublePoint(DrawFigure.ap1.x,y); TConnectorObject(TraceFigure).DrawFigure.ActualPoints[2] := DoublePoint(DrawFigure.ap2.x,y); end; end else if mp.SeqNbr in [5,6,7] then begin p1_in := fHouse.IsPointInRegion(DrawFigure.ap3.x,y); p2_in := fHouse.IsPointInRegion(DrawFigure.ap4.x,y); if p1_in and p2_in then begin TConnectorObject(TraceFigure).DrawFigure.ActualPoints[3] := DoublePoint(DrawFigure.ap3.x,y); TConnectorObject(TraceFigure).DrawFigure.ActualPoints[4] := DoublePoint(DrawFigure.ap4.x,y); end; end; } DrawFigure.TraceModification(CadControl, mp, DrawFigure, x, y, Shift); Result := true; exit; end; Result := false; deltax := x - TraceFigure.ActualPoints[1].x; deltay := y - TraceFigure.ActualPoints[1].y; adim75 := 7.5; aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then aZoomScaleCad := GCadForm.PCad.ZoomScale; if aZoomScaleCad > 0 then begin adim75 := adim75 / (aZoomScaleCad / 100); end; if not GMoveByArrow then begin if GCadForm.PCad.SelectedCount = 1 then begin // ОРТОГОНАЛЬНОЕ ПЕРЕМЕЩЕНИЕ if (ssShift in GGlobalShiftState) then begin fulldeltax := x - GBeforeDragConnectorPoints.x; fulldeltay := y - GBeforeDragConnectorPoints.y; if abs(fulldeltax) >= abs(fulldeltay) then begin TraceFigure.ActualPoints[1] := GBeforeDragConnectorPoints; x := TraceFigure.ActualPoints[1].x + fulldeltax; y := TraceFigure.ActualPoints[1].y; end else if abs(fulldeltax) < abs(fulldeltay) then begin TraceFigure.ActualPoints[1] := GBeforeDragConnectorPoints; x := TraceFigure.ActualPoints[1].x; y := TraceFigure.ActualPoints[1].y + fulldeltay; end; end else // C УЧЕТОМ УГЛА if (not GCadForm.PCad.SnapToGrids)and((not GCadForm.PCad.SnapToGuides)or(GCadForm.PCad.Guides.count = 0)) then begin //23.07.2013 FModPosOffset.x := 0; FModPosOffset.y := 0; PtMoved := false; if FModConnsOtherSides.Count = 1 then begin Conn1 := TConnectorObject(FModConnsOtherSides[0]); op1 := Conn1.ActualPoints[1]; if Abs(op1.x - x) <= adim75 then begin FModPosOffset.x := op1.x - x; x := op1.x; PtMoved := true; end; if Abs(op1.y - y) <= adim75 then begin FModPosOffset.y := op1.y - y; y := op1.y; PtMoved := true; end; end else if FModConnsOtherSides.Count = 2 then begin Conn1 := TConnectorObject(FModConnsOtherSides[0]); Conn2 := TConnectorObject(FModConnsOtherSides[1]); op1 := DoublePoint(Conn1.ActualPoints[1].x, Conn2.ActualPoints[1].y); op2 := DoublePoint(Conn2.ActualPoints[1].x, Conn1.ActualPoints[1].y); op := nil; CurrPt := DoublePoint(x,y); if GetLineLength(op1, CurrPt) <= adim75 then op := @op1 else if GetLineLength(op2, CurrPt) <= adim75 then op := @op2; if op <> nil then begin FModPosOffset.x := op^.x - x; FModPosOffset.y := op^.y - y; x := op^.x; y := op^.y; PtMoved := true; end end; if Not PtMoved then begin pos := GetPosWithAngle(GCurrMousePos.x, GCurrMousePos.y, GCadForm.FDefaultTraceStepRotate); x := pos.x; y := pos.y; end; end; // ПОКАЗЫВАТЬ SHADOW if GGlobalShiftState = [] then if not CheckTrunkObject(GLastConnector) then SetConnectedLinesDrawShadow(x, y); end; end; if (deltax <> 0) or (deltay <> 0) then GIsConnMoved := True; if GFigureSnap = nil then GDraggedFigureZOrder := ActualZOrder[1] else begin if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then GDraggedFigureZOrder := TConnectorObject(GFigureSnap).ActualZOrder[1] else if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then GDraggedFigureZOrder := TOrthoLine(GFigureSnap).ActualZOrder[1]; end; TraceFigure.ActualPoints[1] := DoublePoint(x, y); // поиск объектов для привязки в режиме трейса за модпоинт if not (ssAlt in GGlobalShiftState) then begin if not GIsConnMoved then GFigureSnap := Nil else //============ther test===================== begin if FindSnapTimer = nil then CreateSnapTimer(False); if FindSnapTimer <> nil then begin FindSnapTimer.Enabled:=false; FindSnapTimer.Enabled:=true; FindSnapTimer.tag := 1; FDeltaPoint.x:=TraceFigure.ActualPoints[1].x; FDeltaPoint.y:=TraceFigure.ActualPoints[1].y; end; end; // GFigureSnap := TConnectorObject(TraceFigure).FindSnapObject(TraceFigure.ActualPoints[1].x, TraceFigure.ActualPoints[1].y); ther test { ther test if (GPrevFigureSnap <> nil) AND (GPrevFigureSnap <> GFigureSnap) then DrawSnapFigures(GPrevFigureSnap, False); if GFigureSnap <> nil then begin DrawSnapFigures(GFigureSnap, True); GPrevFigureSnap := GFigureSnap; end; } end; Result := true; except on E: Exception do addExceptionToLogEx('TConnectorObject.TraceModification', E.Message); end; end; // Поcле перемещения function TConnectorObject.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): Boolean; var i, j, k: integer; SaveFigureSnap: TFigure; CurrPointObject: TConnectorObject; CheckedBreak: Boolean; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; fulldeltax, fulldeltay: double; pos: TDoublePoint; begin try if FindSnapTimer <> nil then FindSnapTimer.Enabled := false; Result := false; if not GMoveByArrow then begin if GCadForm.PCad.SelectedCount = 1 then begin // ОРТОГОНАЛЬНОЕ ПЕРЕМЕЩЕНИЕ if (ssShift in GGlobalShiftState) then begin fulldeltax := x - GBeforeDragConnectorPoints.x; fulldeltay := y - GBeforeDragConnectorPoints.y; if abs(fulldeltax) >= abs(fulldeltay) then begin y := GBeforeDragConnectorPoints.y; end else if abs(fulldeltax) < abs(fulldeltay) then begin x := GBeforeDragConnectorPoints.x; end; end else // C УЧЕТОМ УГЛА if (not GCadForm.PCad.SnapToGrids)and((not GCadForm.PCad.SnapToGuides)or(GCadForm.PCad.Guides.count = 0)) then begin //23.07.2013 if (FModPosOffset.x <> 0) or (FModPosOffset.y <> 0) then begin x := x + FModPosOffset.x; y := y + FModPosOffset.y; end else begin pos := GetPosWithAngle(GCurrMousePos.x, GCurrMousePos.y, GCadForm.FDefaultTraceStepRotate); x := pos.x; y := pos.y; end; end; end; end; GCadForm.PCad.DeselectAll(2); // ДУБЛИКАТ !!! if ssCtrl in GGlobalShiftState then if (ConnectorType <> ct_Clear) then if GCadForm.PCad.SelectedCount = 0 then begin if FTrunkName = ctsnCrossATS then begin CreateCrossATSDuplicate(x, y); end else if FTrunkName = ctsnDistributionCabinet then begin CreateDistribCabDuplicate(x, y); end else begin CreateDuplicate(x, y); SkipConnectedLinesDrawShadow; end; Exit; end; if GCadForm.FNoMoveConnectedObjects then if (ConnectorType <> ct_clear) and (JoinedConnectorsList.Count > 0) then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes10); Exit; end; if (GCadForm.PCad.SelectedCount > 1) and (GCadForm.FNoMoveConnectedObjects) then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes10); Exit; end; {**************************************************************************} SaveFigureSnap := GFigureSnap; //Tolik 13/09/2016 -- // так неправильно, потому что просто оторвет пустой коннектор от поинта, // если есть поинт, поэтому тут немножко изменим Move(x - ActualPoints[1].x, y - ActualPoints[1].y); { if ((ConnectorType = ct_Nb) or ((connectorType = ct_Clear) and (JoinedConnectorsList.Count = 0))) then Move(x - ActualPoints[1].x, y - ActualPoints[1].y) else if (ConnectorType = ct_Clear) and (JoinedConnectorsList.Count > 0) then TConnectorObject(JoinedConnectorsList[0]).Move(x - TConnectorObject(JoinedConnectorsList[0]).ActualPoints[1].x, y - TConnectorObject(JoinedConnectorsList[0]).ActualPoints[1].y); }// if (not GCadForm.PCad.SnapToGrids)and(not GCadForm.PCad.SnapToGuides) then begin if SaveFigureSnap = nil then if not Self.Deleted then //Толик -- 30/03/2018 -- после мува в результате снапа коннектор может быть уже удален!!! ActualPoints[1] := DoublePoint(x, y); end; Result := true; //Tolik 05/05/2017 -- // if Assigned(TraceFigure) and (not TraceFigure.Deleted) and (GCadForm.PCad.Figures.IndexOf(TraceFigure) <> -1) then // if TraceFigure <> nil then //Tolik 02/04/2018 -- не проверять -- ёбнется на объекте !!! TraceFigure.Deselect; // Tolik -- 30/03/2018 -- после мува в результате снапа коннектор может быть уже удален!!! if not Self.Deleted then begin // оторвать конектор если он за пределами обьекта if ConnectorType = ct_Clear then begin for i := 0 to JoinedConnectorsList.Count - 1 do begin CurrPointObject := TConnectorObject(JoinedConnectorsList[i]); CheckedBreak := CheckByBreakConnector(Self, CurrPointObject); if CheckedBreak then // оторвать конектор UnsnapConnectorFromPointObject(Self, CurrPointObject); end; end; end; // Tolik 16/04/2018 -- //GTempJoinedOrtholinesList := nil; FreeAndNil(GTempJoinedOrtholinesList); //GTempJoinedConnectorsList := nil; FreeAndNil(GTempJoinedConnectorsList); // SkipConnectedLinesDrawShadow; if not Deleted then // Tolik -- 30/03/2018 -- после мува в результате снапа коннектор может быть уже удален!!! Select; FreeAndNil(FModConnsOtherSides); // Tolik 30/11/2015 TPowerCad(Self.Owner).ModPoint := nil; // except on E: Exception do addExceptionToLogEx('TConnectorObject.EndModification', E.Message); end; end; Function TConnectorObject.TraceRotate(CadControl: Pointer;mp:TModPoint;var TraceFigure:TFigure; x,y:Double;Shift: TShiftState):boolean; var a1,a2,a: Double; s: Integer; CurrPos: TPoint; begin if mp.SeqNbr = 5 then begin TraceFigure.RotPoint := DoublePoint(x,y); end else begin a1 := GetRadOfLine(TraceFigure.rotPoint,DoublePoint(mp.CoordX ,mp.CoordY)); a2 := GetRadOfLine(TraceFigure.rotPoint,DoublePoint(x,y)); //Tolik -- 18/10/2017 -- //TraceFigure.Free; FreeAndNil(TraceFigure); // //GetCursorPos(CurrPos); TraceFigure := CreateRotModification; //TConnectorObject(Self).DrawFigure.CreateModification; //CreateRotModification; //SetCursorPos(CurrPos.x, CurrPos.y); TraceFigure.RotPoint := RotPoint; a := a2-a1; s := sign(a); a := abs(a); if abs(a - 0) < (pi/180)*5 then a := 0; if abs(a - pi/2) < (pi/180)*5 then a := pi/2; if abs(a - pi) < (pi/180)*5 then a := pi; if abs(a - 3*(pi/2)) < (pi/180)*5 then a := 3*(pi/2); if abs(a - 2*pi) < (pi/180)*5 then a := 2*pi; //TraceFigure.Rotate(s*a,TraceFigure.RotPoint); TConnectorObject(TraceFigure).RotateByParams(s*a,TraceFigure.RotPoint); end; end; Function TConnectorObject.EndRotate(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure; x,y:Double;Shift: TShiftState):boolean; var a1,a2,a: Double; s: Integer; begin if mp.SeqNbr = 5 then begin RotPoint := TraceFigure.RotPoint; end else begin a1 := GetRadOfLine(rotPoint,DoublePoint(mp.CoordX ,mp.CoordY)); a2 := GetRadOfLine(rotPoint,DoublePoint(x,y)); a := a2-a1; s := sign(a); a := abs(a); if abs(a - 0) < (pi/180)*5 then a := 0; if abs(a - pi/2) < (pi/180)*5 then a := pi/2; if abs(a - 3*(pi/2)) < (pi/180)*5 then a := 3*(pi/2); if abs(a - pi) < (pi/180)*5 then a := pi; if abs(a - 2*pi) < (pi/180)*5 then a := 2*pi; //Rotate(s*a,RotPoint); RotateByParams(s*a,TraceFigure.RotPoint); end; end; procedure TConnectorObject.DrawSnapFigures(FFigure: TFigure; SetSnapStatus: Boolean); // Tolik 26/02/2018 - Function CheckCTNBWithTrace: Boolean; var nb_Conn: TConnectorObject; i: Integer; begin Result := False; if Self.ConnectorType = ct_Clear then // Tolik -- 20/04/2018 -- exit; NB_Conn := Nil; if Self.ConnectorType = ct_NB then Nb_Conn := Self else begin for i := 0 to JoinedConnectorsList.Count - 1 do begin if TConnectorObject(JoinedConnectorsList[i]).ConnectorType = ct_NB then begin NB_Conn := TConnectorObject(JoinedConnectorsList[i]); break; end; end; end; if NB_Conn <> nil then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then if TConnectorObject(FFigure).ConnectorType = ct_NB then Result := True; end; end; // begin try if FFigure <> nil then begin // Tolik -- 26/02/2018 -- отключить подсветку объектов, на которые наезжает коннектор при передвижении // ЕСЛИ Это ct_NB if SetSnapStatus then if CheckFigurebyClassName(Self, cTConnectorObject) then if CheckCTNBWithTrace then exit; // if CheckFigureByClassName(FFigure, cTOrthoLine) then begin TOrthoLine(FFigure).isSnap := SetSnapStatus; // TOrthoLine(FFigure).Draw(GCadForm.PCad.DEngine, False); 08.11.2013 самыков end else if CheckFigureByClassName(FFigure, cTConnectorObject) then begin TConnectorObject(FFigure).isSnap := SetSnapStatus; // TConnectorObject(FFigure).Draw(GCadForm.PCad.DEngine, False);08.11.2013 самыков end else if CheckFigureByClassName(FFigure, cTHouse) then begin THouse(FFigure).isSnap := SetSnapStatus; THouse(FFigure).Draw(GCadForm.PCad.DEngine, False); end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.DrawSnapFigures', E.Message); end; end; function TConnectorObject.FindSnapObject(aFindX, aFindY: Double): TFigure; var XMod, YMod: Double; x, y: Double; i, j: integer; JoinedCon: TConnectorObject; FindFigure: TFigure; isCurrentReal: Boolean; RaiseConn: TConnectorObject; FindFiguresList: TList; ResFinded: TList; begin //GCadForm.mProtocol.Lines.Add(DateTimeToStr(date+time)+': ====FindSnapObject====');//ther test try Result := Nil; //{$IFOPT D+} // OutputDebugString(PChar('TConnectorObject.FindSnapObject')); //{$ENDIF} if DrawStyle = dsTrace then //ЕСЛИ ОБЬЕКТ ПЕРЕМЕЩАЕТСЯ begin ResFinded := TList.Create; FindFigure := Nil; FindFiguresList := TList.Create; // Поиск других обьктов при наведении XMod := aFindX; YMod := aFindY; // Поиск обьекта для соединения try CheckBySCSObjectsNear(XMod, YMod, ResFinded, self); except end; for i := 0 to ResFinded.Count - 1 do begin FindFigure := ResFinded[i]; if FindFigure <> nil then isCurrentReal := CanSnapToFindFigure(FindFigure, FindFiguresList) else isCurrentReal := False; // Занести в список, если есть что заносить if isCurrentReal then begin if FindFiguresList.IndexOf(FindFigure) = -1 then FindFiguresList.Add(FindFigure); end; FindFigure := Nil; end; FindFigure := Nil; // ОПРЕДЕЛИТЬ НАЙДЕННЫЙ ОБЪЕКТ // найти коннектор не пустой for i := 0 to FindFiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTConnectorObject) then begin if TConnectorObject(FindFiguresList[i]).ConnectorType <> ct_Clear then FindFigure := TConnectorObject(FindFiguresList[i]); end; end; // найти коннектор пустой, если нет обьекта if FindFigure = Nil then begin for i := 0 to FindFiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTConnectorObject) then begin FindFigure := TConnectorObject(FindFiguresList[i]); end; end; end; // если коннектор не найден if FindFigure = Nil then begin for i := 0 to FindFiguresList.Count - 1 do begin // найти хотя бы ортолинию if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTOrthoLine) then FindFigure := TOrthoLine(FindFiguresList[i]); end; end; // найти Дом if FindFigure = Nil then begin for i := 0 to FindFiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTHouse) then FindFigure := THouse(FindFiguresList[i]); end; end; Result := FindFigure; if ResFinded <> nil then FreeAndNil(ResFinded); if FindFiguresList <> nil then FreeAndNil(FindFiguresList); end; //КОНЕЦ ЦИКЛА ПРИ ТРЕЙСЕ ОБЬЕКТА except on E: Exception do addExceptionToLogEx('TConnectorObject.FindSnapObject', E.Message); end; (* Result := Nil; if DrawStyle = dsTrace then //ЕСЛИ ОБЬЕКТ ПЕРЕМЕЩАЕТСЯ begin FindFigure := Nil; FindFiguresList := TList.Create; // Поиск других обьктов при наведении XMod := aFindX; YMod := aFindY; // Поиск обьекта для соединения x := -1; //// ЦИКЛ ПОИСКА ОБЬЕКТОВ while x <= 1 do begin y := -1; while y <= 1 do begin isCurrentReal := False; try FindFigure := CheckBySCSObjects(XMod + x, YMod + y, self); except FindFigure := nil; end; if FindFigure <> nil then isCurrentReal := CanSnapToFindFigure(FindFigure, FindFiguresList) else isCurrentReal := False; // Занести в список, если есть что заносить if isCurrentReal then FindFiguresList.Add(FindFigure); y := y + 0.5; FindFigure := Nil; end; x := x + 0.5; end; FindFigure := Nil; // ОПРЕДЕЛИТЬ НАЙДЕННЫЙ ОБЪЕКТ // найти коннектор не пустой for i := 0 to FindFiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTConnectorObject) then begin if TConnectorObject(FindFiguresList[i]).ConnectorType <> ct_Clear then FindFigure := TConnectorObject(FindFiguresList[i]); end; end; // найти коннектор пустой, если нет обьекта if FindFigure = Nil then begin for i := 0 to FindFiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTConnectorObject) then begin FindFigure := TConnectorObject(FindFiguresList[i]); end; end; end; // если коннектор не найден if FindFigure = Nil then begin for i := 0 to FindFiguresList.Count - 1 do begin // найти хотя бы ортолинию if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTOrthoLine) then FindFigure := TOrthoLine(FindFiguresList[i]); end; end; // найти Дом if FindFigure = Nil then begin for i := 0 to FindFiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FindFiguresList[i]), cTHouse) then FindFigure := THouse(FindFiguresList[i]); end; end; Result := FindFigure; if FindFiguresList <> nil then FreeAndNil(FindFiguresList); end; //КОНЕЦ ЦИКЛА ПРИ ТРЕЙСЕ ОБЬЕКТА except on E: Exception do addExceptionToLogEx('TConnectorObject.FindSnapObject', E.Message); end; *) end; // -- Tolik 25/03/2016 -- старая закомменчена -- см. ниже, а здесь немножко переделано совсем function TConnectorObject.CanSnapToFindFigure(aFindedFigure: TFigure; aFindedList: TList): Boolean; var i, j, k: integer; JoinedPOConn: TConnectorObject; JoinedConn: TConnectorObject; NextJoinedConn: TConnectorObject; JoinedLine: TOrthoLine; NextJoinedLine: TOrthoLine; RaiseConn: TConnectorObject; begin try Result := True; // сам объект if aFindedFigure = Self then Result := False; // что этого обьекта еще нет в списке найденных обьектов // Tolik -- 16/03/2017 -- if not CheckNoFigureInList(aFindedFigure, aFindedList) then Result := False; {if (aFindedList <> nil) then begin if (aFindedList.Count = 0) then Result := False else if not CheckNoFigureInList(aFindedFigure, aFindedList) then Result := False; end else Result := False;} // // найденный объект выделен if aFindedFigure.Selected then Result := False; // объект является вершиной с-п if FConnRaiseType <> crt_None then Result := False; // сам объект присоединен к ТО if (ConnectorType = ct_Clear) and ((JoinedConnectorsList.Count > 0) or (GTempJoinedConnectorsList.Count > 0)) then Result := False; if CheckTrunkObject(Self) then Result := False; {**************************************************************************} // Tolik -- 25/03/2016 -- if Result then begin // // НАЙДЕН КОННЕКТОР if CheckFigureByClassName(aFindedFigure, cTConnectorObject) then begin if CheckTrunkObject(TConnectorObject(aFindedFigure)) then Result := False; // при отключенном отображении с-п if not GCadForm.FShowRaise then begin if TConnectorObject(aFindedFigure).FConnRaiseType <> crt_None then Result := False; end; // Оба - ТО // if (ConnectorType <> ct_Clear) and (TConnectorObject(aFindedFigure).ConnectorType <> ct_Clear) then // Result := False; // вершина с-п и объект к нему if Self = TConnectorObject(aFindedFigure).FObjectFromRaise then Result := False; if Self = GetRaiseConn(TConnectorObject(aFindedFigure)) then Result := False; // к соединителю который связующий с ТО if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then if TConnectorObject(aFindedFigure).JoinedConnectorsList.Count > 0 then Result := False; // SELF - СОЕДИНИТЕЛЬ // Tolik -- 25/03/2016 -- //if ConnectorType = ct_Clear then if Result Then begin if ConnectorType = ct_Clear then // begin // основание с-п на основание с-п // if (GetRaiseConn(Self) <> nil) and (GetRaiseConn(TConnectorObject(aFindedFigure)) <> nil) then // Result := False; // что это не коннекторы присоединенные к той же линии (при трейсе) if GTempJoinedOrtholinesList <> nil then begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do if (aFindedFigure = TFigure(TOrthoLine(GTempJoinedOrtholinesList[i]).JoinConnector1)) or (aFindedFigure = TFigure(TOrthoLine(GTempJoinedOrtholinesList[i]).JoinConnector2)) then // Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; end; // Tolik 25/03/2016 -- if Result then begin // aFindedFigure - ТО if TConnectorObject(aFindedFigure).ConnectorType <> ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = aFindedFigure then // Tolik 25/03/2016 -- // Result := False; begin Result := False; break; end; end; // Tolik -- 25/03/2016 -- if not Result then break; // if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = aFindedFigure then // Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; end; // Tolik -- 25/03/2016 -- if Not Result then break; end; end; // Tolik -- 25/03/2016 -- if Result then begin // что это не коннекторы присоединенные к линии через одну (при трейсе) // if GTempJoinedOrtholinesList <> nil then // begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then // Tolik 25/03/2016 // Result := False; begin Result := False; break; end; // if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then // Tolik 25/03/2016 // Result := False; begin Result := False; break; end; // end; end; // Tolik -- 25/03/2016 -- if not Result then break; // if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then // Tolik 25/03/2016 -- begin Result := False; break; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then begin Result := False; break; end; end; end; // Tolik -- 25/03/2016 -- if not Result then break; // end; end; // Tolik -- 25/03/2016 -- if Result then begin // aFindedFigure - ТО if TConnectorObject(aFindedFigure).ConnectorType <> ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector1); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then // Tolik 25/03/2016 -- // Result := False; begin Result := False; break; end; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector2); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then // Tolik -- 25/03/2016 -- // Result := False begin Result := False; break; end; end; end; end; // Tolik 25/03/2016 -- if Not Result then break; if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector1); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then //Tolik 25/03/2016 -- // Result := False; begin Result := False; break; end; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector2); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then // Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; end; end; end; // Tolik -- 25/03/2016 -- if not Result then break; end; end; end; //end; end; end; end; end; end; // Tolik -- 25/03/2016 -- if Result then begin // // SELF - ТО if ConnectorType <> ct_Clear then begin // на найденном объекте - м-э с-п RaiseConn := GetRaiseConn(TConnectorObject(aFindedFigure)); // что это не коннекторы присоединенные к той же линии (при трейсе) if GTempJoinedConnectorsList <> nil then begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedPOConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedPOConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedPOConn.JoinedOrtholinesList[j]); if JoinedPOConn <> JoinedLine.JoinConnector1 then if TConnectorObject(JoinedLine.JoinConnector1) = aFindedFigure then // Tolik 25/03/2016 -- // Result := False; begin Result := False; break; end; if JoinedPOConn <> JoinedLine.JoinConnector2 then if TConnectorObject(JoinedLine.JoinConnector2) = aFindedFigure then //Tolik 25/03/2016 -- // Result := False; begin Result := False; break; end; end; // Tolik -- 25/03/2016 -- if not Result then break; end; end; // что это не коннекторы присоединенные к линии через одну (при трейсе) //Tolik -- 25/03/2016 -- //if GTempJoinedConnectorsList <> nil then if Result then begin // // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedPOConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedPOConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedPOConn.JoinedOrtholinesList[j]); if JoinedPOConn <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for k := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then // Tolik 25/03/2016 -- //Result := False; begin Result := False; break; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then //Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; end; // Tolik 25/03/2016 -- if not Result then break; end; if JoinedPOConn <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for k := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then //Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then //Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; end; end; end; // Tolik 25/03/2016 -- if not Result then break; // end; end; end; end; end; end; end {**************************************************************************} // НАЙДЕНА ОРТОЛИНИЯ else // Tolik -- 25/03/2016 -- // if CheckFigureByClassName(aFindedFigure, cTOrthoLine then if Result then begin // if CheckFigureByClassName(aFindedFigure, cTOrthoLine) then begin if TOrthoLine(aFindedFigure).FConnectingLine then Result := False; // c-п if TOrthoLine(aFindedFigure).FIsRaiseUpDown then Result := False else // линия не горизонтальная if (TOrthoLine(aFindedFigure).ActualZOrder[1] <> TOrthoLine(aFindedFigure).ActualZOrder[2]) and (not TOrthoLine(aFindedFigure).FIsVertical) then beep; //Result := False; // пока отключим эту хрень - а то получается что на наклонные можно только новые цеплять... // Tolik -- 25/03/2016 -- if Result then begin // SELF - СОЕДИНИТЕЛЬ if ConnectorType = ct_Clear then begin // что это не уже привязанные к нему линии (при трейсе) if GTempJoinedOrtholinesList <> nil then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do if aFindedFigure = TFigure(GTempJoinedOrtholinesList[i]) then //Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; // // что это не линия привязанная через 1 линию (при трейсе) //Tolik //if GTempJoinedOrtholinesList <> nil then if Result then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then //Tolik -- 25/03/2016 -- // Resulty := False; begin Result := False; break; end; end; // Tolik 25/03/2016 -- if Not Result Then break; // if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then // Tolik // Result := False; begin Result := False; break; end; // end; // Tolik 25/03/2016 -- if Not Result Then break; // end; end; end; // Tolik -- 25/03/2016 -- if Result then begin if ((TOrthoLine(aFindedFigure).ActualPoints[1].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[1].y = ActualPoints[1].y)) or ((TOrthoLine(aFindedFigure).ActualPoints[2].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[2].y = ActualPoints[1].y)) then Result := False; end; end; // Tolik -- 25/03/2016 -- if Result then begin // SELF - ТО if ConnectorType <> ct_Clear then begin // что это не уже привязанные к нему линии (при трейсе) if GTempJoinedOrtholinesList <> nil then begin for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if aFindedFigure = TFigure(JoinedConn.JoinedOrtholinesList[j]) then // Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; // Tolik -- 25/03/2016 -- if Not Result then break; // end; end; // Tolik -- 25/03/2016 -- if Result then begin // что это не линия привязанная через 1 линию (при трейсе) if GTempJoinedConnectorsList <> nil then begin for k := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedPOConn := TConnectorObject(GTempJoinedConnectorsList[k]); for i := 0 to JoinedPOConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedPOConn.JoinedOrtholinesList[i]); if JoinedPOConn <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then // Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; end; // Tolik -- 25/03/2016 -- if Not Result then break; // if JoinedPOConn <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then // Tolik -- 25/03/2016 -- // Result := False; begin Result := False; break; end; // end; // Tolik -- 25/03/2016 -- if Not Result then break; // end; // Toilk -- 25/03/2016 -- if Not Result then exit; // end; end; end; // Tolik -- 25/03/2016 -- if Result then begin if ((TOrthoLine(aFindedFigure).ActualPoints[1].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[1].y = ActualPoints[1].y)) or ((TOrthoLine(aFindedFigure).ActualPoints[2].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[2].y = ActualPoints[1].y)) then Result := False; end; end; end; end; end; end; end; {**************************************************************************} except on E: Exception do addExceptionToLogEx('TConnectorObject.CanSnapToFindFigure', E.Message); end; end; (*function TConnectorObject.CanSnapToFindFigure(aFindedFigure: TFigure; aFindedList: TList): Boolean; var i, j, k: integer; JoinedPOConn: TConnectorObject; JoinedConn: TConnectorObject; NextJoinedConn: TConnectorObject; JoinedLine: TOrthoLine; NextJoinedLine: TOrthoLine; RaiseConn: TConnectorObject; begin try Result := True; // сам объект if aFindedFigure = Self then Result := False; // что этого обьекта еще нет в списке найденных обьектов if not CheckNoFigureInList(aFindedFigure, aFindedList) then Result := False; // найденный объект выделен if aFindedFigure.Selected then Result := False; // объект является вершиной с-п if FConnRaiseType <> crt_None then Result := False; // сам объект присоединен к ТО if (ConnectorType = ct_Clear) and ((JoinedConnectorsList.Count > 0) or (GTempJoinedConnectorsList.Count > 0)) then Result := False; if CheckTrunkObject(Self) then Result := False; {**************************************************************************} // НАЙДЕН КОННЕКТОР if CheckFigureByClassName(aFindedFigure, cTConnectorObject) then begin if CheckTrunkObject(TConnectorObject(aFindedFigure)) then Result := False; // при отключенном отображении с-п if not GCadForm.FShowRaise then begin if TConnectorObject(aFindedFigure).FConnRaiseType <> crt_None then Result := False; end; // Оба - ТО // if (ConnectorType <> ct_Clear) and (TConnectorObject(aFindedFigure).ConnectorType <> ct_Clear) then // Result := False; // вершина с-п и объект к нему if Self = TConnectorObject(aFindedFigure).FObjectFromRaise then Result := False; if Self = GetRaiseConn(TConnectorObject(aFindedFigure)) then Result := False; // к соединителю который связующий с ТО if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then if TConnectorObject(aFindedFigure).JoinedConnectorsList.Count > 0 then Result := False; // SELF - СОЕДИНИТЕЛЬ if ConnectorType = ct_Clear then begin // основание с-п на основание с-п // if (GetRaiseConn(Self) <> nil) and (GetRaiseConn(TConnectorObject(aFindedFigure)) <> nil) then // Result := False; // что это не коннекторы присоединенные к той же линии (при трейсе) if GTempJoinedOrtholinesList <> nil then begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do if (aFindedFigure = TFigure(TOrthoLine(GTempJoinedOrtholinesList[i]).JoinConnector1)) or (aFindedFigure = TFigure(TOrthoLine(GTempJoinedOrtholinesList[i]).JoinConnector2)) then Result := False; end; // aFindedFigure - ТО if TConnectorObject(aFindedFigure).ConnectorType <> ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = aFindedFigure then Result := False; end; if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = aFindedFigure then Result := False; end; end; end; end; // что это не коннекторы присоединенные к линии через одну (при трейсе) if GTempJoinedOrtholinesList <> nil then begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then Result := False; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then Result := False; end; end; if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then Result := False; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then Result := False; end; end; end; end; // aFindedFigure - ТО if TConnectorObject(aFindedFigure).ConnectorType <> ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector1); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then Result := False; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector2); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then Result := False; end; end; end; if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedConn <> NextJoinedLine.JoinConnector1 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector1); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then Result := False; end; if JoinedConn <> NextJoinedLine.JoinConnector2 then begin NextJoinedConn := TConnectorObject(NextJoinedLine.JoinConnector2); if NextJoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(NextJoinedConn.JoinedConnectorsList[0]) = aFindedFigure then Result := False; end; end; end; end; end; end; end; // SELF - ТО if ConnectorType <> ct_Clear then begin // на найденном объекте - м-э с-п RaiseConn := GetRaiseConn(TConnectorObject(aFindedFigure)); // что это не коннекторы присоединенные к той же линии (при трейсе) if GTempJoinedConnectorsList <> nil then begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedPOConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedPOConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedPOConn.JoinedOrtholinesList[j]); if JoinedPOConn <> JoinedLine.JoinConnector1 then if TConnectorObject(JoinedLine.JoinConnector1) = aFindedFigure then Result := False; if JoinedPOConn <> JoinedLine.JoinConnector2 then if TConnectorObject(JoinedLine.JoinConnector2) = aFindedFigure then Result := False; end; end; end; end; // что это не коннекторы присоединенные к линии через одну (при трейсе) if GTempJoinedConnectorsList <> nil then begin // aFindedFigure - соединитель if TConnectorObject(aFindedFigure).ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedPOConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedPOConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedPOConn.JoinedOrtholinesList[j]); if JoinedPOConn <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for k := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then Result := False; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then Result := False; end; end; if JoinedPOConn <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for k := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin NextJoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]); if JoinedConn <> NextJoinedLine.JoinConnector1 then if NextJoinedLine.JoinConnector1 = aFindedFigure then Result := False; if JoinedConn <> NextJoinedLine.JoinConnector2 then if NextJoinedLine.JoinConnector2 = aFindedFigure then Result := False; end; end; end; end; end; end; end; end {**************************************************************************} // НАЙДЕНА ОРТОЛИНИЯ else if CheckFigureByClassName(aFindedFigure, cTOrthoLine) then begin if TOrthoLine(aFindedFigure).FConnectingLine then Result := False; // c-п if TOrthoLine(aFindedFigure).FIsRaiseUpDown then Result := False else // линия не горизонтальная if (TOrthoLine(aFindedFigure).ActualZOrder[1] <> TOrthoLine(aFindedFigure).ActualZOrder[2]) and (not TOrthoLine(aFindedFigure).FIsVertical) then beep; //Result := False; // пока отключим эту хрень - а то получается что на наклонные можно только новые цеплять... // SELF - СОЕДИНИТЕЛЬ if ConnectorType = ct_Clear then begin // что это не уже привязанные к нему линии (при трейсе) if GTempJoinedOrtholinesList <> nil then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do if aFindedFigure = TFigure(GTempJoinedOrtholinesList[i]) then Result := False; end; // что это не линия привязанная через 1 линию (при трейсе) if GTempJoinedOrtholinesList <> nil then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if Self <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then Result := False; end; if Self <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then Result := False; end; end; end; if ((TOrthoLine(aFindedFigure).ActualPoints[1].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[1].y = ActualPoints[1].y)) or ((TOrthoLine(aFindedFigure).ActualPoints[2].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[2].y = ActualPoints[1].y)) then Result := False; end; // SELF - ТО if ConnectorType <> ct_Clear then begin // что это не уже привязанные к нему линии (при трейсе) if GTempJoinedOrtholinesList <> nil then begin for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if aFindedFigure = TFigure(JoinedConn.JoinedOrtholinesList[j]) then Result := False; end; end; // что это не линия привязанная через 1 линию (при трейсе) if GTempJoinedConnectorsList <> nil then begin for k := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedPOConn := TConnectorObject(GTempJoinedConnectorsList[k]); for i := 0 to JoinedPOConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedPOConn.JoinedOrtholinesList[i]); if JoinedPOConn <> JoinedLine.JoinConnector1 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then Result := False; end; if JoinedPOConn <> JoinedLine.JoinConnector2 then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if JoinedLine <> TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = aFindedFigure then Result := False; end; end; end; end; if ((TOrthoLine(aFindedFigure).ActualPoints[1].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[1].y = ActualPoints[1].y)) or ((TOrthoLine(aFindedFigure).ActualPoints[2].x = ActualPoints[1].x) and (TOrthoLine(aFindedFigure).ActualPoints[2].y = ActualPoints[1].y)) then Result := False; end; end; {**************************************************************************} except on E: Exception do addExceptionToLogEx('TConnectorObject.CanSnapToFindFigure', E.Message); end; end; *) //////////////////////////////////////////////////////////////////////////////// // Срабатывает когда перемещаешь обьект //////////////////////////////////////////////////////////////////////////////// procedure TConnectorObject.Move(deltax, deltay: Double); var i: Integer; Cabinet: TCabinet; pt: TDoublePoint; vLevel: TList; begin // Tolik -- 23/04/2017 -- if deleted then Exit; // // Tolik 07/02/2017 -- vLevel := nil; // try if DrawStyle = mydsNormal then if FIsHouseJoined then begin for i := 0 to FHouse.PointCount - 1 do begin pt := FHouse.ActualPoints[i]; if IsPointIn(pt.x, pt.y) then begin FHouse.ActualPoints[i] := DoublePoint(FHouse.ActualPoints[i].x + deltax, FHouse.ActualPoints[i].y + deltay); break; end; end; end; //Tolik --09/09/2016 vLevel := CheckOtherConnectorsOnLevel(Self, ActualPoints[1].x, ActualPoints[1].y); if (vLevel <> nil) and (vLevel.Count > 0) then //Tolik -- 13/06/2017 -- begin if vLevel.IndexOf(Self) = -1 then vLevel.Add(Self); // Tolik -- 30/03/2018 - //MoveConnector(deltax, deltay, false, false); MoveConnector(deltax, deltay, True, false); // end // else MoveConnector(deltax, deltay); FreeAndNil(vLevel); // Tolik 30/03/2018 -- если при муве произошел снап коннекторов, то текущий коннектор, если снапились, например, // на коннектор райза, будет обязательно удален...так что нех дальше тут ёрзать...во избежание! if Self.Deleted then exit; // DefRaizeDrawFigurePos; // Auto ReAlign if (GCadForm.PCad.SnapToGrids)or(GCadForm.PCad.SnapToGuides) then begin if DrawStyle = mydsNormal then begin if (not GMoveByArrow) and (not FIsApproach) then if FConnRaiseType = crt_None then begin ReAlignObject(Self); end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.Move', E.Message); end; SetProjectChanged(True); // Tolik 19/11/2019 -- end; //Tolik 03/08/2021 -- aCanAlign - чтобы не сбить координаты коннекторов за счет привязок (к объектам, направляющим, сетке и т.п.) //procedure TConnectorObject.MoveP(deltax, deltay: Double; FindSnap: Boolean = true); procedure TConnectorObject.MoveP(deltax: Double; deltay: Double; FindSnap: Boolean = True; aCanAlign: Boolean = True); // var i: Integer; Cabinet: TCabinet; pt: TDoublePoint; vLevel: TList; begin // Tolik 07/02/2017 -- vLevel := nil; // try if DrawStyle = mydsNormal then if FIsHouseJoined then begin for i := 0 to FHouse.PointCount - 1 do begin pt := FHouse.ActualPoints[i]; if IsPointIn(pt.x, pt.y) then begin FHouse.ActualPoints[i] := DoublePoint(FHouse.ActualPoints[i].x + deltax, FHouse.ActualPoints[i].y + deltay); break; end; end; end; //Tolik --09/09/2016 vLevel := CheckOtherConnectorsOnLevel(Self, ActualPoints[1].x, ActualPoints[1].y); if (vLevel <> nil) and (vLevel.Count > 0) then MoveConnector(deltax, deltay, false, false) else MoveConnector(deltax, deltay, findSnap); DefRaizeDrawFigurePos; // Auto ReAlign if aCanAlign then begin if (GCadForm.PCad.SnapToGrids)or(GCadForm.PCad.SnapToGuides) then begin if DrawStyle = mydsNormal then begin if (not GMoveByArrow) and (not FIsApproach) then if FConnRaiseType = crt_None then begin ReAlignObject(Self); end; end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.Move', E.Message); end; // Tolik 07/02/2017 -- if vLevel <> nil then FreeAndNil(vLevel); // end; procedure TConnectorObject.MoveConnector(deltax, deltay: Double; aFindSnap: Boolean = True; aMoveByVertical: Boolean = False; CheckDelta: Boolean = True); var i, j: integer; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; // ListToPassage: TF_CAD; ConnToPassage: TConnectorObject; CurGCadForm: TF_CAD; CurConnToPassageIndex: Integer; fulldeltax, fulldeltay: double; Cabinet: TFigure; pos: TDoublePoint; isMove: Boolean; p1, p2, p3, p4: TDoublePoint; VertList: TList; TempLine: TOrthoLine; // Tolik 21/04/2017 -- LineToMoveList: Tlist; vdeltax, vdeltay: Double; Function GetLineToMoveList: TList; var i: Integer; begin Result := tList.Create; for i := 0 to JoinedOrtholinesList.Count - 1 do begin if ((not TOrthoLine(JoinedOrtholinesList[i]).Deleted) and (Result.IndexOf(TOrthoLine(JoinedOrtholinesList[i])) = -1)) then Result.Add(TOrthoLine(JoinedOrtholinesList[i])); end; end; // begin // Tolik 07/02/2017 -- VertList := nil; // // Tolik 31/03/2021 -- if deltax = 0 then if deltay = 0 then exit; try if (DrawStyle = mydsNormal) then if (FIsHouseJoined) and (not fByHouseMove) and (FHouse.Selected) then exit; if (FIsApproach) and (not fByHouseMove) and (fMoveByApproach) and (not FHouse.Selected) then begin if (DrawStyle = dsTrace) then begin isMove := IsApproachInHouse(deltax, deltay); if isMove then begin appdeltax := appdeltax + deltax; appdeltay := appdeltay + deltay; end else begin exit; end; end else begin fMoveByApproach := false; if not GMoveByArrow then begin deltax := appdeltax; deltay := appdeltay; end else begin isMove := IsApproachInHouse(deltax, deltay); if not isMove then exit; end; end; end; // ************************************************************************* if (deltax <> 0) or (deltay <> 0) then GIsConnMoved := True; // Коррект под автосдвиг под сетку if DrawStyle = dsTrace then begin if GTraceNotMove then begin GTraceNotMove := False; GAddDeltaX := deltax; GAddDeltaY := deltay; Exit; end; end; if DrawStyle = mydsNormal then begin if GNormalNotMove then begin GNormalNotMove := False; deltax := deltax - GAddDeltaX; deltay := deltay - GAddDeltaY; GAddDeltaX := 0; GAddDeltaY := 0; end; // СБРОС ШАДОУ ТРАСС ЕСЛИ ПЕРЕМЕЩЕНИЕ БЫЛО ЧЕРЕЗ СЕБЯ if DrawStyle = mydsNormal then if (not GMovedByLine) {and (GMovedBySelf)} then //Tolik 18/04/2018 -- if not aMoveByVertical then // SkipConnectedLinesDrawShadow; end; // Перемещение по опциям - если заблочено перемещение if GCadForm.FNoMoveConnectedObjects then if (ConnectorType <> ct_clear) and (JoinedConnectorsList.Count > 0) then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes9); Exit; end; if (GCadForm.PCad.SelectedCount > 1) and (GCadForm.FNoMoveConnectedObjects) then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes9); Exit; end; // При скроле КАДа сбросить Шадоу трасс при трейсе if DrawStyle = dsTrace then begin if (deltax <> 0) or (deltay <> 0) then if GCadForm.CheckScrollingOnTracing(ActualPoints[1].x, ActualPoints[1].y) then begin SkipConnectedLinesDrawShadow; end; end; {**************************************************************************} if not GMoveByArrow then begin if GCadForm.PCad.SelectedCount = 1 then begin begin if DrawStyle = dsTrace then begin // ОРТОГОНАЛЬНОЕ ПЕРЕМЕЩЕНИЕ if ssShift in GGlobalShiftState then begin deltax := 0; deltay := 0; fulldeltax := GCurrMousePos.x - GBeforeDragConnectorPoints.x; fulldeltay := GCurrMousePos.y - GBeforeDragConnectorPoints.y; if abs(fulldeltax) >= abs(fulldeltay) then begin // IGOR 05.11.2013 - Пока закоментил - в самом конце процедуры они выставляются еще раз // если оставить и здесь - при большом количестве объектов дергается трейс квадратик // возможно какие то другие перемещения поламаются... // НЕЛЬЗЯ ПОКА КОММЕНТИТЬ - сбивается ортогональность и учет углов, возможно как то по иному обойти это получится ActualPoints[1] := GBeforeDragConnectorPoints; deltax := fulldeltax; deltay := 0; end else if abs(fulldeltax) < abs(fulldeltay) then begin // IGOR 05.11.2013 - Пока закоментил - в самом конце процедуры они выставляются еще раз // если оставить и здесь - при большом количестве объектов дергается трейс квадратик // возможно какие то другие перемещения поламаются... // НЕЛЬЗЯ ПОКА КОММЕНТИТЬ - сбивается ортогональность и учет углов, возможно как то по иному обойти это получится ActualPoints[1] := GBeforeDragConnectorPoints; deltay := fulldeltay; deltax := 0; end; end else // C УЧЕТОМ УГЛА БЕЗ ПРИВЯЗКИ К СЕТКЕ if (not GCadForm.PCad.SnapToGrids)and ((not GCadForm.PCad.SnapToGuides)or(GCadForm.PCad.Guides.count = 0)) and (not GMovedByLine) then begin pos := GetPosWithAngle(GCurrMousePos.x, GCurrMousePos.y, GCadForm.FDefaultTraceStepRotate); // IGOR 05.11.2013 - Пока закоментил - в самом конце процедуры они выставляются еще раз // если оставить и здесь - при большом количестве объектов дергается трейс квадратик // возможно какие то другие перемещения поламаются... // НЕЛЬЗЯ ПОКА КОММЕНТИТЬ - сбивается ортогональность и учет углов, возможно как то по иному обойти это получится ActualPoints[1] := pos; end; // РИСОВАТЬ SHADOW ЛИНИИ if (not GMovedByLine) then begin if GGlobalShiftState = [] then if not CheckTrunkObject(GLastConnector) then SetConnectedLinesDrawShadow(ActualPoints[1].x, ActualPoints[1].y); end; GMovedBySelf := True; end; if DrawStyle = mydsNormal then begin // ОРТОГОНАЛЬНОЕ ПЕРЕМЕЩЕНИЕ if (ssShift in GGlobalShiftState) and (not GMovedByLine) then begin if abs(deltax) >= abs(deltay) then deltay := 0 else if abs(deltax) < abs(deltay) then deltax := 0; end else // C УЧЕТОМ УГЛА БЕЗ ПРИВЯЗКИ К СЕТКЕ if (not GCadForm.PCad.SnapToGrids)and((GCadForm.PCad.Guides.count = 0)or (not GCadForm.PCad.SnapToGuides)) and (not GMovedByLine) and (not GMovedByOtherObject) and (GMovedBySelf) then begin pos := GetPosWithAngle(GCurrMousePos.x, GCurrMousePos.y, GCadForm.FDefaultTraceStepRotate); deltax := pos.x - GBeforeDragConnectorPoints.x; deltay := pos.y - GBeforeDragConnectorPoints.y; end; GMovedBySelf := False; end; end; end; // ДУБЛИКАТ !!! if (DrawStyle = mydsNormal) and (ssCtrl in GGlobalShiftState) and (not GMoveByArrow) then begin if (ConnectorType <> ct_Clear) then begin if GCadForm.PCad.SelectedCount = 1 then begin if not FIsApproach then begin if FTrunkName = ctsnCrossATS then CreateCrossATSDuplicate(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay) else if FTrunkName = ctsnDistributionCabinet then CreateDistribCabDuplicate(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay) else CreateDuplicate(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); end; Exit; end; end; end; end; // Tolik 20/04/2017 -- это пока просто "КОСТЫЛЬ", есть большая необходимость обнаружить, где // ПОЛУЧАЕТСЯ РАСХОЖДЕНИЕ МЕЖДУ КООРДИНАТАМИ ОРТОЛИНИИ И ЕЕ КОННЕКТОРОВ !!! if not aMoveByVertical then VertList := CheckOtherConnectorsOnLevel(Self, ActualPoints[1].x, ActualPoints[1].y); ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); LineToMoveList := GetLineToMoveList; for i := 0 to LineToMoveList.Count - 1 do begin TempLine := TOrthoLine(LineToMoveList[i]); if Self.ID = TempLine.JoinConnector1.ID then ReMoveJoinedOrthoLines(TempLine, ActualPoints[1].x - TempLine.ActualPoints[1].x, ActualPoints[1].y - TempLine.ActualPoints[1].y, CheckDelta) else if Self.Id = TempLine.JoinConnector2.ID then ReMoveJoinedOrthoLines(TempLine, ActualPoints[1].x - TempLine.ActualPoints[2].x, ActualPoints[1].y - TempLine.ActualPoints[2].y, CheckDelta) end; LineToMoveList.free; { for i := 0 to JoinedOrtholinesList.Count - 1 do begin TempLine := TOrthoLine(JoinedOrtholinesList[i]); if Self.ID = TempLine.JoinConnector1.ID then ReMoveJoinedOrthoLines(TOrthoLine(JoinedOrtholinesList[i]), ActualPoints[1].x - TempLine.ActualPoints[1].x, ActualPoints[1].y - TempLine.ActualPoints[1].y, CheckDelta) else if Self.Id = TempLine.JoinConnector2.ID then ReMoveJoinedOrthoLines(TOrthoLine(JoinedOrtholinesList[i]), ActualPoints[1].x - TempLine.ActualPoints[2].x, ActualPoints[1].y - TempLine.ActualPoints[2].y, CheckDelta) end; } { for i := 0 to JoinedOrtholinesList.Count - 1 do ReMoveJoinedOrthoLines(TOrthoLine(JoinedOrtholinesList[i]), deltax, deltay, CheckDelta); if not aMoveByVertical then VertList := CheckOtherConnectorsOnLevel(Self, ActualPoints[1].x, ActualPoints[1].y); ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); } if DrawStyle = mydsNormal then if DrawFigure <> nil then if Not DrawFigure.Selected then DrawFigure.move(deltax, deltay); if CaptionsGroup <> nil then if Not CaptionsGroup.Selected then CaptionsGroup.Move(deltax, deltay); if NotesGroup <> nil then if Not NotesGroup.Selected then NotesGroup.Move(deltax, deltay); // передвинуть пустые конекторы привязанные к обьекту if ConnectorType <> ct_Clear then begin GMovedByOtherObject := True; for i := 0 to JoinedConnectorsList.Count - 1 do begin //13/09/2016 -- Tolik if (not TConnectorObject(JoinedConnectorsList[i]).Selected) and (not GDisableMove) then TConnectorObject(JoinedConnectorsList[i]).MoveConnector(deltax, deltay, False, true) else if TConnectorObject(JoinedConnectorsList[i]).LockMove then TConnectorObject(JoinedConnectorsList[i]).MoveConnector(deltax, deltay, False, true); {if (not TConnectorObject(JoinedConnectorsList[i]).Selected) and (not GDisableMove) then TConnectorObject(JoinedConnectorsList[i]).MoveConnector(deltax, deltay, False) else if TConnectorObject(JoinedConnectorsList[i]).LockMove then TConnectorObject(JoinedConnectorsList[i]).MoveConnector(deltax, deltay, False)} end; GMovedByOtherObject := False; end; {*********************************************} // передвигать вместе с с-п if GMoveWithRaise then begin MoveRaiseConnector(deltax, deltay); MoveBetweenRaiseConnector(deltax, deltay); end; {*********************************************} // if not GMoveByArrow then begin if aFindSnap then begin if DrawStyle = dsTrace then begin if FindSnapTimer = nil then CreateSnapTimer; if FindSnapTimer <> nil then begin FindSnapTimer.Tag := 0; FindSnapTimer.Enabled := false; FindSnapTimer.Enabled := true; FDeltaPoint.x := deltax; FDeltaPoint.y := deltay; end; end else begin if (not GMovedByLine) and (GCadForm.PCad.SelectedCount <= 1) then if Not GCadForm.TimerFindSnap.Enabled then begin if FindSnapTimer <> nil then FindSnapTimer.Enabled := false; //GCadForm.mProtocol.Lines.Add(DateTimeToStr(date+time)+': ==MoveConnector=='); //ther test FindObjectsOnMove(deltax, deltay); GCadForm.TimerFindSnap.Enabled := true; end; end; // } end; // ПОИСК ОБЪЕКТОВ НА ОБРАБОТЧИКЕ !!! // при нажатом Альте убрать предыдущие выделенные объекты if (ssAlt in GGlobalShiftState) then begin if GPrevFigureSnap <> nil then begin DrawSnapFigures(GPrevFigureSnap, False); GPrevFigureSnap := nil; end; end; end; // Tolik 30/09/2018 -- if Self.Deleted then exit; // // Z вывести на панель if DrawStyle = dsTrace then begin if GFigureSnap = nil then GDraggedFigureZOrder := ActualZOrder[1] else begin if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then GDraggedFigureZOrder := TConnectorObject(GFigureSnap).ActualZOrder[1] else if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then GDraggedFigureZOrder := TOrthoLine(GFigureSnap).ActualZOrder[1]; end; end; if DrawStyle = mydsNormal then GDraggedFigureZOrder := -1; // КАБИНЕТ if DrawStyle = mydsNormal then begin Cabinet := GetCabinetAtPos(ActualPoints[1].x, ActualPoints[1].y, False, self); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then begin if TCabinet(Cabinet).FSCSID <> FCabinetID then begin FCabinetID := TCabinet(Cabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, ID, FCabinetID); end; end else if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin if TCabinetExt(Cabinet).FSCSID <> FCabinetID then begin FCabinetID := TCabinetExt(Cabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, ID, FCabinetID); end; end; end; end; if CheckTrunkObject(Self) then begin AfterMoveTrunkObject(Self, deltax, deltay); end; if not aMoveByVertical then if VertList <> nil then begin for i := 0 to VertList.Count - 1 do begin if not TConnectorObject(VertList[i]).Selected then begin vdeltax := Self.AP1.x - TConnectorObject(VertList[i]).Ap1.x; vdeltay := Self.AP1.y - TConnectorObject(VertList[i]).Ap1.y; if ((vDeltax <> 0) or (vDeltay <> 0)) then TConnectorObject(VertList[i]).MoveConnector(vdeltax, vdeltay, false, true); end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.MoveConnector', E.Message); end; // Tolik -- 07/02/2017 -- if VertList <> nil then FreeAndNil(VertList); end; procedure TConnectorObject.MoveRaiseConnector(deltax, deltay: Double); var RaiseConn, ObjFromRaise: TConnectorObject; begin try if (ConnectorType <> ct_Clear) or (JoinedConnectorsList.Count = 0) then begin GMoveWithRaise := False; GMovedByOtherObject := True; // получить с-п RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin if (not RaiseConn.Selected) and (not GDisableMove) then RaiseConn.MoveConnector(deltax, deltay, False) else if RaiseConn.LockMove then RaiseConn.MoveConnector(deltax, deltay, False); end; // получить ТО под с-п ObjFromRaise := FObjectFromRaise; if ObjFromRaise <> nil then if (not ObjFromRaise.Selected) and (not GDisableMove) then ObjFromRaise.MoveConnector(deltax, deltay, False) else if ObjFromRaise.LockMove then ObjFromRaise.MoveConnector(deltax, deltay, False); GMoveWithRaise := True; GMovedByOtherObject := False; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.MoveRaiseConnector', E.Message); end; end; procedure TConnectorObject.MoveBetweenRaiseConnector(deltax, deltay: Double); var RaiseConn, ObjFromRaise: TConnectorObject; ListToPassage, CurGCadForm: TF_CAD; ConnToPassage: TConnectorObject; CurConnToPassageIndex: Integer; OldPoints, NewPoints: TDoublePoint; begin try // передвинуть м-э с-п RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin GMovedByOtherObject := True; if RaiseConn.FID_ConnToPassage <> -1 then begin // получить коэффициент перемещения по Shift // переместить только себя и записать коэффициент if (ssShift in GGlobalShiftState) and not (ssCtrl in GGlobalShiftState) then begin NewPoints := ActualPoints[1]; OldPoints := DoublePoint(ActualPoints[1].x - deltax, ActualPoints[1].y - deltay); if OldPoints.x < 1 then OldPoints.x := 1; if OldPoints.y < 1 then OldPoints.y := 1; FRaiseShiftX := FRaiseShiftX * (NewPoints.x / OldPoints.x); FRaiseShiftY := FRaiseShiftY * (NewPoints.y / OldPoints.y); end else // переместить себя, а объект на другом этаже переместить с учетом // его коэффициента перемещения масштаба begin ListToPassage := GetListOfPassage(RaiseConn.FID_ListToPassage); ConnToPassage := TConnectorObject(GetFigureByID(ListToPassage, RaiseConn.FID_ConnToPassage)); if ConnToPassage <> nil then begin ObjFromRaise := ConnToPassage.FObjectFromRaise; if ObjFromRaise <> nil then begin CurGCadForm := GCadForm; GCadForm := ListToPassage; CurConnToPassageIndex := ConnToPassage.FID_ConnToPassage; ConnToPassage.FID_ConnToPassage := -1; // просто перемещение без учета коэффициента if (ssShift in GGlobalShiftState) and (ssCtrl in GGlobalShiftState) then ObjFromRaise.MoveConnector(deltax, deltay) else // перемещение с учетом коэффициента ObjFromRaise.MoveConnector(deltax * ObjFromRaise.FRaiseShiftX, deltay * ObjFromRaise.FRaiseShiftY, False); ConnToPassage.FID_ConnToPassage := CurConnToPassageIndex; GCadForm := CurGCadForm; end; end; end; end; GMovedByOtherObject := False; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.MoveBetweenRaiseConnector', E.Message); end; end; procedure TConnectorObject.FindObjectsOnMove(deltax, deltay: Double); var i: integer; FiguresList: TList; Item: TMenuItem; FFigure: TFigure; Point: TPoint; FHeightStr: string; X, Y: double; // Tolik -- 07/04/2017 -- SnapFigureBound: TDoubleRect; POINTS: TDoublePointArr; dim1: Double; CanSnap: Boolean; begin // Tolik 19/04/2018 -- { if Self.ID = -1 then exit;} FFindSnapEnable := False; try if FIsApproach then exit; // // Tolik -- 10/04/2017 -- dim1 := 0.6; FiguresList := Nil; // if not (ssAlt in GGlobalShiftState) then begin // Вызов процедуры поиска обьектов if (DrawStyle = dsTrace) then begin if not GIsConnMoved then GFigureSnap := Nil else GFigureSnap := FindSnapObject(ActualPoints[1].x, ActualPoints[1].y); if (GPrevFigureSnap <> nil) AND (GPrevFigureSnap <> GFigureSnap) then DrawSnapFigures(GPrevFigureSnap, False); if GFigureSnap <> nil then begin DrawSnapFigures(GFigureSnap, True); GPrevFigureSnap := GFigureSnap; end; if isSnap then isSnap := False; end; if DrawStyle = mydsNormal then begin if (GFigureSnap <> nil) then begin // Tolik -- 07/04/2017 -- проверить, рядом ли фигура с коннектором -- НЕ ТРОГАТЬ!!! // проверка написана во избежание снапа коннектора, который двигается в данный момент // (особенно критично при автоматических операциях), если есть снапфигура, а коннектор фиг // знает где от нее --- то чтобы он к ней не приконнекчивался -- а то были случаи.... // Tolik 13/06/2017 -- if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then // begin // Tolik 08/11/2017 -- //SnapFigureBound := GFigureSnap.GetBoundRect; // SetLength(points, 4); {POINTS[0].x := SnapFigureBound.Left - dim1 ; POINTS[0].y := SnapFigureBound.Top - dim1; POINTS[1].x := SnapFigureBound.Right + dim1 ; POINTS[1].y := SnapFigureBound.Top - dim1; POINTS[2].x := SnapFigureBound.Right + dim1; POINTS[2].y := SnapFigureBound.Bottom + dim1; POINTS[3].x := SnapFigureBound.Left - dim1; POINTS[3].y := SnapFigureBound.Bottom + dim1;} POINTS[0].x := TConnectorObject(GFigureSnap).RedRect[1].x; POINTS[0].y := TConnectorObject(GFigureSnap).RedRect[1].y; POINTS[1].x := TConnectorObject(GFigureSnap).RedRect[2].x; POINTS[1].y := TConnectorObject(GFigureSnap).RedRect[1].y; POINTS[2].x := TConnectorObject(GFigureSnap).RedRect[2].x; POINTS[2].y := TConnectorObject(GFigureSnap).RedRect[2].y; POINTS[3].x := TConnectorObject(GFigureSnap).RedRect[1].x; POINTS[3].y := TConnectorObject(GFigureSnap).RedRect[2].y; // if not PtInPolygon(points, DoublePoint(ActualPoints[1].x, ActualPoints[1].y)) then begin SetLength(Points, 0); if GPrevFigureSnap <> nil then DrawSnapFigures(GPrevFigureSnap, False); if GFigureSnap <> nil then DrawSnapFigures(GFigureSnap, False); // Tolik 08/11/2017 -- {GFigureSnap := Nil; GPrevFigureSnap := Nil;} if GFigureSnap <> nil then begin if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then TConnectorObject(GFigureSnap).isSnap := False else if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then TOrthoLine(GFigureSnap).isSnap := False else THouse(GFigureSnap).isSnap := False; GFigureSnap := nil; end; if GPrevFigureSnap <> nil then begin if CheckFigureByClassName(GPrevFigureSnap, cTConnectorObject) then TConnectorObject(GPrevFigureSnap).isSnap := False else if CheckFigureByClassName(GPrevFigureSnap, cTOrthoLine) then TOrthoLine(GPrevFigureSnap).isSnap := False else THouse(GPrevFigureSnap).isSnap := False; GPrevFigureSnap := nil; end; FFindSnapEnable := True; // SetLength(Points, 0); // Toik 18/05/2018 -- exit; end; SetLength(Points, 0); end; // // ******************************************************************* // if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then X := TConnectorObject(GFigureSnap).ActualPoints[1].x; Y := TConnectorObject(GFigureSnap).ActualPoints[1].y; if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin FiguresList := GetObjectsByVertical(Self, TConnectorObject(GFigureSnap)); end else begin if CheckFigureByClassName(GFigureSnap, cTOrthoLine) and (TOrthoLine(GFigureSnap).FIsVertical) then FiguresList := GetObjectsByVertical(Self, TConnectorObject(GFigureSnap)) else begin FiguresList := TList.Create; FiguresList.Add(GFigureSnap); end; end; // формировать список объектов if (FiguresList <> nil) and (FiguresList.Count > 1) then begin GFigureSnap := nil; GetCursorPos(Point); FSCS_Main.pmFiguresByLevel.Items.Clear; for i := 0 to FiguresList.Count - 1 do begin FFigure := TFigure(FiguresList[i]); Item := TMenuItem.Create(FSCS_Main.pmFiguresByLevel); FHeightStr := ''; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if TOrthoLine(FFigure).ActualZOrder[1] = TOrthoLine(FFigure).ActualZOrder[2] then FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) else FHeightStr := FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[1])) + '-' + FormatFloat(ffMask, MetreToUOM(TOrthoLine(FFigure).ActualZOrder[2])); end else if CheckFigureByClassName(FFigure, cTConnectorObject) then FHeightStr := FormatFloat(ffMask, MetreToUOM(TConnectorObject(FFigure).ActualZOrder[1])); Item.Caption := GetFullFigureName(FFigure) + ' (' + FHeightStr + GetUOMString(GCurrProjUnitOfMeasure) + ')'; FSCS_Main.pmFiguresByLevel.Items.Add(Item); Item.Tag := FFigure.ID; Item.OnClick := GCadForm.SnapFigureEvent; end; FSCS_Main.pmFiguresByLevel.Popup(Point.X, Point.Y); if FiguresList <> nil then FreeAndNil(FiguresList); //Tolik -- 19/04/2018 if GFigureSnap <> nil then begin if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then TConnectorObject(GFigureSnap).isSnap := False else if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then TOrthoLine(GFigureSnap).isSnap := False else THouse(GFigureSnap).isSnap := False; GFigureSnap := nil; end; if GPrevFigureSnap <> nil then begin if CheckFigureByClassName(GPrevFigureSnap, cTConnectorObject) then TConnectorObject(GPrevFigureSnap).isSnap := False else if CheckFigureByClassName(GPrevFigureSnap, cTOrthoLine) then TOrthoLine(GPrevFigureSnap).isSnap := False else THouse(GPrevFigureSnap).isSnap := False; GPrevFigureSnap := nil; end; GCadForm.PCad.Refresh; FFindSnapEnable := True; exit; end; if FiguresList <> nil then FreeAndNil(FiguresList); // ******************************************************************* // Tolik 22/03/2018 -- CanSnap := True; if (GetRaiseConn(Self) <> nil) then begin begin if not GUseVerticalTraces then begin GCadForm.mProtocol.Lines.Add(cCadClasses_Mes11 + cCadClasses_Mes11_1); CanSnap := False; end; end; end; if CanSnap then begin if not CheckTrunkObject(Self) then begin if not FIsApproach then begin //// To Connector ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin if (ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) then CheckingSnapConnectorToConnector(Self, TConnectorObject(GFigureSnap)) else if (ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType <> ct_Clear) then CheckingSnapConnectorToPointObject(Self, TConnectorObject(GFigureSnap), True) else if (ConnectorType <> ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) then CheckingSnapPointObjectToConnector(Self, TConnectorObject(GFigureSnap)); end else //// To Ortholine ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin if ConnectorType = ct_Clear then begin CheckingSnapConnectorToOrtholine(Self, TOrthoLine(GFigureSnap)); end else begin CheckingSnapPointObjectToOrthoLine(Self, TOrthoLine(GFigureSnap)); end; end else //// To Ortholine ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTHouse) then begin if ConnectorType = ct_Clear then SnapConnectorToHouse(Self, THouse(GFigureSnap)) end; end; end; end; { if (GetRaiseConn(Self) = nil) then begin if not CheckTrunkObject(Self) then begin if not FIsApproach then begin //// To Connector ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTConnectorObject) then begin if (ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) then CheckingSnapConnectorToConnector(Self, TConnectorObject(GFigureSnap)) else if (ConnectorType = ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType <> ct_Clear) then CheckingSnapConnectorToPointObject(Self, TConnectorObject(GFigureSnap), True) else if (ConnectorType <> ct_Clear) and (TConnectorObject(GFigureSnap).ConnectorType = ct_Clear) then CheckingSnapPointObjectToConnector(Self, TConnectorObject(GFigureSnap)); end else //// To Ortholine ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTOrthoLine) then begin if ConnectorType = ct_Clear then begin CheckingSnapConnectorToOrtholine(Self, TOrthoLine(GFigureSnap)); end else begin CheckingSnapPointObjectToOrthoLine(Self, TOrthoLine(GFigureSnap)); end; end else //// To Ortholine ////////////////////////// if CheckFigureByClassName(GFigureSnap, cTHouse) then begin if ConnectorType = ct_Clear then SnapConnectorToHouse(Self, THouse(GFigureSnap)) end; end; end; end else if GetRaiseConn(Self) <> nil then GCadForm.mProtocol.Lines.Add(cCadClasses_Mes11); } if GPrevFigureSnap <> nil then DrawSnapFigures(GPrevFigureSnap, False); GFigureSnap := Nil; GPrevFigureSnap := Nil; end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.FindObjectsOnMove', E.Message); end; FFindSnapEnable := True; end; procedure TConnectorObject.ReMoveJoinedOrthoLines(AJoinedLine: TOrthoLine; deltax, deltay: Double; CheckDelta: boolean = True); var OldAP1, OldAP2: TDoublePoint; NewAP1, NewAP2: TDoublePoint; mydeltax, mydeltay: Double; CP: TDoublePoint; x1, y1, z1, x2, y2, z2: double; GetPointObject: TConnectorObject; ResPoints: TDoublePoint; Cabinet: TFigure; Bnd: TDoubleRect; DrawFigureCP: TDoublePoint; // Tolik -- 27//11/2015 // CanX, CanY : Boolean; Captions: TRichTextMod; begin try if (AJoinedLine = nil) or (not OrtholineDetect(AJoinedLine)) then exit; OldAP1 := AJoinedLine.ActualPoints[1]; OldAP2 := AJoinedLine.ActualPoints[2]; // Tolik -- 21/04/2017 -- если нужно поменять координаты концов присоединенных трасс, то их // координаты должны соответствовать концевику(коннектору) { if Self = AJoinedLine.JoinConnector1 then begin AJoinedLine.ActualPoints[1] := DoublePoint(AJoinedLine.ActualPoints[1].x + deltax, AJoinedLine.ActualPoints[1].y + deltay); AJoinedLine.ActualZOrder[1] := ActualZOrder[1]; end; if Self = AJoinedLine.JoinConnector2 then begin AJoinedLine.ActualPoints[2] := DoublePoint(AJoinedLine.ActualPoints[2].x + deltax, AJoinedLine.ActualPoints[2].y + deltay); AJoinedLine.ActualZOrder[2] := ActualZOrder[1]; end; } if Self = AJoinedLine.JoinConnector1 then begin AJoinedLine.ActualPoints[1] := DoublePoint(ActualPoints[1].x, ActualPoints[1].y); AJoinedLine.ActualZOrder[1] := ActualZOrder[1]; end; if Self = AJoinedLine.JoinConnector2 then begin AJoinedLine.ActualPoints[2] := DoublePoint(ActualPoints[1].x, ActualPoints[1].y); AJoinedLine.ActualZOrder[2] := ActualZOrder[1]; end; // AJoinedLine.CalculLength := AJoinedLine.LengthCalc; AJoinedLine.LineLength := AJoinedLine.CalculLength; // RECALC IN PM !!! if Not AJoinedLine.FIsRaiseUpDown then begin if Not AJoinedLine.Selected then if Not AJoinedLine.FNotRecalcLength then if (deltax <> 0) or (deltay <> 0) or Not CheckDelta then SetLineFigureLengthInPM(AJoinedLine.ID, AJoinedLine.LineLength); end else begin if Not AJoinedLine.FNotRecalcLength then if Not CheckDelta then SetLineFigureLengthInPM(AJoinedLine.ID, AJoinedLine.LineLength); end; NewAP1 := AJoinedLine.ActualPoints[1]; NewAP2 := AJoinedLine.ActualPoints[2]; CP.x := (AJoinedLine.ActualPoints[1].x + AJoinedLine.ActualPoints[2].x) / 2; CP.y := (AJoinedLine.ActualPoints[1].y + AJoinedLine.ActualPoints[2].y) / 2; // ЕСЛИ ЭТО НЕ С-П !!! ///////////// подсчеты для CaptionsGroup ////////////////////////////////// if AJoinedLine.CaptionsGroup <> nil then begin if (OldAP1.x <> NewAP1.x) or (OldAP1.y <> NewAP1.y) or (OldAP2.x <> NewAP2.x) or (OldAP2.y <> NewAP2.y) or Not CheckDelta then begin // пересоздать подпись в нужном месте {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} Captions := TRichTextMod(AJoinedLine.CaptionsGroup.InFigures[1]); ResPoints := AJoinedLine.CaptionsGroupRemoveCalc(AJoinedLine.CaptionsGroup.CenterPoint, OldAP1, OldAP2, NewAP1, NewAP2, AJoinedLine.CaptionsGroupH, Captions.re.Lines.Count); AJoinedLine.UpdateLengthTextBox(false, false); if (AJoinedLine.FCaptionsViewType = cv_Auto) {or (AJoinedLine.FCaptionsViewType = cv_Center)} then AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, ResPoints.y - (AJoinedLine.CaptionsGroup.CenterPoint.y)); if AJoinedLine.ShowLength then // Tolik -- 12/04/2017 -- { AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, ResPoints.y - AJoinedLine.CaptionsGroup.CenterPoint.y) } begin (* Captions := TRichTextMod(AJoinedLine.CaptionsGroup.InFigures[1]); ResPoints := AJoinedLine.CaptionsGroupRemoveCalc(AJoinedLine.CaptionsGroup.CenterPoint, OldAP1, OldAP2, NewAP1, NewAP2, AJoinedLine.CaptionsGroupH, Captions.re.Lines.Count); //Tolik -- 09/12/2015 AJoinedLine.UpdateLengthTextBox(false, false); //AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, // ResPoints.y - (AJoinedLine.CaptionsGroup.CenterPoint.y)); if (AJoinedLine.FCaptionsViewType = cv_Auto) {or (AJoinedLine.FCaptionsViewType = cv_Center)} then AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, ResPoints.y - (AJoinedLine.CaptionsGroup.CenterPoint.y)); *) end else begin // new mark // по правильному нужно бы сместить немного всторону что бы было не по центру линии // но нужно смотреть на то как размещается линия // пока оставим как было // Tolik 13/04/2017 -- {AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, ResPoints.y - AJoinedLine.CaptionsGroup.CenterPoint.y)} // //AJoinedLine.CaptionsGroup.Move(abs(AJoinedLine.CaptionsGroup.ap2.x - AJoinedLine.CaptionsGroup.ap1.x)/2, 0); end; {$ELSE} // Tolik Captions := TRichTextMod(AJoinedLine.CaptionsGroup.InFigures[1]); ResPoints := AJoinedLine.CaptionsGroupRemoveCalc(AJoinedLine.CaptionsGroup.CenterPoint, OldAP1, OldAP2, NewAP1, NewAP2, AJoinedLine.CaptionsGroupH, Captions.re.Lines.Count); //Tolik -- 09/12/2015 AJoinedLine.UpdateLengthTextBox(false, false); //AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, // ResPoints.y - (AJoinedLine.CaptionsGroup.CenterPoint.y)); if (AJoinedLine.FCaptionsViewType = cv_Auto) {or (AJoinedLine.FCaptionsViewType = cv_Center)} then AJoinedLine.CaptionsGroup.Move(ResPoints.x - AJoinedLine.CaptionsGroup.CenterPoint.x, ResPoints.y - (AJoinedLine.CaptionsGroup.CenterPoint.y)); // {$IFEND} end; end; //////////// подсчеты для NotesGroup ///////////////////////////////////// if AJoinedLine.NotesGroup <> nil then begin if (OldAP1.x <> NewAP1.x) or (OldAP1.y <> NewAP1.y) or (OldAP2.x <> NewAP2.x) or (OldAP2.y <> NewAP2.y) or Not CheckDelta then begin AJoinedLine.ReCreateNotesGroup; end; end; //////////// подсчеты для MultilineCaptionBox ///////////////////////////////////// if AJoinedLine.FCount > 1 then begin if AJoinedLine.MultilineCaptionBox <> nil then begin mydeltax := CP.x - TTextMod(AJoinedLine.MultilineCaptionBox).CenterPoint.x; mydeltay := CP.y - TTextMod(AJoinedLine.MultilineCaptionBox).CenterPoint.y; AJoinedLine.MoveTextBox(AJoinedLine.MultilineCaptionBox, AJoinedLine.ActualPoints[1], AJoinedLine.ActualPoints[2], True); if Not TTextMod(AJoinedLine.MultilineCaptionBox).Selected then TTextMod(AJoinedLine.MultilineCaptionBox).Move(mydeltax, mydeltay); end; end; //////////// подсчеты для DrawFigure ///////////////////////////////////// if (OldAP1.x <> NewAP1.x) or (OldAP1.y <> NewAP1.y) or (OldAP2.x <> NewAP2.x) or (OldAP2.y <> NewAP2.y) or Not CheckDelta then begin // Tolik -- 05/05/2017 -- если установлена опция "показывать УГО для райзов", то тут тоже надо было учесть, // а то херня полная при муве происходит -- УГО райзов остаются на старых местах //if not AJoinedLine.FIsRaiseUpDown then if (not AJoinedLine.FIsRaiseUpDown) or TF_CAD(TPowerCad(AJoinedLine.Owner).Owner).FListSettings.CADShowRaiseDrawFigure then // if AJoinedLine.DrawFigure <> nil then begin Bnd := AJoinedLine.DrawFigure.GetBoundRect; DrawFigureCP.x := (Bnd.Left + Bnd.Right) / 2; DrawFigureCP.y := (Bnd.Top + Bnd.Bottom) / 2; if (not AJoinedLine.FIsRaiseUpDown) then AJoinedLine.ReCreateDrawFigureBlock; if AJoinedLine.DrawFigure.InFigures.Count > 0 then begin // передвинуть УГО в нужное место ResPoints := AJoinedLine.DrawFigureRemoveCalc(DrawFigureCP, OldAP1, OldAP2, NewAP1, NewAP2, AJoinedLine.DrawFigureH); // Этот кусок Толян был закоментил в свое время, но вернем пока назад так как вроде двойных // перемещений не удалось воспроизвести AJoinedLine.DrawFigure.Move(ResPoints.x - AJoinedLine.DrawFigure.CenterPoint.x, ResPoints.y - AJoinedLine.DrawFigure.CenterPoint.y); end; end; if AJoinedLine.DrawStyle = mydsNormal then begin Cabinet := GetCabinetAtPos(AJoinedLine.ActualPoints[1].x, AJoinedLine.ActualPoints[1].y, False, AJoinedLine); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then begin if TCabinet(Cabinet).FSCSID <> AJoinedLine.FCabinetID then begin AJoinedLine.FCabinetID := TCabinet(Cabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, AJoinedLine.ID, AJoinedLine.FCabinetID); end; end else if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin if TCabinetExt(Cabinet).FSCSID <> AJoinedLine.FCabinetID then begin AJoinedLine.FCabinetID := TCabinetExt(Cabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, AJoinedLine.ID, AJoinedLine.FCabinetID); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.ReMoveJoinedOrthoLines', E.Message); end; end; function TConnectorObject.Duplicate: TFigure; begin try Result := nil; Result := TConnectorObject.Create(ActualPoints[1].x + 5, ActualPoints[1].y + 5, ActualZOrder[1], LayerHandle, DrawStyle, Owner); TConnectorObject(Result).ConnectorType := ConnectorType; except on E: Exception do addExceptionToLogEx('TConnectorObject.Duplicate', E.Message); end; end; function TConnectorObject.GetActualZOrder(Index: Integer): Double; var DynArrLen: integer; begin try result := 0; DynArrLen := length(FActualZOrder); if (Index <= DynArrLen) And (Index > 0)then result := FActualZOrder[Index - 1]; except // on E: Exception do addExceptionToLogEx('TConnectorObject.GetActualZOrder', E.Message); end; end; procedure TConnectorObject.SetActualZOrder(Index: Integer; const Value: Double); var i: integer; DynArrLen: integer; begin try DynArrLen := length(FActualZOrder); if Index > DynArrLen then SetLength(FACtualZOrder, Index); FActualZOrder[Index - 1] := Value; for i := 0 to JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(JoinedOrtholinesList[i]).JoinConnector1 = Self then TOrthoLine(JoinedOrtholinesList[i]).ActualZOrder[1] := Value; if TOrthoLine(JoinedOrtholinesList[i]).JoinConnector2 = Self then TOrthoLine(JoinedOrtholinesList[i]).ActualZOrder[2] := Value; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.SetActualZOrder', E.Message); end; end; procedure TConnectorObject.SetDrawFigure(const Value: TFigureGrpMod); var deltax, deltay: Double; Bnd: TDoubleRect; begin try // Tolik if Value <> nil then begin // if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); GCadForm.PCad.Figures.Remove(DrawFigure); // Tolik FreeAndNil(FDrawFigure); // end; FDrawFigure := TFigureGrpMod(Value); // Tolik -- 14/09/2017 -- // Bnd := DrawFigure.GetBoundRect; Bnd := DrawFigure.GetBoundRectWithoutAutoCreatedFigures; // GrpSizeX := Bnd.Right - Bnd.Left; GrpSizeY := Bnd.Bottom - Bnd.Top; FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; DrawFigure.ActualPoints[1] := DoublePoint((Bnd.Left + Bnd.Right)/2 - GrpSizeX/2, (Bnd.Top + Bnd.Bottom)/2 - GrpSizeY/2); deltax := ActualPoints[1].x - GrpSizeX / 2 - DrawFigure.ActualPoints[1].x; deltay := ActualPoints[1].y - GrpSizeY / 2 - DrawFigure.ActualPoints[1].y; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure(2, DrawFigure, False)); GCadForm.PCad.AddCustomFigure(2, DrawFigure, False); DrawFigure.move(deltax, deltay); DrawFigure.LockModify := True; AutoShiftObject(Self); // IGOR - 2013-13-05 Это для того чтобы штриховка объектов была впереди, а не за УГО // Tolik 12/02/2020 -- если создается дом с подъездом, то подъезт как коннектор на кад не добавится... // будет какашка... проверка надо! if GCadForm.PCad.Figures.IndexOf(Self) <> -1 then // GCadForm.PCad.Figures.Move(GCadForm.PCad.Figures.IndexOf(self), GCadForm.PCad.Figures.IndexOf(FDrawFigure)); end; except on E: Exception do addExceptionToLogEx('TConnectorObject.SetDrawFigure', E.Message); end; end; destructor TConnectorObject.Destroy; var i: Integer; begin // Tolik -- 22/04/2017 -- ВАЖНО!!! не удалять !!! if Self = GLastConnector then GLastConnector := nil; // // Tolik 02/04/2018 -- if FJoinedOrthoLinesByVerticals <> nil then FreeAndNil(FJoinedOrthoLinesByVerticals); // список присоединенных трасс через вертикали (* //Tolik if Self.ConnectorType = ct_Clear then // 03/08/2017 -- ct_NB на закрытии листа/проекта вызывает множество проблем DeleteObjectFromPM(Self.ID, Self.Name); // *) //// попробуем так: if Self.ConnectorType = ct_Clear then // 03/08/2017 -- ct_NB на закрытии листа/проекта вызывает множество проблем begin // трейсовая в принципе не должна быть в ПМке if (DrawStyle <> dsTrace) then begin // если отмена действия, НО ПМка не отменяется будеи так: //if ListUndoAction.FBasePath <> '' then // при отмене действий TPowerCad(Owner ).OnObjectInserted = nil, поэтому не нужно делать DeleteObjectFromPM if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then begin if Assigned( TPowerCad(Owner).OnObjectInserted ) then begin if not GProjectClose then DeleteObjectFromPM(Self.ID, Self.Name); end; end; end; end; try if DrawStyle <> dsTrace then begin try if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then TF_CAD(TPowerCad(Owner ).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TConnectorObject.Destroy FNeedUpdateCheckedFigures', E.Message); end; end; if FIsRotating then //11.03.2012 FreeAndNil(FDrawFigure); if FindSnapTimer <> nil then FreeAndNil(FindSnapTimer); //Tolik if RemJoined <> nil then begin //RemJoined.Clear; FreeAndNil(RemJoined); end; if JoinedOrtholinesList <> nil then begin //JoinedOrtholinesList.Clear; FreeAndNil(JoinedOrtholinesList); end; if JoinedConnectorsList <> nil then begin //JoinedConnectorslist.Clear; //JoinedConnectorslist.Free; FreeAndNil(JoinedConnectorslist); end; if OutTextCaptions <> nil then begin FreeAndNil(OutTextCaptions); end; if OutTextNotes <> nil then begin FreeAndNil(OutTextNotes); end; if FModConnsOtherSides <> nil then begin //FModConnsOtherSides.Clear; //FModConnsOtherSides.Free; FreeAndNil(FModConnsOtherSides); end; if Length(FActualZOrder) > 0 then SetLength(FActualZOrder, 0); if Length(FJoinedConnectorsIndexes) > 0 then SetLength(FJoinedConnectorsIndexes, 0); if Length(FJoinedConnectorsIndexesForGrp) > 0 then SetLength(FJoinedConnectorsIndexesForGrp, 0); if FindSnapTimer <> nil then FreeAndNil(FindSnapTimer); // 21.09.2105 Tolik GCadForm.PCad.Figures сюда уже может как nil попасть, потому лучше вообще так не делать, // чтобы не нарваться на AV на пустом месте { if FDrawFigure <> nil then begin if GCadForm.PCad.Figures.IndexOf(FDrawFigure) = -1 then FDrawFigure.Free; end;} { if CaptionsGroup <> nil then begin i := GCadForm.PCad.Figures.IndexOf(Self.CaptionsGroup); if i <> -1 then begin GCadForm.PCad.Figures.Delete(i); try FreeAndNil(Self.CaptionsGroup); Except on E: Exception do showmessage(inttostr(i)); end; end else begin beep; end; end; if NotesGroup <> nil then begin i := GCadForm.PCad.Figures.IndexOf(Self.NotesGroup); if i <> -1 then begin GCadForm.PCad.Figures.Delete(i); try FreeAndNil(Self.NotesGroup); Except on E: Exception do showmessage(inttostr(i)); end; end else begin beep; end; end; } // inherited; except on E: Exception do addExceptionToLogEx('TConnectorObject.Destroy', E.Message); end; end; procedure TConnectorObject.WriteToStream(Stream: TStream); var xInt: integer; xIntL: word; xIntH: word; xStr: string; xDbl: double; i: integer; xParam: byte; GetGroupObject: TSCSFigureGrp; FiguresList: TList; l0, l1, l2: Integer; begin try inherited; // if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; // DrawFigure if DrawFigure <> nil then begin xInt := FiguresList.IndexOf(DrawFigure); l0 := GCadForm.Pcad.GetLayerHandle(0); l1 := GCadForm.Pcad.GetLayerHandle(1); l2 := GCadForm.Pcad.GetLayerHandle(2); WriteField(20, Stream, xInt, sizeof(xInt)); end; // ConnectorType xInt := Ord(ConnectorType); WriteField(21, Stream, xInt, sizeof(xInt)); // сохранить CaptionsGroup xInt := FiguresList.IndexOf(CaptionsGroup); WriteField(22, Stream, xInt, sizeof(xInt)); // сохранить FObjectFromRaise if FObjectFromRaise <> nil then begin GetGroupObject := TConnectorObject(FObjectFromRaise).FGroupObject; if GetGroupObject = nil then begin xInt := FiguresList.IndexOf(FObjectFromRaise); WriteField(23, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(78, Stream, xInt, sizeof(xInt)); end else begin xInt := GetGroupObject.InFigures.IndexOf(FObjectFromRaise); WriteField(23, Stream, xInt, sizeof(xInt)); xInt := FiguresList.IndexOf(GetGroupObject); WriteField(78, Stream, xInt, sizeof(xInt)); end; end else begin xInt := -1; WriteField(23, Stream, xInt, sizeof(xInt)); xInt := -1; WriteField(78, Stream, xInt, sizeof(xInt)); end; // ConnectorFullness xInt := Ord(FConnFullness); WriteField(24, Stream, xInt, sizeof(xInt)); // Save FID_ListToPassage xInt := FID_ListToPassage; WriteField(25, Stream, xInt, sizeof(xInt)); // Save FID_ConnToPassage xInt := FID_ConnToPassage; WriteField(26, Stream, xInt, sizeof(xInt)); // Save FConnRaiseType xInt := Ord(FConnRaiseType); WriteField(27, Stream, xInt, sizeof(xInt)); // Save FBlockID xInt := FBlockID; WriteField(28, Stream, xInt, sizeof(xInt)); // Save FObjectType xInt := FObjectType; WriteField(29, Stream, xInt, sizeof(xInt)); // сохранить NotesGroup xInt := FiguresList.IndexOf(NotesGroup); WriteField(30, Stream, xInt, sizeof(xInt)); // FNotesRowType xInt := Ord(FNotesRowsType); WriteField(31, Stream, xInt, sizeof(xInt)); // FNetworkType xInt := $0; if nt_Computer in FNetworkTypes then xInt := xInt + cComputer_nt; if nt_Telephon in FNetworkTypes then xInt := xInt + cTelephon_nt; if nt_Television in FNetworkTypes then xInt := xInt + cTelevision_nt; if nt_Gas in FNetworkTypes then xInt := xInt + cGas_nt; if nt_Electric in FNetworkTypes then xInt := xInt + cElectric_nt; WriteField(32, Stream, xInt, sizeof(xInt)); // Save JoinedConnectorsList for i := 0 to JoinedConnectorsList.Count - 1 do begin GetGroupObject := TConnectorObject(JoinedConnectorsList[i]).FGroupObject; if GetGroupObject = nil then begin xIntL := FiguresList.IndexOf(JoinedConnectorsList[i]); xIntH := $FFFF; xInt := MakeLong(xIntL, xIntH); if ((33 + i) <= 72) then WriteField(33 + i, Stream, xInt, sizeof(xInt)); // xIntH := -1; // if ((53 + i) <= 72) then // WriteField(53 + i, Stream, xInt, sizeof(xInt)); end else begin xIntL := GetGroupObject.InFigures.IndexOf(JoinedConnectorsList[i]); xIntH := FiguresList.IndexOf(GetGroupObject); xInt := MakeLong(xIntL, xIntH); if ((33 + i) <= 72) then WriteField(33 + i, Stream, xInt, sizeof(xInt)); // if ((53 + i) <= 72) then // WriteField(53 + i, Stream, xInt, sizeof(xInt)); end; end; // Save FConnRaiseType xInt := Ord(FDefectDegree); WriteField(75, Stream, xInt, sizeof(xInt)); // FComponID xInt := FComponID; WriteField(76, Stream, xInt, sizeof(xInt)); // FHouse if FHouse <> nil then begin xInt := FiguresList.IndexOf(FHouse); WriteField(77, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(77, Stream, xInt, sizeof(xInt)); end; // FCaptionsFontColor xInt := FCaptionsFontColor; WriteField(79, Stream, xInt, sizeof(xInt)); // FNotesFontColor xInt := FNotesFontColor; WriteField(80, Stream, xInt, sizeof(xInt)); // FBlockCount xInt := FBlockCount; WriteField(81, Stream, xInt, sizeof(xInt)); // FGroupObject if FGroupObject <> nil then begin xInt := FiguresList.IndexOf(FGroupObject); WriteField(82, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(82, Stream, xInt, sizeof(xInt)); end; // FCaptionsFontSize xInt := FCaptionsFontSize; WriteField(83, Stream, xInt, sizeof(xInt)); // FNotesFontSize xInt := FNotesFontSize; WriteField(84, Stream, xInt, sizeof(xInt)); // FCabinetID xInt := FCabinetID; WriteField(85, Stream, xInt, sizeof(xInt)); // FIndex xInt := FIndex; WriteField(86, Stream, xInt, sizeof(xInt)); // FCaptionsViewType xInt := Ord(FCornerType); WriteField(87, Stream, xInt, sizeof(xInt)); // FCaptionsViewType xInt := Ord(FCaptionsViewType); WriteField(88, Stream, xInt, sizeof(xInt)); // FJoinedListIDForBox xInt := Ord(FJoinedListIDForBox); WriteField(89, Stream, xInt, sizeof(xInt)); // Save MarkingList for i := 0 to OutTextCaptions.Count - 1 do begin xStr := OutTextCaptions.Strings[i]; if ((180 + i) <= 210) then begin WriteStrField(180 + i, Stream, xStr); xStr := ReadStringFromStream(Stream); end end; xStr := FTrunkName; WriteStrField(211, Stream, xStr); xStr := FBlockGUID; WriteStrField(212, Stream, xStr); // FCaptionsNotesFontName xStr := FCaptionsFontName; WriteStrField(213, Stream, xStr); xStr := FNotesFontName; WriteStrField(214, Stream, xStr); // ActualPoints xDbl := ActualPoints[1].x; WriteField(220, Stream, xDbl, sizeof(xDbl)); xDbl := ActualPoints[1].y; WriteField(221, Stream, xDbl, sizeof(xDbl)); xDbl := ActualZOrder[1]; WriteField(222, Stream, xDbl, sizeof(xDbl)); // GrpSize xDbl := GrpSizeX; WriteField(223, Stream, xDbl, sizeof(xDbl)); xDbl := GrpSizeY; WriteField(224, Stream, xDbl, sizeof(xDbl)); xDbl := FDrawFigureAngle; WriteField(225, Stream, xDbl, sizeof(xDbl)); // DrawFigure Percent Image xDbl := FOriginalSizeX; WriteField(226, Stream, xDbl, sizeof(xDbl)); xDbl := FOriginalSizeY; WriteField(227, Stream, xDbl, sizeof(xDbl)); xDbl := FDrawFigurePercent; WriteField(228, Stream, xDbl, sizeof(xDbl)); // RaiseShift xDbl := FRaiseShiftX; WriteField(229, Stream, xDbl, sizeof(xDbl)); xDbl := FRaiseShiftY; WriteField(230, Stream, xDbl, sizeof(xDbl)); // флаг отображения подписей if ShowCaptions = true then xParam := 0 else xParam := 1; WriteField(101, Stream, xParam, sizeof(xParam)); // флаг отображения выносок if ShowNotes = true then xParam := 0 else xParam := 1; WriteField(102, Stream, xParam, sizeof(xParam)); // св-ва измененнных полей if FIsNameChanged then xParam := 0 else xParam := 1; WriteField(103, Stream, xParam, sizeof(xParam)); if FIsCaptionsChanged then xParam := 0 else xParam := 1; WriteField(104, Stream, xParam, sizeof(xParam)); if FIsNoteschanged then xParam := 0 else xParam := 1; WriteField(105, Stream, xParam, sizeof(xParam)); if FIsBlockChanged then xParam := 0 else xParam := 1; WriteField(106, Stream, xParam, sizeof(xParam)); // менялся ли тип уголка if FCornerTypeChangedByUser then xParam := 0 else xParam := 1; WriteField(107, Stream, xParam, sizeof(xParam)); // как зеркальное отображение if FMirrored then xParam := 0 else xParam := 1; WriteField(108, Stream, xParam, sizeof(xParam)); // поднять состояние "как конечный объект" if AsEndPoint then xParam := 0 else xParam := 1; WriteField(109, Stream, xParam, sizeof(xParam)); // House if FIsApproach then xParam := 0 else xParam := 1; WriteField(110, Stream, xParam, sizeof(xParam)); if FIsHouseJoined then xParam := 0 else xParam := 1; WriteField(111, Stream, xParam, sizeof(xParam)); if FDrawFigureMoved then xParam := 0 else xParam := 1; WriteField(112, Stream, xParam, sizeof(xParam)); except on E: Exception do addExceptionToLogEx('TConnectorObject.WriteToStream' + Self.FMark, E.Message); end; end; procedure TConnectorObject.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); var xStr: string; xInt: integer; xIntL: word; xIntH: word; FindCode: integer; xParam: byte; DataP: PChar; begin try inherited; case xCode of 220: GConnectorPoints.x := pDouble(data)^; 221: GConnectorPoints.y := pDouble(data)^; 222: ActualZOrder[1] := pDouble(data)^; 223: GrpSizeX := pDouble(data)^; 224: GrpSizeY := pDouble(data)^; 225: FDrawFigureAngle := pDouble(data)^; // 226: FOriginalSizeX := pDouble(data)^; 227: FOriginalSizeY := pDouble(data)^; 228: FDrawFigurePercent := pDouble(data)^; 229: FRaiseShiftX := pDouble(data)^; 230: FRaiseShiftY := pDouble(data)^; 20: begin xInt := pInt(data)^; FDrawFigureIndex := xInt; FCornerType := GCadForm.FDefaultCornerType; FCabinetID := -1; tmpParentDupID := -1; FCaptionsFontSize := -1; FNotesFontSize := -1; FCaptionsFontColor := -1; FNotesFontColor := -1; FGroupObjectIndex := -1; // FOriginalSizeX := -1; FOriginalSizeY := -1; FDrawFigurePercent := 100; FCaptionsFontName := GCadForm.FFontName; FNotesFontName := GCadForm.FFontName; FBlockCount := 2; FRaiseShiftX := 1; FRaiseShiftY := 1; // FObjectFromRaiseIndexForGrp := -1; FDefectDegree := dodNormal; FHouseIndex := -1; FIsApproach := False; FIsHouseJoined := False; FDrawFigureMoved := false; end; 21: begin xInt := pInt(data)^; FConnectorType := TConnectorType(xInt); end; 22: begin xInt := pInt(data)^; FCaptionsGroupIndex := xInt; end; 23: begin xInt := pInt(data)^; FObjectFromRaiseIndex := xInt; end; 24: begin xInt := pInt(data)^; FConnFullness := TComponInterfacesFullness(xInt); end; 25: begin xInt := pInt(data)^; FID_ListToPassage := xInt; end; 26: begin xInt := pInt(data)^; FID_ConnToPassage := xInt; end; 27: begin xInt := pInt(data)^; FConnRaiseType := TConnRaiseType(xInt); end; 28: begin xInt := pInt(data)^; FBlockID := xInt; end; 29: begin xInt := pInt(data)^; FObjectType := xInt; end; 30: begin xInt := pInt(data)^; FNotesGroupIndex := xInt; end; 31: begin xInt := pInt(data)^; FNotesRowsType := TNotesRowsType(xInt); end; 32: begin // FNetworkType xInt := pInt(data)^; FNetworkTypes := []; if xInt and cComputer_nt = cComputer_nt then FNetworkTypes := FNetworkTypes + [nt_Computer]; if xInt and cTelephon_nt = cTelephon_nt then FNetworkTypes := FNetworkTypes + [nt_Telephon]; if xInt and cTelevision_nt = cTelevision_nt then FNetworkTypes := FNetworkTypes + [nt_Television]; if xInt and cGas_nt = cGas_nt then FNetworkTypes := FNetworkTypes + [nt_Gas]; if xInt and cElectric_nt = cElectric_nt then FNetworkTypes := FNetworkTypes + [nt_Electric]; end; 75: begin xInt := pInt(data)^; FDefectDegree := TDefectDegree(xInt); end; 76: begin xInt := pInt(data)^; FComponID := xInt; end; 77: begin xInt := pInt(data)^; FHouseIndex := xInt; end; 78: begin xInt := pInt(data)^; FObjectFromRaiseIndexForGrp := xInt; end; 79: begin xInt := pInt(data)^; FCaptionsFontColor := xInt; end; 80: begin xInt := pInt(data)^; FNotesFontColor := xInt; end; 81: begin xInt := pInt(data)^; FBlockCount := xInt; end; 82: begin xInt := pInt(data)^; FGroupObjectIndex := xInt; end; 83: begin xInt := pInt(data)^; FCaptionsFontSize := xInt; end; 84: begin xInt := pInt(data)^; FNotesFontSize := xInt; end; 85: begin xInt := pInt(data)^; FCabinetID := xInt; end; 86: begin xInt := pInt(data)^; FIndex := xInt; end; 87: begin xInt := pInt(data)^; FCornerType := TCornerType(xInt); end; 88: begin xInt := pInt(data)^; FCaptionsViewType := TConnCaptionsViewType(xInt); end; 89: begin xInt := pInt(data)^; FJoinedListIDForBox := xInt; end; 101: begin xParam := pByte(data)^; if xParam = 0 then ShowCaptions := true else ShowCaptions := false; end; 102: begin xParam := pByte(data)^; if xParam = 0 then ShowNotes := true else ShowNotes := false; end; 103: begin xParam := pByte(data)^; if xParam = 0 then FIsNameChanged := true else FIsNameChanged := false; end; 104: begin xParam := pByte(data)^; if xParam = 0 then FIsCaptionsChanged := true else FIsCaptionsChanged := false; end; 105: begin xParam := pByte(data)^; if xParam = 0 then FIsNotesChanged := true else FIsNotesChanged := false; end; 106: begin xParam := pByte(data)^; if xParam = 0 then FIsBlockChanged := true else FIsBlockChanged := false; end; 107: begin xParam := pByte(data)^; if xParam = 0 then FCornerTypeChangedByUser := true else FCornerTypeChangedByUser := false; end; 108: begin xParam := pByte(data)^; if xParam = 0 then FMirrored := true else FMirrored := false; end; 109: begin xParam := pByte(data)^; if xParam = 0 then AsEndPoint := true else AsEndPoint := false; end; 110: begin xParam := pByte(data)^; if xParam = 0 then FIsApproach := true else FIsApproach := false; end; 111: begin xParam := pByte(data)^; if xParam = 0 then FIsHouseJoined := true else FIsHouseJoined := false; end; 112: begin xParam := pByte(data)^; if xParam = 0 then FDrawFigureMoved := true else FDrawFigureMoved := false; end; 211: begin DataP := data; xStr := DataP; FTrunkName := xStr; end; 212: begin DataP := data; xStr := DataP; FBlockGUID := xStr; end; 213: begin DataP := data; xStr := DataP; FCaptionsFontName := xStr; end; 214: begin DataP := data; xStr := DataP; FNotesFontName := xStr; end; end; if (xCode >= 33) AND (xCode <= 72) then begin FindCode := Length(FJoinedConnectorsIndexes); FindCode := FindCode + 1; SetLength(FJoinedConnectorsIndexes, FindCode); SetLength(FJoinedConnectorsIndexesForGrp, FindCode); xInt := pInt(data)^; xIntL := LoWord(DWord(xInt)); xIntH := HiWord(DWord(xInt)); FJoinedConnectorsIndexes[FindCode - 1] := xIntL; if xIntH = 0 then xIntH := $FFFF; FJoinedConnectorsIndexesForGrp[FindCode - 1] := xIntH; end; // if (xCode >= 53) AND (xCode <= 72) then // begin // xInt := pInt(data)^; // FJoinedConnectorsIndexesForGrp[xCode - 53] := xInt; // end; if (xCode >= 180) AND (xCode <= 210) then begin DataP := data; xStr := DataP; OutTextCaptions.Add(xStr); end; FDrawFigure := nil; CaptionsGroup := nil; NotesGroup := nil; ActualPoints[1] := GConnectorPoints; // пересоздать OutText if OutTextCaptions = nil then OutTextCaptions := TStringList.Create; if OutTextNotes = nil then begin OutTextNotes := TStringList.Create; if ID <> 0 then //08.11.2011 TF_CAD(TPowerCad(Owner).Owner).AddSCSFigure(Self); end; // пересоздать RemJoined if RemJoined = nil then RemJoined := TList.Create; // пересоздать JoinedOrtholinesList if JoinedOrtholinesList = nil then JoinedOrtholinesList := TList.Create; // пересоздать JoinesConnectorsList if JoinedConnectorslist = nil then JoinedConnectorslist := TList.Create; TF_CAD(TPowerCad(Owner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TConnectorObject.SetPropertyFromStream', E.Message); end; end; //============================================================================== //============= TFigureGrpMod ================================================== //============================================================================== function TFigureGrpMod.duplicate: TFigure; var i: integer; TempFig: TFigure; CurFig: TFigure; TempWMF: TWMFObject; TempPath: string; //08.09.2011 Buffer: array[0..1023] of Char; begin try Result := nil; Result := TFigureGrpMod.Create(LayerHandle, Owner); for i := 0 to InFigures.Count - 1 do begin try if CheckFigureByClassName(TFigure(InFigures[i]), 'TWMFObject') then begin TempWMF := TWMFObject(InFigures[i]); TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); TempWMF.MetaFile.SaveToFile(TempPath + 'tempWMF.bmp'); TempWMF.PictureName := TempPath + 'tempWMF.bmp'; TempFig := TempWMF.Duplicate; end else begin TempFig := TFigure(InFigures[i]).Duplicate; end; except end; TFigureGrpMod(Result).AddFigure(TempFig); end; except on E: Exception do addExceptionToLogEx('TFigureGrpMod.duplicate', E.Message); end; end; // Tolik -- 11/08/2017 -- удалить автосозданные фигуры из // групповой фигуры procedure TFigureGrpMod.RemoveAutoCreatedFigures; var i: Integer; InFigure: TFigure; begin if not Self.Deleted then if Assigned(infigures) then begin for i := (infigures.Count - 1) downto 0 do begin inFigure := TFigure(inFigures[i]); if inFigure.isAutoCreatedFigure = biTrue then begin inFigures.Remove(inFigure); if not inFigure.Deleted then inFigure.Free; end; end; end; end; procedure TFigureGrpMod.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); begin inherited; { test figMaxX := -1000; figMaxY := -1000; figMinX := -1000; figMinY := -1000; GProcCnt := GProcCnt + 1;} end; procedure TFigureGrpMod.getModPoints(ModList: TMyList); begin if fFromApproach <> nil then inherited else if LayerHandle = LongInt(TPowerCad(Owner).Layers[1]) then inherited end; function TFigureGrpMod.IsPointIn(x, y: Double): Boolean; var apoint : TDoublePoint; a: integer; nx,ny,z: Double; ctrl: Double; ap,p1,p2,p3,p4: TDoublePoint; DEngine: TPCDrawEngine; begin result := false; if assigned(Owner) then if LayerHandle = LongInt(TPowerCad(Owner).Layers[1]) then begin try //Result := False; //CP := CenterPoint; //if (x >= ActualPoints[1].x - 0.5) and (x <= ActualPoints[1].x + 0.5) and (y >= ActualPoints[1].y - 0.5) AND (y <= ActualPoints[1].y + 0.5) then // Result := True; //Result := inherited IsPointIn(x, y); apoint := DoublePoint(x,y); ap := aPoint; p1 := ap1; p2 := ap2; p3 := ap3; p4 := ap4; if assigned(Owner) then begin z:= 0; DEngine := TPCDrawing(Owner).DEngine; DEngine.ConvertPoint(ap.x,ap.y,z); DEngine.ConvertPoint(p1.x,p1.y,z); DEngine.ConvertPoint(p2.x,p2.y,z); DEngine.ConvertPoint(p3.x,p3.y,z); DEngine.ConvertPoint(p4.x,p4.y,z); end; if ( ispointinLine(p1,p2,ap,width) or ispointinLine(p2,p3,ap,width) or ispointinLine(p3,p4,ap,width) or ispointinLine(p4,p1,ap,width) ) then result := true; except end; end; end; procedure TFigureGrpMod.select; begin try if fFromApproach <> nil then begin if fRMode or fTraceMod then inherited; end else begin if assigned(Owner) then if LayerHandle = LongInt(TPowerCad(Owner).Layers[1]) then inherited; end; except on E: Exception do AddExceptionToLogEx('TFigureGrpMod.select', E.Message); end; end; //============================================================================== //============= TFrame ========================================================= //============================================================================== function TFrame.IsPointIn(x, y: Double): Boolean; begin Result := False; Result := inherited IsPointIn(x, y); end; procedure TFrame.Select; begin inherited; end; procedure TFrame.WriteToStream(Stream: TStream); begin try inherited; except on E: Exception do addExceptionToLogEx('TFrame.WriteToStream', E.Message) end; end; procedure TFrame.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); begin try inherited; except on E: Exception do addExceptionToLogEx('TFrame.SetPropertyFromStream', E.Message) end; end; //Procedure TConnectorObject.AddAutoCreatedObjsToDrawFigure(Angle, aTransparency: Integer; cpx, cpy, Radius, CutRadius: Double; FillColor: TColor; aCutStyle: TPieCutStyle; aRotateAngle: integer = -1); Procedure TConnectorObject.AddAutoCreatedObjsToDrawFigure(AFigClassName: String; AParamList: TStringList); var i: Integer; PieFigure: TPie; EllFigure: TOverLappedEllipse; ap1: TDoublePoint; MaxX, MaxY, MinX, MinY: Double; Angle, FAngle, SAngle: double; TransParency: Integer; cpx, cpy, Radius, CutRadius: Double; FillColor: TColor; CutStyle: TPieCutStyle; RotateAngle: integer; cX, cY, cX1, cY1, Rad1, Rad2, CutRad1, CutRad2: Double; w,s,c,abrs,abrc:integer; LHandle: LongInt; begin if DrawFigure = nil then exit; if AParamList = nil then exit; // если добавляем сектор if aFigClassName = 'TPie' then begin if AParamList.Count < 9 then // если не хватает параметров -- нах exit; Angle := StrToFloat_My(aParamList[0]); // угол TransParency := StrToInt(aParamList[1]); //прозрачность cpx := StrToFloat_My(aParamList[2]); // центрХ cpy := StrToFloat_My(aParamList[3]); // центрУ Radius := StrToFloat_My(aParamList[4]); // радиус CutRadius := StrToFloat_My(aParamList[5]);// обрезка FillColor := StrToInt(aParamList[6]);//цвет CutStyle := TPieCutStyle(StrToInt(aParamList[7])); // стиль обрезки RotateAngle := StrToInt(aParamList[8]); // угол поворота // Tolik 31/10/2019 -- { Sangle := (360 - Angle/2)/180*PI; FAngle := (Angle/360)*PI; } while Angle > 360 do Angle := Angle - 360; if Angle = 360 then begin Sangle := 0; FAngle := 2*PI; end else begin Sangle := (360 - Angle/2)/180*PI; FAngle := (Angle/360)*PI; end; // // DrawFigure.GetBounds(MaxX, MaxY, MinX, MinY); {AP1.y := (MaxY + MinY)/2; AP1.x := (MaxX);} AP1.x := cpx; AP1.y := cpy; PieFigure := TPie.Create( ap1.x, ap1.y, radius, SAngle, FAngle, GCadForm.PCad.DefaultPenWidth, ord(GCadForm.PCad.DefaultPenStyle), GCadForm.PCad.DefaultPenColor, //ord(cad.DefaultBrushStyle), 1, {clSkyBlue} FillColor, DrawFigure.LayerHandle,mydsNormal,DrawFigure.Owner, CutStyle{PieLinearCut}, CutRadius); PieFigure.Transparency := TransParency; PieFigure.isAutoCreatedFigure := biTrue; // autocreated figure if Angle <> 360 then // 01/11/2019 -- если зона круглая, ясен пень, вращать не нужно ... if RotateAngle <> -1 then PieFigure.Rotate((RotateAngle/180)*PI, DoublePoint(cpx, cpy)); // GCadForm.PCad.AddCustomFigure (GLN(PieFigure.LayerHandle), PieFigure, False); //DrawFigure.AddToGrp(PieFigure); //FAngle := 0; if Angle <> 360 then // 01/11/2019 -- если зона круглая, ясен пень, вращать не нужно ... PieFigure.Rotate(FDrawFigureAngle, Self.DrawFigure.CenterPoint);//DoublePoint(cpx, cpy)); //Self.DrawFigure.CenterPoint);//DoublePoint(cpx, cpy)); DrawFigure.AddFigure(PieFigure); //так правильнее end else if aFigClassName = 'TOverLappedEllipse' then begin cx := StrToFloat_My(aParamList[0]); // центрХ cy := StrToFloat_My(aParamList[1]); // центрУ cx1 := StrToFloat_My(aParamList[2]); // центрХ cy1 := StrToFloat_My(aParamList[3]); // центрУ Rad1 := StrToFloat_My(aParamList[4]); Rad2 := StrToFloat_My(aParamList[5]); CutRad1 := StrToFloat_My(aParamList[6]); CutRad2 := StrToFloat_My(aParamList[7]); FillColor := StrToInt(aParamList[8]); // цвет заливки TransParency := StrToInt(aParamList[9]); // прозрачность EllFigure := TOverlappedEllipse.create(cX, cY, cX1, cY1, Rad1, Rad2, CutRad1, CutRad2,1,1,1,1,clRed, DrawFigure.LayerHandle, TDrawStyle(1), nil); EllFigure.TransParency := TransParency; EllFigure.isAutoCreatedFigure := biTrue; //EllFigure.Owner := GCadForm.PCad; EllFigure.Rotate(FDrawFigureAngle, Self.DrawFigure.CenterPoint); //DrawFigure.AddFigure(EllFigure); //так правильнее DrawFigure.InsertFigure(EllFigure); end; end; procedure TConnectorObject.SetConnectorType(const Value: TConnectorType); var i: integer; deltax, deltay: Double; LHandle: integer; Bnd: TDoubleRect; CaptionsLHandle: integer; NotesLHandle: integer; begin try if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); GCadForm.PCad.Figures.Remove(DrawFigure); end; FConnectorType := Value; //Tolik 18/12/2019 -- if FDrawFigure <> nil then begin GCadForm.PCad.Figures.Remove(FDrawFigure); FreeAndNil(FDrawFigure); end; // FDrawFigure := GetConnectorImg(FConnectorType); if DrawFigure <> nil then Bnd := DrawFigure.GetBoundRect; GrpSizeX := Bnd.Right - Bnd.Left; GrpSizeY := Bnd.Bottom - Bnd.Top; FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; if (GCadForm.PCad <> nil) AND (DrawStyle <> dsTrace) then begin // Задать точки для отрисовки прямоугольника, верхнюю левую и нижнюю правую Bnd := DrawFigure.GetBoundRect; GrpSizeX := Bnd.Right - Bnd.Left; GrpSizeY := Bnd.Bottom - Bnd.Top; FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; DrawFigure.ActualPoints[1] := DoublePoint((Bnd.Left + Bnd.Right) / 2 - GrpSizeX / 2, (Bnd.Top + Bnd.Bottom) / 2 - GrpSizeY / 2); deltax := ActualPoints[1].x - GrpSizeX / 2 - DrawFigure.ActualPoints[1].x; deltay := ActualPoints[1].y - GrpSizeY / 2 - DrawFigure.ActualPoints[1].y; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(FLHandle), DrawFigure, False)); GCadForm.PCad.AddCustomFigure (GLN(FLHandle), DrawFigure, False); DrawFigure.move(deltax, deltay); DrawFigure.LockModify := True; // убрать CaptionsGroup и NotesGroup if ConnectorType = ct_Clear then begin if CaptionsGroup <> nil then begin if CheckFigureByClassName(CaptionsGroup, cTFigureGrpNotMod) then RemoveInFigureGrp(TFigureGrp(CaptionsGroup)); GCadForm.PCad.Figures.Remove(CaptionsGroup); FreeAndNil(CaptionsGroup); end; if NotesGroup <> nil then begin RemoveInFigureGrp(TFigureGrp(NotesGroup)); GCadForm.PCad.Figures.Remove(NotesGroup); FreeAndNil(NotesGroup); end; end; if ConnectorType <> ct_Clear then if NotesGroup <> nil then ReCreateNotesGroup(True); end else begin if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); GCadForm.PCad.Figures.Remove(DrawFigure); end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.SetConnectorType', E.Message); end; end; // Tolik 21/11/2016-- // старая закомменчена (см. ниже) // здесь переписано (дописано), чтобы не пиздануть нужный райз на поинте procedure TConnectorObject.Delete(Recurse: Boolean = True; DelRaise: Boolean = True); var i, j: integer; JoinedConn: TConnectorObject; RaiseLine: TOrthoLine; RaiseConn: TConnectorObject; ConnectedConn: TConnectorObject; ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; JoinedLine: TOrthoLine; CurGCadForm: TF_CAD; ObjParams: TObjectParams; SnappedList: TList; PrevConnector: TConnectorObject; // Tolik -- 23/09/2016 -- ActualPX, ActualPY: Double; CanDelTrunkConnector: Boolean; // Tolik 22/11/2016 -- // процедура проверки удаления райза, если удаляем точечный объект (НЕ ПУСТОЙ КОННЕКТОР!!!) Procedure CheckDeleteRaiseOnPointObject; var RConn1, RConn2, TrunkConn: TConnectorObject; isTrunk: Boolean; // Line1Count, Line2Count: Integer; CanDelRaise: Boolean; function CheckCanDelTrunk: Boolean; var i: Integer; ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; CurGCadForm: TF_CAD; SCSFigureGrp: TSCSFigureGrp; RelatedConn1, RelatedConn2: TConnectorObject; RelatedRaise: TOrthoLine; CanDelRelatedRaise: Boolean; begin Result := False; if not CanDelTrunkConnector then exit; try ListOfPassage := GetListOfPassage(TrunkConn.FID_ListToPassage); if ListOfPassage <> nil then begin RelatedRaise := Nil; CanDelRelatedRaise := False; ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, TrunkConn.FID_ConnToPassage)); if ConnOfPassage <> nil then begin CurGCadForm := GCadForm; GCadForm := ListOfPassage; for i := 0 to ConnOfPassage.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(ConnOfPassage.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RelatedRaise := TOrthoLine(ConnOfPassage.JoinedOrtholinesList[i]); Break; //// BREAK ////; end; end; if RelatedRaise <> nil then begin if (RelatedRaise.JoinConnector1 <> nil) and (not TConnectorObject(RelatedRaise.JoinConnector1).Deleted) then begin if (TConnectorObject(RelatedRaise.JoinConnector1).RemJoined.IndexOf(RelatedRaise) = -1) and (TConnectorObject(RelatedRaise.JoinConnector1).JoinedOrtholinesList.Count - TConnectorObject(RelatedRaise.JoinConnector1).RemJoined.Count = 1) then CanDelRelatedRaise := True; end else CanDelRelatedRaise := True; if not CanDelRelatedRaise then begin if (RelatedRaise.JoinConnector2 <> nil) and (not TConnectorObject(RelatedRaise.JoinConnector2).Deleted) then begin if (TConnectorObject(RelatedRaise.JoinConnector2).RemJoined.IndexOf(RelatedRaise) = -1) and (TConnectorObject(RelatedRaise.JoinConnector2).JoinedOrtholinesList.Count - TConnectorObject(RelatedRaise.JoinConnector2).RemJoined.Count = 1) then CanDelRelatedRaise := True; end end; end; if CanDelRelatedRaise then begin if RelatedRaise.FGroupObject = nil then RelatedRaise.Delete else begin SCSFigureGrp := RelatedRaise.FGroupObject; if (not SCSFigureGrp.Deleted) then begin SCSFigureGrp.RemoveFromGrp(RelatedRaise); SCSFigureGrp.RemoveFromGrp(RelatedRaise.JoinConnector1); SCSFigureGrp.RemoveFromGrp(RelatedRaise.JoinConnector2); RelatedRaise.Delete; end; end; {ConnOfPassage.FConnRaiseType := crt_None; ConnOfPassage.Delete(True);} RefreshCAD(GCadForm.PCad); end; GCadForm := CurGCadForm; end; {else begin SCSFigureGrp := GetSCSFigureGrp(ListOfPassage, aItRaise.FID_ConnToPassage); if SCSFigureGrp <> nil then begin ConnOfPassage := TConnectorObject(GetFigureByIDInSCSFigureGrp(SCSFigureGrp, aItRaise.FID_ConnToPassage)); if ConnOfPassage <> nil then begin CurGCadForm := GCadForm; GCadForm := ListOfPassage; // ConnOfPassage.FConnRaiseType := crt_None; DeleteObjectFromSCSFigureGrp(SCSFigureGrp, ConnOfPassage); RefreshCAD(GCadForm.PCad); GCadForm := CurGCadForm; end; end; end;} end; except on E: Exception do addExceptionToLogEx('U_ESCadClasses.TConnectorObject.Delete.CheckDeleteRaiseOnPointObject', E.Message); end; end; begin if RaiseLine = nil then exit; isTRunk := False; Line1Count := 0; Line2Count := 0; TrunkConn := nil; RConn1 := TConnectorObject(RaiseLine.JoinConnector1); RConn2 := TConnectorObject(RaiseLine.JoinConnector2); if (RConn1 <> nil) and (not RConn1.Deleted) and (RConn2 <> nil) and (not RConn2.Deleted) then begin Line1Count := RConn1.JoinedOrthoLinesList.Count - RConn1.RemJoined.Count; Line2Count := RConn2.JoinedOrtholinesList.Count - RConn2.RemJoined.Count; if (RConn1.FConnRaiseType = crt_BetweenFloorUp) or (RConn1.FConnRaiseType = crt_BetweenFloorDown) or (RConn1.FConnRaiseType = crt_TrunkUp) or (RConn1.FConnRaiseType = crt_TrunkDown) then begin isTrunk := True; TrunkConn := RConn1; end else if (RConn2.FConnRaiseType = crt_BetweenFloorUp) or (RConn2.FConnRaiseType = crt_BetweenFloorDown) or (RConn2.FConnRaiseType = crt_TrunkUp) or (RConn2.FConnRaiseType = crt_TrunkDown) then begin isTrunk := True; TrunkConn := RConn2; end; if isTrunk then CanDelRaise := CheckCanDelTrunk else begin //Tolik 15/11/2019 -- { if (Line1Count <= 1) or (Line2Count <= 1) then CanDelRaise := True;} if (Line1Count <= 1) then if RConn1.JoinedConnectorsList.Count = 0 then CandelRaise := true; if (Line2Count <= 1) then if RConn2.JoinedConnectorsList.Count = 0 then CanDelRaise := True; end; end else CanDelRaise := True; if CanDelRaise then RaiseLine.Delete; end; // // Tolik 15/03/2017 -- function checkCanSnapConnToConn(conn1, conn2: TConnectorObject): Boolean; var i: Integer; RaiseLine: TOrthoLine; begin RaiseLine := nil; Result := True; for i := 0 to conn1.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(conn1.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(conn1.JoinedOrtholinesList[i]); Break; //// BREAK ////; end; end; if RaiseLine = nil then begin for i := 0 to conn2.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(conn2.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(conn2.JoinedOrtholinesList[i]); Break; //// BREAK ////; end; end; end; Result := (RaiseLine = nil); end; // begin // Tolik -- 21/11/2016-- ибо нех тут вообще! if deleted then exit; // try // Tolik 21/05/2019 -- if GPrevFigureTraceTo <> nil then if ID = GPrevFigureTraceTo.ID then GPrevFigureTraceTo := nil; if GPrevFigureSnap <> nil then if ID = GPrevFigureSnap.ID then GPrevFigureSnap := nil; if GFigureSnap <> nil then if ID = GFigureSnap.ID then GFigureSnap := nil; // // Tolik --25/07/2017 -- //if Self.ConnectorType = ct_Clear then DeleteObjectFromPM(Self.ID, Self.Name); // SnappedList := TList.Create; RaiseConn := nil; RaiseLine := Nil; CanDelTrunkConnector := False; for i := 0 to JoinedConnectorsList.Count - 1 do begin if (TConnectorObject(JoinedConnectorsList[i]) <> nil) and (not TConnectorObject(JoinedConnectorsList[i]).deleted) then begin if (TConnectorObject(JoinedConnectorsList[i]).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(JoinedConnectorsList[i]).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(JoinedConnectorsList[i]).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(JoinedConnectorsList[i]).FConnRaiseType = crt_TrunkDown) then begin CanDelTrunkConnector := True; Break; //// BREAK ////; end; end; end; // Tolik -- 23/09/2016-- ActualPX := Self.ActualPoints[1].x; ActualPY := Self.ActualPoints[1].y; // if Owner <> nil then //07.11.2011 TF_CAD(TPowerCad(Owner).Owner).RemoveSCSFigure(Self); // House if FIsHouseJoined then FHouse.fJoined.Remove(Self); if FIsApproach then fHouse.fApproaches.Remove(Self); // if CheckTrunkObject(Self) then begin //Tolik FreeAndNil(SnappedList); // DeleteTrunkObject(Self); Exit; end; // ObjFromRaise // if DelRaise then // на пустом коннекторе удаляем райз по-любому if ConnectorType = ct_clear then begin RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin DeleteRaiseOtherFloor(RaiseConn); end; if RaiseConn.ConnectorType = ct_clear then begin RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; end; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; RaiseLine := GetRaiseLine(RaiseConn); if RaiseLine <> nil then begin TOrthoLine(RaiseLine).Delete; // Tolik 25/05/2021 -- //RaiseLine := Nil; SnappedList.Free; exit; // end; end // Tolik -- хер мы так райз найдем, нужно в любом случае убедиться, что райза нет ни х else begin for i := 0 to JoinedOrtholinesList.count - 1 do begin if TOrthoLine(JoinedOrthoLinesList[i]).FisRaiseUpDown then begin RaiseLine := TOrthoLine(JoinedOrthoLinesList[i]); break; end; end; if RaiseLine <> nil then begin RaiseLine.delete; //Tolik 25/05/2021 -- //RaiseLine := Nil; SnappedList.free; exit; // end; end; end; // это конечный объект if AsEndPoint then begin GEndPoint := Nil; GListWithEndPoint := Nil; end; // м-э переход if (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_TrunkUp) or (FConnRaiseType = crt_TrunkDown)then begin DeleteRaiseOtherFloor(Self); end; // на поинте райз не удаляем, а выставляем и удаляем потом (если нужно), после проверки if ConnectorType <> ct_Clear then begin // если есть с-п удалить и его (*RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(RaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then RaiseLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); { TOrthoLine(RaiseLine).Delete; RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False;} end else if FConnRaiseType <> crt_None then begin RaiseLine := GetRaiseLine(Self); // TOrthoLine(RaiseLine).Delete; end;*) RaiseConn := nil; RaiseLine := RaiseFromConnector(Self); if RaiseLine <> nil then begin if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.IndexOf(Self) <> -1 then RaiseConn := TConnectorObject(RaiseLine.JoinConnector1) else if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.IndexOf(Self) <> -1 then RaiseConn := TConnectorObject(RaiseLine.JoinConnector2); end; // Tolik 17/02/2021 -- if RaiseConn <> nil then if FObjectFromRaise <> nil then begin RaiseConn.FObjectFromRaise := FObjectFromRaise; FObjectFromRaise := Nil; end; while JoinedConnectorsList.Count > 0 do begin JoinedConn := TConnectorObject(JoinedConnectorsList[0]); UnsnapConnectorFromPointObject(JoinedConn, Self); SnappedList.Add(JoinedConn); end; end; if AsEndPoint then begin GEndPoint := nil; GListWithEndPoint := nil; end; Deleted := True; if Self = GLastConnector then GLastConnector := nil; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // TPowerCad(Owner).Figures.Remove(Self); //07/11/2015 // // Tolik 07/06/2021 -- { if Assigned(CaptionsGroup) then CaptionsGroup.Delete; if Assigned(NotesGroup) then NotesGroup.Delete; if Assigned(DrawFigure) then begin TPowerCad(Owner).Figures.Remove(DrawFigure); //07/11/2015 DrawFigure.Delete; end; } if Assigned(CaptionsGroup) then begin if TF_Cad(Owner.Owner).FRemFigures.IndexOf(CaptionsGroup) = -1 then CaptionsGroup.Delete; end; if Assigned(NotesGroup) then begin if TF_Cad(Owner.Owner).FRemFigures.IndexOf(NotesGroup) = -1 then NotesGroup.Delete; end; if Assigned(DrawFigure) then begin if TF_Cad(Owner.Owner).FRemFigures.IndexOf(DrawFigure) = -1 then DrawFigure.Delete; end; // i := 0; if Recurse then begin while i < JoinedOrtholinesList.Count do begin TOrthoLine(JoinedOrtholinesList[i]).Delete; i := i + 1; end; end; // удалить ссылки на конектор из привязанных конекторов for i := 0 to JoinedConnectorslist.Count - 1 do begin JoinedConn := TConnectorObject(JoinedConnectorslist[i]); //Tolik 07/11/2015 { хуйня кака-то ... будут дубли(подряд) - проскочит j := 0; while j < JoinedConn.JoinedConnectorslist.Count do begin if TFigure(JoinedConn.JoinedConnectorslist[j]) = Self then JoinedConn.JoinedConnectorslist.Remove(Self); j := j + 1; end; } // лучше так: while JoinedConn.JoinedConnectorslist.IndexOf(Self) <> -1 do JoinedConn.JoinedConnectorslist.Remove(Self); // end; // присоединить коннекторы отвязанные от РТ if SnappedList.Count > 0 then begin if RaiseConn <> nil then PrevConnector := RaiseConn else PrevConnector := TConnectorObject(SnappedList[0]); SnappedList.Remove(PrevConnector); // если есть райз, нужно перебросить FObjectFromRaise, так как после снапа коннекторов пересчитаются длины трасс // и перестроятся подписи к трассам if RaiseLine <> nil then begin if (RaiseLine.FObjectFromRaisedLine <> nil) and (RaiseLine.FObjectFromRaisedLine.ID = Self.Id) then begin RaiseLine.FObjectFromRaisedLine := PrevConnector; end; if (RaiseLine.JoinConnector1 <> nil) and (not TConnectorObject(RaiseLine.JoinConnector1).deleted) then begin if (TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise <> nil) and (TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise.Id = Self.Id) then TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise := PrevConnector; end; if (RaiseLine.JoinConnector2 <> nil) and (not TConnectorObject(RaiseLine.JoinConnector2).deleted) then begin if (TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise <> nil) and (TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise.Id = Self.Id) then TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise := PrevConnector; end; end; if (PrevConnector <> nil) and (not PrevConnector.Deleted) then begin ConnectedConn := nil; // Tolik 15/11/2019 -- {for i := 1 to SnappedList.Count - 1 do begin ConnectedConn := TConnectorObject(SnappedList[i]); if (ConnectedConn <> nil) and (not ConnectedConn.Deleted) then begin // Tolik 15/03/2017 -- это переделать после того, как перепишется снап // коннекторов с учетом вертикальных линий //if checkCanSnapConnToConn(ConnectedConn, PrevConnector) then // CheckingSnapConnectorToConnector(ConnectedConn, PrevConnector);// ConnectedConn := SnapConnectorToConnector(ConnectedConn, PrevConnector); PrevConnector := ConnectedConn; end; end;} for i := SnappedList.Count - 1 downto 0 do begin ConnectedConn := TConnectorObject(SnappedList[i]); if (ConnectedConn <> nil) and (not ConnectedConn.Deleted) then begin // Tolik 15/03/2017 -- это переделать после того, как перепишется снап // коннекторов с учетом вертикальных линий //if checkCanSnapConnToConn(ConnectedConn, PrevConnector) then // PrevConnector := SnapConnectorToConnector(PrevConnector, ConnectedConn, false); end; end; if (ConnectedConn <> nil) and (not ConnectedConn.Deleted) then // tolik -- 23/09/2016-- // ConnectedConn.Move(ActualPoints[1].x - ConnectedConn.ActualPoints[1].x, ActualPoints[1].y - ConnectedConn.ActualPoints[1].y); ConnectedConn.Move(ActualPX - ConnectedConn.ActualPoints[1].x, ActualPY - ConnectedConn.ActualPoints[1].y); // // Tolik 13/02/2021 -- выравнять присоединенные трассы по коннектору for i := 0 to PrevConnector.JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(PrevConnector.JoinedOrthoLinesList[i]).Joinconnector1.Id = PrevConnector.ID then TOrthoLine(PrevConnector.JoinedOrthoLinesList[i]).ActualPoints[1] := PrevConnector.ap1 else if TOrthoLine(PrevConnector.JoinedOrthoLinesList[i]).Joinconnector2.Id = PrevConnector.ID then TOrthoLine(PrevConnector.JoinedOrthoLinesList[i]).ActualPoints[2] := PrevConnector.ap1; end; end; end; // если был райз на поинте -- выполняем проверку на удаление // если не нужен -- будет удален if RaiseLine <> nil then begin if SnappedList.Count > 0 then begin ConnectedConn := nil; // Tolik -- выравнять райз (с трассами) if RaiseLine.JoinConnector1.ID = PrevConnector.ID then connectedConn := TConnectorObject(RaiseLine.JoinConnector2) else if RaiseLine.JoinConnector2.ID = PrevConnector.ID then connectedConn := TConnectorObject(RaiseLine.JoinConnector1); if ConnectedConn <> nil then begin ConnectedConn.ActualPoints[1] := PrevConnector.Ap1; for i := 0 to ConnectedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(ConnectedConn.JoinedOrthoLinesList[i]).Joinconnector1.Id = ConnectedConn.ID then TOrthoLine(ConnectedConn.JoinedOrthoLinesList[i]).ActualPoints[1] := ConnectedConn.ap1 else if TOrthoLine(ConnectedConn.JoinedOrthoLinesList[i]).Joinconnector2.Id = ConnectedConn.ID then TOrthoLine(ConnectedConn.JoinedOrthoLinesList[i]).ActualPoints[2] := ConnectedConn.ap1 end; end; // //if SnappedList.Count = 1 then ConnectedConn := PrevConnector; if (RaiseLine.FObjectFromRaisedLine <> nil) and (RaiseLine.FObjectFromRaisedLine.Id = Self.Id) then RaiseLine.FObjectFromRaisedLine := ConnectedConn; if (TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise <> nil) and (TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise.ID = Self.ID) then TConnectorObject(RaiseLine.JoinConnector1).FObjectFromRaise := ConnectedConn; if (TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise <> nil) and (TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise.ID = Self.ID) then TConnectorObject(RaiseLine.JoinConnector2).FObjectFromRaise := ConnectedConn; end; CheckDeleteRaiseOnPointObject; end; FreeAndNil(SnappedList); except //on E: Exception do addExceptionToLogEx('TConnectorObject.Delete', E.Message); on E: Exception do addExceptionToLogEx('TConnectorObject.Delete ' + inttostr(ID), E.Message); end; end; (* procedure TConnectorObject.Delete(Recurse: Boolean = True; DelRaise: Boolean = True); var i, j: integer; JoinedConn: TConnectorObject; RaiseLine: TOrthoLine; RaiseConn: TConnectorObject; ConnectedConn: TConnectorObject; ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; JoinedLine: TOrthoLine; CurGCadForm: TF_CAD; ObjParams: TObjectParams; SnappedList: TList; PrevConnector: TConnectorObject; // Tolik -- 23/09/2016 -- ActualPX, ActualPY: Double; // begin try SnappedList := TList.Create; if Not Deleted then begin // Tolik -- 23/09/2016-- ActualPX := Self.ActualPoints[1].x; ActualPY := Self.ActualPoints[1].y; // if Owner <> nil then //07.11.2011 TF_CAD(TPowerCad(Owner).Owner).RemoveSCSFigure(Self); // House if FIsHouseJoined then FHouse.fJoined.Remove(Self); if FIsApproach then fHouse.fApproaches.Remove(Self); // if CheckTrunkObject(Self) then begin //Tolik FreeAndNil(SnappedList); // DeleteTrunkObject(Self); Exit; end; // ObjFromRaise if DelRaise then begin RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin DeleteRaiseOtherFloor(RaiseConn); end; if RaiseConn.ConnectorType = ct_clear then begin RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; end; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; RaiseLine := GetRaiseLine(RaiseConn); if RaiseLine <> nil then begin TOrthoLine(RaiseLine).Delete; end; end; end; // это конечный объект if AsEndPoint then begin GEndPoint := Nil; GListWithEndPoint := Nil; end; // м-э переход if (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_TrunkUp) or (FConnRaiseType = crt_TrunkDown)then begin DeleteRaiseOtherFloor(Self); end; if ConnectorType <> ct_Clear then begin // если есть с-п удалить и его RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(RaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then RaiseLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); TOrthoLine(RaiseLine).Delete; RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; end else if FConnRaiseType <> crt_None then begin RaiseLine := GetRaiseLine(Self); TOrthoLine(RaiseLine).Delete; end; while JoinedConnectorsList.Count > 0 do begin JoinedConn := TConnectorObject(JoinedConnectorsList[0]); UnsnapConnectorFromPointObject(JoinedConn, Self); SnappedList.Add(JoinedConn); end; end; if AsEndPoint then begin GEndPoint := nil; GListWithEndPoint := nil; end; Deleted := True; if Self = GLastConnector then GLastConnector := nil; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // TPowerCad(Owner).Figures.Remove(Self); //07/11/2015 // if Assigned(CaptionsGroup) then CaptionsGroup.Delete; if Assigned(NotesGroup) then NotesGroup.Delete; if Assigned(DrawFigure) then begin DrawFigure.Delete; TPowerCad(Owner).Figures.Remove(DrawFigure); //07/11/2015 end; i := 0; if Recurse then begin while i < JoinedOrtholinesList.Count do begin TOrthoLine(JoinedOrtholinesList[i]).Delete; i := i + 1; end; end; end; // удалить ссылки на конектор из привязанных конекторов for i := 0 to JoinedConnectorslist.Count - 1 do begin JoinedConn := TConnectorObject(JoinedConnectorslist[i]); //Tolik 07/11/2015 { хуйня кака-то ... будут дубли(подряд) - проскочит j := 0; while j < JoinedConn.JoinedConnectorslist.Count do begin if TFigure(JoinedConn.JoinedConnectorslist[j]) = Self then JoinedConn.JoinedConnectorslist.Remove(Self); j := j + 1; end; } // лучше так: while JoinedConn.JoinedConnectorslist.IndexOf(Self) <> -1 do JoinedConn.JoinedConnectorslist.Remove(Self); // end; // присоединить коннекторы отвязанные от РТ if SnappedList.Count > 0 then begin PrevConnector := TConnectorObject(SnappedList[0]); if (PrevConnector <> nil) and (not PrevConnector.Deleted) then begin ConnectedConn := nil; for i := 1 to SnappedList.Count - 1 do begin ConnectedConn := TConnectorObject(SnappedList[i]); if (ConnectedConn <> nil) and (not ConnectedConn.Deleted) then begin SnapConnectorToConnector(ConnectedConn, PrevConnector); PrevConnector := ConnectedConn; end; end; if (ConnectedConn <> nil) and (not ConnectedConn.Deleted) then // tolik -- 23/09/2016-- // ConnectedConn.Move(ActualPoints[1].x - ConnectedConn.ActualPoints[1].x, ActualPoints[1].y - ConnectedConn.ActualPoints[1].y); ConnectedConn.Move(ActualPX - ConnectedConn.ActualPoints[1].x, ActualPY - ConnectedConn.ActualPoints[1].y); // end; end; FreeAndNil(SnappedList); except on E: Exception do addExceptionToLogEx('TConnectorObject.Delete', E.Message); end; end; *) procedure TFigureGrpMod.Delete; begin try if Not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); TPowerCad(Owner).Figures.Remove(Self); // end; except on E: Exception do addExceptionToLogEx('TFigureGrpMod.Delete', E.Message); end; end; // Tolik -- 21/11/2016-- старая закомменчена -- см ниже procedure TOrthoLine.Delete; var i,j: integer; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; ObjParams: TObjectParams; RaiseLine, RelatedRaiseLine: TOrthoLine; RemJoinConn1, RemJoinConn2: Integer; // Tolik 29/09/2017 -- CrossLine: TOrthoLine; PointDeleted: Boolean; CrossInfo: POrthoLineCrossInfo; CrossLinesList: TList; // function isTrunk(aLine: TOrthoLine): Boolean; var currConn: TConnectorObject; begin Result := False; currConn := TConnectorObject(aLine.JoinConnector1); if (currConn <> nil) and (not currConn.deleted) then begin if (CurrConn.FConnRaiseType = crt_BetweenFloorUp) or (currConn.FConnRaiseType = crt_BetweenFloorDown) or (CurrConn.FConnRaiseType = crt_TrunkUp) or (currConn.FConnRaiseType = crt_TrunkDown) then begin Result := True; exit; end; end else exit; currConn := TConnectorObject(aLine.JoinConnector2); if (currConn <> nil) and (not currConn.deleted) then begin if (CurrConn.FConnRaiseType = crt_BetweenFloorUp) or (currConn.FConnRaiseType = crt_BetweenFloorDown) or (CurrConn.FConnRaiseType = crt_TrunkUp) or (currConn.FConnRaiseType = crt_TrunkDown) then begin Result := True; exit; end; end end; // Tolik 06/01/2016 -- Function CheckCanDelRaise(aRaiseLine: TOrthoLine) : boolean; var i: Integer; begin Result := True; for i := 0 to TConnectorObject(aRaiseLine.JoinConnector1).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(aRaiseLine.JoinConnector1).JoinedOrtholinesList[i]).ID <> aRaiseLine.ID) and (not TOrthoLine(TConnectorObject(aRaiseLine.JoinConnector1).JoinedOrtholinesList[i]).Deleted) then begin Result := False; break; end; end; if Result then begin for i := 0 to TConnectorObject(aRaiseLine.JoinConnector2).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(aRaiseLine.JoinConnector2).JoinedOrtholinesList[i]).ID <> aRaiseLine.ID) and (not TOrthoLine(TConnectorObject(aRaiseLine.JoinConnector2).JoinedOrtholinesList[i]).Deleted) then begin Result := False; break; end; end; end; end; begin //если трасса удалена -- нах отсюда if Deleted then exit; // Tolik 21/05/2019 -- if GPrevFigureTraceTo <> nil then if ID = GPrevFigureTraceTo.ID then GPrevFigureTraceTo := nil; if GPrevFigureSnap <> nil then if ID = GPrevFigureSnap.ID then GPrevFigureSnap := nil; if GFigureSnap <> nil then if ID = GFigureSnap.ID then GFigureSnap := nil; // BeginProgress; //Tolik -- 25/07/2017 -- DeleteObjectFromPM(Self.Id, Self.Name); // RaiseConn := Nil; // Tolik 18/10/2017 -- try RemJoinConn1 := 0; RemJoinConn2 := 0; if Owner <> nil then //07.11.2011 TF_CAD(TPowerCad(Owner).Owner).RemoveSCSFigure(Self); // c-п if FIsRaiseUpDown then begin ObjFromRaise := FObjectFromRaisedLine; if ObjFromRaise <> nil then RaiseConn := GetRaiseConn(ObjFromRaise); if RaiseConn <> nil then begin if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin DeleteRaiseOtherFloor(RaiseConn); end; if RaiseConn.ConnectorType = ct_clear then begin RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; end; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; end; end; Deleted := True; //Tolik //GCadForm.FRemFigures.Add(Self); // хз откуда пришло удаление и кто такой в момент удаления GCadForm // может быть и не тот, на котором находится удаляемый компонент TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // Tolik 04/02/2021 -- {if Assigned(CaptionsGroup) then CaptionsGroup.Delete; if Assigned(NotesGroup) then NotesGroup.Delete; if Assigned(MultilineCaptionBox) then TTextMod(MultilineCaptionBox).Delete;} if Assigned(CaptionsGroup) then begin CaptionsGroup.Delete; CaptionsGroup := nil; end; if Assigned(NotesGroup) then begin NotesGroup.Delete; NotesGroup := nil; end; if Assigned(MultilineCaptionBox) then begin TTextMod(MultilineCaptionBox).Delete; MultilineCaptionBox := nil; end; // //Tolik -- FSingleBlock на КАДе уже не сидит, отдельно удалять смысла нет, если удаляется ортолиния, // то удалится при удалении FDrawFigure {if Assigned(FSingleBlock) then begin DrawFigure.RemoveFromGrp(FSingleBlock); //28.04.2011 DrawFigure.InFigures.Remove(FSingleBlock); FSingleBlock.Delete; end;} FSingleBlock := nil; { if Assigned(DrawFigure) then DrawFigure.Delete;} if Assigned(FDrawFigure) then begin FDrawFigure.Delete; FDrawFigure := nil; // Tolik 04/02/2021 -- end; // Tolik -- 22/11/2016 -- это все нах не нужно, т.к. PCad.GiuEvent сам проверит коннектор и отправит его на удаление // если у него не остается присоединенных трасс { if JoinConnector1 <> nil then if TConnectorObject(JoinConnector1).ConnectorType = ct_Clear then begin if TConnectorObject(JoinConnector1).JoinedOrtholinesList.Count = 1 then begin if TConnectorObject(JoinConnector1).JoinedOrtholinesList[0] = Self then begin if not TConnectorObject(JoinConnector1).FIsHouseJoined then begin if TConnectorObject(JoinConnector1).FGroupObject <> nil then TConnectorObject(JoinConnector1).FGroupObject.RemoveFromGrp(JoinConnector1); //28.04.2011 TConnectorObject(JoinConnector1).FGroupObject.InFigures.Remove(JoinConnector1); TConnectorObject(JoinConnector1).Delete; end; end; end; end; if JoinConnector2 <> nil then if TConnectorObject(JoinConnector2).ConnectorType = ct_Clear then begin if TConnectorObject(JoinConnector2).JoinedOrtholinesList.Count = 1 then if TConnectorObject(JoinConnector2).JoinedOrtholinesList[0] = Self then begin if not TConnectorObject(JoinConnector2).FIsHouseJoined then begin if TConnectorObject(JoinConnector2).FGroupObject <> nil then TConnectorObject(JoinConnector2).FGroupObject.RemoveFromGrp(JoinConnector2); //28.04.2011 TConnectorObject(JoinConnector2).FGroupObject.InFigures.Remove(JoinConnector2); TConnectorObject(JoinConnector2).Delete; end; end; end; } // убрать обьект из листа привязанных к нему обьектов if JoinConnector1 <> nil then begin if not TConnectorObject(JoinConnector1).deleted then begin if TConnectorObject(JoinConnector1).RemJoined.IndexOf(Self) = -1 then // Tolik 26/11/2020 -- на всякий... TConnectorObject(JoinConnector1).RemJoined.Add(Self); // если осталась только адна трасса, проверяем, есть ли райз и можно ли его удалить. // если можно удалить райз -- удаляем // если в данный момент удаляем не райз if not FIsRaiseUpDown then begin if ((TConnectorObject(JoinConnector1).JoinedOrtholinesList.Count - TConnectorObject(JoinConnector1).RemJoined.Count) = 1) then begin RaiseLine := nil; RelatedRaiseLine := Nil; for i := 0 to TConnectorObject(JoinConnector1).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(JoinConnector1).JoinedOrtholinesList[i]).FIsRaiseUpDown and (not TOrthoLine(TConnectorObject(JoinConnector1).JoinedOrtholinesList[i]).Deleted)) then begin RaiseLine := TOrthoLine(TConnectorObject(JoinConnector1).JoinedOrtholinesList[i]); Break; //// BREAK ////; end; end; // если райз есть, а в списке на удаление его нет if (RaiseLine <> nil) and (TConnectorObject(JoinConnector1).RemJoined.IndexOf(RaiseLine) = -1) then begin // Tolik -- 06/01/2017 -- так будет правильно if TConnectorObject(JoinConnector1).JoinedOrthoLinesList.Count - TConnectorObject(JoinConnector1).RemJoined.Count = 1 then begin if not isTrunk(RaiseLine) then RaiseLine.Delete; //RaiseLine.Delete; // CheckDeleteRaise(RaiseLine); {if CheckCanDelRaise(RaiseLine) then if (TConnectorObject(JoinConnector1).RemJoined.IndexOf(RaiseLine) = -1) then (TConnectorObject(JoinConnector1).RemJoined.Add(RaiseLine));} //RaiseLine.Delete; // end; end; end; end // Tolik 26/11/2020 else begin if isTrunk(Self) then if TConnectorObject(JoinConnector1).RemJoined.IndexOf(Self) = -1 then TConnectorObject(JoinConnector1).RemJoined.Add(Self); end; // end; end; if JoinConnector2 <> nil then begin if not TConnectorObject(JoinConnector2).deleted then begin if TConnectorObject(JoinConnector2).RemJoined.IndexOf(Self) = -1 then // Tolik 26/11/2020 -- на всякий TConnectorObject(JoinConnector2).RemJoined.Add(Self); // если в данный момент удаляем не райз if not FIsRaiseUpDown then begin if ((TConnectorObject(JoinConnector2).JoinedOrtholinesList.Count - TConnectorObject(JoinConnector2).RemJoined.Count) = 1) then begin RaiseLine := nil; RelatedRaiseLine := Nil; for i := 0 to TConnectorObject(JoinConnector2).JoinedOrtholinesList.Count - 1 do begin if (TOrthoLine(TConnectorObject(JoinConnector2).JoinedOrtholinesList[i]).FIsRaiseUpDown and (not TOrthoLine(TConnectorObject(JoinConnector2).JoinedOrtholinesList[i]).Deleted)) then begin RaiseLine := TOrthoLine(TConnectorObject(JoinConnector2).JoinedOrtholinesList[i]); Break; //// BREAK ////; end; end; // если райз есть, а в списке на удаление его нет if (RaiseLine <> nil) and (TConnectorObject(JoinConnector2).RemJoined.IndexOf(RaiseLine) = -1) then begin if TConnectorObject(JoinConnector2).JoinedOrthoLinesList.Count - TConnectorObject(JoinConnector2).RemJoined.Count = 1 then begin // если это простой с/п -- удалить его нах // Tolik -- 06/01/2017 -- так будет правильно if not isTrunk(RaiseLine) then RaiseLine.Delete; //CheckDeleteRaise(RaiseLine); {if CheckCanDelRaise(RaiseLine) then if (TConnectorObject(JoinConnector2).RemJoined.IndexOf(RaiseLine) = -1) then (TConnectorObject(JoinConnector2).RemJoined.Add(RaiseLine));} // RaiseLine.Delete; // end; end; end; end // Tolik 26/11/2020 else begin if isTrunk(Self) then if TConnectorObject(JoinConnector2).RemJoined.IndexOf(Self) = -1 then TConnectorObject(JoinConnector2).RemJoined.Add(Self); end; // end; end; //Tolik 29/09/20107 -- сбросить пересечения с трассами if CrossList.Count > 0 then begin if Assigned(Self.Owner) then if Assigned(Self.Owner.Owner) then if TF_Cad(TPowerCad(Self.Owner).Owner).FListSettings.ShowTracesCrossPoints > 0 then begin CrossLinesList := TList.Create; for i := 0 to CrossList.Count - 1 do begin CrossInfo := POrthoLineCrossInfo(CrossList[i]); CrossLine := TOrthoLine(GetFigureByID(TF_Cad(TPowerCad(Self.Owner).Owner), CrossInfo.CrossLineID)); if CrossLine <> nil then if not CrossLine.Deleted then if CrossLinesList.IndexOf(CrossLine) = -1 then CrossLinesList.Add(CrossLine); // линии пересечения end; for i := 0 to CrossLinesList.Count - 1 do begin CrossLine := TOrthoLine(CrossLinesList[i]); PointDeleted := False; if CrossLine.CrossList.Count > 0 then begin for j := CrossLine.CrossList.Count - 1 downto 0 do begin CrossInfo := POrthoLineCrossInfo(CrossLine.CrossList[j]); if CrossInfo.CrossLineID = Self.ID then begin CrossLine.CrossList.Remove(CrossInfo); //FreeMem(CrossInfo); // память не забываем освобождать Dispose(CrossInfo); // память не забываем освобождать PointDeleted := True; end; end; if PointDeleted then CrossLine.ReCreateDrawFigureBlock; end; end; CrossLinesList.free; end; end; // освободить память, занятую списком пересечений While CrossList.Count > 0 do begin CrossInfo := POrthoLineCrossInfo(CrossList[0]); CrossList.Remove(CrossInfo); //FreeMem(CrossInfo); // память не забываем освобождать Dispose(CrossInfo); // память не забываем освобождат end; // except on E: Exception do addExceptionToLogEx('TOrthoLine.Delete', E.Message); end; EndProgress; end; (* procedure TOrthoLine.Delete; var i: integer; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; ObjParams: TObjectParams; begin try if Not Deleted then begin if Owner <> nil then //07.11.2011 TF_CAD(TPowerCad(Owner).Owner).RemoveSCSFigure(Self); // c-п if FIsRaiseUpDown then begin ObjFromRaise := FObjectFromRaisedLine; if ObjFromRaise <> nil then RaiseConn := GetRaiseConn(ObjFromRaise); if RaiseConn <> nil then begin if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin DeleteRaiseOtherFloor(RaiseConn); end; if RaiseConn.ConnectorType = ct_clear then begin RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; end; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; end; end; Deleted := True; //Tolik //GCadForm.FRemFigures.Add(Self); // хз откуда пришло удаление и кто такой в момент удаления GCadForm // может быть и не тот, на котором находится удаляемый компонент TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); if Assigned(CaptionsGroup) then CaptionsGroup.Delete; if Assigned(NotesGroup) then NotesGroup.Delete; if Assigned(MultilineCaptionBox) then TTextMod(MultilineCaptionBox).Delete; //Tolik -- FSingleBlock на КАДе уже не сидит, отдельно удалять смысла нет, если удаляется ортолиния, // то удалится при удалении FDrawFigure {if Assigned(FSingleBlock) then begin DrawFigure.RemoveFromGrp(FSingleBlock); //28.04.2011 DrawFigure.InFigures.Remove(FSingleBlock); FSingleBlock.Delete; end;} FSingleBlock := nil; { if Assigned(DrawFigure) then DrawFigure.Delete;} if Assigned(FDrawFigure) then FDrawFigure.Delete; if JoinConnector1 <> nil then if TConnectorObject(JoinConnector1).ConnectorType = ct_Clear then begin if TConnectorObject(JoinConnector1).JoinedOrtholinesList.Count = 1 then if TConnectorObject(JoinConnector1).JoinedOrtholinesList[0] = Self then begin if not TConnectorObject(JoinConnector1).FIsHouseJoined then begin if TConnectorObject(JoinConnector1).FGroupObject <> nil then TConnectorObject(JoinConnector1).FGroupObject.RemoveFromGrp(JoinConnector1); //28.04.2011 TConnectorObject(JoinConnector1).FGroupObject.InFigures.Remove(JoinConnector1); TConnectorObject(JoinConnector1).Delete; end; end; end; if JoinConnector2 <> nil then if TConnectorObject(JoinConnector2).ConnectorType = ct_Clear then begin if TConnectorObject(JoinConnector2).JoinedOrtholinesList.Count = 1 then if TConnectorObject(JoinConnector2).JoinedOrtholinesList[0] = Self then begin if not TConnectorObject(JoinConnector2).FIsHouseJoined then begin if TConnectorObject(JoinConnector2).FGroupObject <> nil then TConnectorObject(JoinConnector2).FGroupObject.RemoveFromGrp(JoinConnector2); //28.04.2011 TConnectorObject(JoinConnector2).FGroupObject.InFigures.Remove(JoinConnector2); TConnectorObject(JoinConnector2).Delete; end; end; end; // убрать обьект из листа привязанных к нему обьектов if JoinConnector1 <> nil then TConnectorObject(JoinConnector1).RemJoined.Add(Self); if JoinConnector2 <> nil then TConnectorObject(JoinConnector2).RemJoined.Add(Self); end; except on E: Exception do addExceptionToLogEx('TOrthoLine.Delete', E.Message); end; end; *) procedure TTextMod.Delete; begin try if Not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // end; except on E: Exception do addExceptionToLogEx('TTextMod.Delete', E.Message); end; end; //============================================================================== //============= TTextMod ======================================================= //============================================================================== procedure TTextMod.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); begin inherited; end; function TTextMod.isPointIn(x, y: Double): Boolean; begin result := false; result := inherited isPointIn(x, y); end; procedure TTextMod.getModPoints(ModList: TMyList); begin end; procedure TTextMod.Select; begin end; procedure TTextMod.WriteToStream(Stream: TStream); begin inherited; end; procedure TTextMod.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); begin inherited; end; procedure TConnectorObject.RaiseProperties(CadFigList: TList); var i: integer; CaptionsLHandle: Integer; NotesLHandle: integer; SCSLHandle: integer; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; Name: string; mess: string; FiguresList: TList; l2, l4, l6: Integer; SCSFigureGrp: TSCSFigureGrp; Figure: TFigure; Badfigure: Boolean; // Tolik 05/10/2018 -- ObjectFromRaiseFigure: TConnectorObject; // Tolik 05/10/2018 -- // Tolik procedure ReRaiseProps; var i: integer; CaptionsLHandle: Integer; NotesLHandle: integer; SCSLHandle: integer; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; Name: string; mess: string; FiguresList: TList; l2, l4, l6: Integer; SCSFigureGrp: TSCSFigureGrp; Figure: TFigure; begin try CaptionsLHandle := GCadForm.PCad.GetLayerHandle(4); NotesLHandle := GCadForm.PCad.GetLayerHandle(6); SCSLHandle := GCadForm.PCad.GetLayerHandle(2); if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) or (DrawFigure = nil) then begin GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TConnectorObject.RaiseProperties', 'ReSETDrawFigure'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); FDrawFigure.fHasParent := true; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); FDrawFigure.LockModify := True; end; try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; if DrawFigure <> nil then begin DrawFigure.FNetworkTypes := FNetworkTypes; if FIndex = 0 then begin FIndex := GetFigureParams(ID).MarkID; end; end; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TConnectorObject.ReRaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; // begin try // // Tolik 02/09/2016 -- бывает, не успевает удалиться, а обновляться -- лезет! if Self.deleted then Exit; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := CadFigList; // GCadForm.PCad.Figures; CaptionsLHandle := GCadForm.PCad.GetLayerHandle(4); NotesLHandle := GCadForm.PCad.GetLayerHandle(6); SCSLHandle := GCadForm.PCad.GetLayerHandle(2); CaptionsGroup := nil; NotesGroup := nil; tmpCaptionsGroup := nil; tmpNotesCaptions := nil; // Tolik 06/11/2018 -- if FCaptionsGroupIndex <> -1 then begin if ((TFigure(FiguresList[FCaptionsGroupIndex]).ClassName <> 'TRichTextMod') or (TFigure(FiguresList[FCaptionsGroupIndex]).LayerHandle <> CaptionsLHandle)) then begin FCaptionsGroupIndex := -1; addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FCaptionsGroupIndex for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); end; end; if FNotesGroupIndex <> -1 then begin if ((TFigure(FiguresList[FNotesGroupIndex]).ClassName <> 'TFigureGrpNotMod') or (TFigure(FiguresList[FNotesGroupIndex]).LayerHandle <> NotesLHandle)) then begin FNotesGroupIndex := -1; addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FNotesGroupIndex for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); end; end; if ((FGroupObjectIndex = 0) or (FHouseIndex = 0) or ((FObjectFromRaiseIndex = 0) and (FObjectFromRaiseIndexForGrp = -1)) or (FObjectFromRaiseIndexForGrp = 0)) then { if ((FGroupObjectIndex = 0) or (FHouseIndex = 0) or ((FObjectFromRaiseIndex = 0) and (FObjectFromRaiseIndexForGrp = -1)) or (FObjectFromRaiseIndexForGrp = 0) or (FCaptionsGroupIndex = 0) or (FNotesGroupIndex = 0) ) then } // begin //beep; // Tolik 05/10/2018 -- BadFigure := False; if FObjectFromRaiseIndexForGrp <> -1 then begin if FObjectFromRaiseIndexForGrp < FiguresList.Count then begin if TFigure(FiguresList[FObjectFromRaiseIndexForGrp]).ClassName = 'TSCSFigureGrp' then begin SCSFigureGrp := TSCSFigureGrp(FiguresList[FObjectFromRaiseIndexForGrp]); if SCSFigureGrp <> nil then begin if SCSFigureGRP.LayerHandle <> SCSLHandle then BadFigure := True; end else BadFigure := True; if BadFigure then addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FObjectFromRaiseIndexForGrp for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); if not BadFigure then begin if FObjectFromRaiseIndex <> -1 then begin if FObjectFromRaiseIndex < SCSFigureGRP.InFigures.Count then begin if Tfigure(SCSFigureGRP.InFigures[FObjectFromRaiseIndex]).ClassName = 'TConnectorObject' then begin ObjectFromRaiseFigure := TConnectorObject(SCSFigureGRP.InFigures[FObjectFromRaiseIndex]); if ObjectFromRaiseFigure.LayerHandle <> SCSLHandle then BadFigure := True; end else BadFigure := True; end else BadFigure := True; end else BadFigure := True; if BadFigure then addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FObjectFromRaiseIndex for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); end; end else begin BadFigure := True; addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FObjectFromRaiseIndexForGrp for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); end; end else begin BadFigure := True; addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FObjectFromRaiseIndexForGrp for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); end; end else begin if FObjectFromRaiseIndex <> -1 then begin if FObjectFromRaiseIndex < FiguresList.Count then begin if TFigure(FiguresList[FObjectFromRaiseIndex]).ClassName = 'TConnectorObject' then begin ObjectFromRaiseFigure := TConnectorObject(FiguresList[FObjectFromRaiseIndex]); if ObjectFromRaiseFigure.LayerHandle <> SCSLHandle then BadFigure := True; end else BadFigure := True; end else BadFigure := True; end; if BadFigure then addExceptionToLogEx('TConnectorObject.RaiseProperties:', 'Incorrect FObjectFromRaiseIndex for TConnectorObject. Id =' + Inttostr(ID) + ' on ' + GCadForm.FCadListName); end; if BadFigure then begin FObjectFromRaiseIndex := -1; // GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TConnectorObject.RaiseProperties', 'Not SET all need figure index'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; end; end; // FGroupObject if FGroupObjectIndex <> - 1 then FGroupObject := TSCSFigureGrp(FiguresList.Items[FGroupObjectIndex]) else FGroupObject := nil; // FHouse if FHouseIndex <> - 1 then begin //10.01.2011 FHouse := THouse(FiguresList.Items[FHouseIndex]) Figure := TFigure(FiguresList.Items[FHouseIndex]); if Figure is THouse then FHouse := THouse(Figure) else begin FHouseIndex := -1; FHouse := nil; end; end else FHouse := nil; //if TFigure(FiguresList.Items[FDrawFigureIndex]).ClassName <> 'TFigureGrpMod' then if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) then begin //Beep; { НЕЛЬЗЯ СОЗДАВАТЬ НИЧЕГО НА RaiseProperties иначе поплывут след. фигуры на таких конструкциях FiguresList.Items[FDrawFigureIndex]; Это делается в доп.проходе GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TConnectorObject.RaiseProperties', 'Not SET DrawFigureIndex'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); FDrawFigure.fHasParent := true; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); FDrawFigure.LockModify := True; } //Tolik //GNeedReRaiseProperties := True; FDrawFigure := nil; ReRaiseProps; end else begin FDrawFigure := TFigureGrpMod(FiguresList.Items[FDrawFigureIndex]); if FDrawFigure <> nil then begin if not FDrawFigure.fHasParent then begin FDrawFigure.fHasParent := true; end else begin { НЕЛЬЗЯ СОЗДАВАТЬ НИЧЕГО НА RaiseProperties иначе поплывут след. фигуры на таких конструкциях FiguresList.Items[FDrawFigureIndex]; Это делается в доп.проходе GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TConnectorObject.RaiseProperties', 'Recreate DrawFigure'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); FDrawFigure.fHasParent := true; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); FDrawFigure.LockModify := True; } //Tolik //GNeedReRaiseProperties := True; FDrawFigure := nil; ReRaiseProps; end; end; end; try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; // поднять CaptionsGroup if FCaptionsGroupIndex <> -1 then begin if ConnectorType <> ct_Clear then begin // Name := OutTextCaptions.Strings[0]; // OutTextCaptions.Clear; // OutTextCaptions.Add(Name); end; tmpCaptionsGroup := TFigure(FiguresList.Items[FCaptionsGroupIndex]); // CONVERT if CheckFigureByClassName(tmpCaptionsGroup, cTFigureGrpNotMod) then begin if Not TFigureGrpNotMod(tmpCaptionsGroup).fHasParent then begin tmpCaptionsGroup := TFigureGrpNotMod(tmpCaptionsGroup); TFigureGrpNotMod(tmpCaptionsGroup).fHasParent := True; // for i := 0 to TFigureGrpNotMod(tmpCaptionsGroup).InFigures.Count - 1 do // OutTextCaptions.Add(TTextMod(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[i]).Text); end else begin tmpCaptionsGroup := nil; end; end else if CheckFigureByClassName(tmpCaptionsGroup, cTRichTextMod) then begin if Not TRichTextMod(tmpCaptionsGroup).fHasParent then begin tmpCaptionsGroup := TRichTextMod(tmpCaptionsGroup); TRichTextMod(tmpCaptionsGroup).fHasParent := True; // for i := 0 to TRichTextMod(tmpCaptionsGroup).Re.Lines.Count - 1 do // OutTextCaptions.Add(TRichTextMod(tmpCaptionsGroup).Re.Lines[i]); end else begin tmpCaptionsGroup := nil; end; end else begin tmpCaptionsGroup := nil; end; if tmpCaptionsGroup <> nil then tmpCaptionsGroup.LockModify := True; end; // поднять NotesGroup if FNotesGroupIndex <> -1 then begin OutTextNotes.Clear; NotesGroup := TFigureGrpNotMod(FiguresList.Items[FNotesGroupIndex]); if Not NotesGroup.fHasParent then begin NotesGroup.fHasParent := True; tmpNotesCaptions := TFigure(NotesGroup.InFigures[1]); // CONVERT if CheckFigureByClassName(tmpNotesCaptions, cTFigureGrpNotMod) then begin tmpNotesCaptions := TFigureGrpNotMod(tmpNotesCaptions); for i := 0 to TFigureGrpNotMod(tmpNotesCaptions).InFigures.Count - 1 do OutTextNotes.Add(TTextMod(TFigureGrpNotMod(tmpNotesCaptions).InFigures[i]).Text); TFigureGrpNotMod(NotesGroup.InFigures[1]).Visible := True; end else if CheckFigureByClassName(tmpNotesCaptions, cTRichTextMod) then begin tmpNotesCaptions := TRichTextMod(tmpNotesCaptions); for i := 0 to TRichTextMod(tmpNotesCaptions).re.Lines.Count - 1 do OutTextNotes.Add(TRichTextMod(tmpNotesCaptions).re.Lines[i]); TRichTextMod(NotesGroup.InFigures[1]).Visible := True; end else begin tmpNotesCaptions := nil; end; // ===== TFigureGrpNotMod(NotesGroup.InFigures[0]).Visible := True; NotesGroup.LockModify := True; end else begin NotesGroup := nil; end; end; // !!!SCSFigureGroup for i := 0 to Length(FJoinedConnectorsIndexesForGrp) - 1 do begin // c када if FJoinedConnectorsIndexesForGrp[i] = $FFFF then begin JoinedConnectorsList.Add(FiguresList.Items[FJoinedConnectorsIndexes[i]]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinedConnectorsIndexesForGrp[i]]); if SCSFigureGrp <> nil then JoinedConnectorsList.Add(SCSFigureGrp.InFigures.Items[FJoinedConnectorsIndexes[i]]); end; end; if FObjectFromRaiseIndex = -1 then begin FObjectFromRaise := Nil; end else begin // FObjectFromRaise // c када if FObjectFromRaiseIndexForGrp = -1 then begin FObjectFromRaise := TConnectorObject(FiguresList.Items[FObjectFromRaiseIndex]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FObjectFromRaiseIndexForGrp]); if SCSFigureGrp <> nil then FObjectFromRaise := TConnectorObject(SCSFigureGrp.InFigures.Items[FObjectFromRaiseIndex]) else FObjectFromRaise := nil; end; LockMove := True; LockModify := True; end; if ConnectorType = ct_Clear then begin if JoinedConnectorsList.Count > 0 then begin if CheckTrunkObject(TConnectorObject(JoinedConnectorsList[0])) then begin LockSelect := true; LockModify := true; LockMove := true; end; end; end; // if DrawFigure <> nil then begin DrawFigure.FNetworkTypes := FNetworkTypes; if FIndex = 0 then begin FIndex := GetFigureParams(ID).MarkID; end; end; // FBlockGUID if FBlockGUID = '' then FBlockGUID := GetIconGUIDByIconID(FBlockID); // размер шрифта для подписей if FCaptionsFontSize = -1 then FCaptionsFontSize := GCadForm.FConnectorsCaptionsFontSize; // размер шрифта для выносок if FNotesFontSize = -1 then FNotesFontSize := GCadForm.FConnectorsNotesFontSize; // цвет подписей if FCaptionsFontColor = -1 then FCaptionsFontColor := GCadForm.FConnectorsCaptionsColor; // цвет выносок if FNotesFontColor = -1 then FNotesFontColor := GCadForm.FConnectorsNotesColor; // DrawFigurePercent if (FOriginalSizeX = -1) and (FOriginalSizeY = -1) then begin FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; end; if AsEndPoint then begin GEndPoint := Self; GListWithEndPoint := GCadForm; end; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TConnectorObject.RaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; // Tolik 13/06/2017 -- if CaptionsGroup <> nil then CaptionsGroup.Visible := ShowCaptions; if NotesGroup <> nil then begin if IsNoteExist(NotesGroup) then NotesGroup.Visible := ShowNotes else NotesGroup.Visible := false; end; // end; procedure TConnectorObject.ReRaiseProperties; var i: integer; CaptionsLHandle: Integer; NotesLHandle: integer; SCSLHandle: integer; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; Name: string; mess: string; FiguresList: TList; l2, l4, l6: Integer; SCSFigureGrp: TSCSFigureGrp; Figure: TFigure; begin try // if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; CaptionsLHandle := GCadForm.PCad.GetLayerHandle(4); NotesLHandle := GCadForm.PCad.GetLayerHandle(6); SCSLHandle := GCadForm.PCad.GetLayerHandle(2); if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) or (DrawFigure = nil) then begin GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TConnectorObject.RaiseProperties', 'ReSETDrawFigure'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); FDrawFigure.fHasParent := true; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); FDrawFigure.LockModify := True; end; try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; if DrawFigure <> nil then begin DrawFigure.FNetworkTypes := FNetworkTypes; if FIndex = 0 then begin FIndex := GetFigureParams(ID).MarkID; end; end; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TConnectorObject.ReRaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; // Tolik (оригинал закомменчен см. ниже) // а здесь, поскольку все уже "зя", создаем все, чего нужно(за один проход) // (концепция поменялась, немножко переделано совсем ...) // FSingleBlock удаляем с КАДа совсем, буде сидеть в FDrswFigure.InFigutres[0]; // старые проекты пересохранятся уже правильно (так же) procedure TOrthoLine.RaiseProperties(CadFigList: TList); var i: integer; ConnectedConn: TConnectorObject; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; mess: string; Join1, Join2: TFigure; FiguresList: TList; l2, l3, l5: Integer; SCSLHandle: integer; SCSFigureGrp: TSCSFigureGrp; // Tolik CanRaiseBlock: Boolean; BadFigure: Boolean; // 05/11/2018 ObjectFromRaiseFigure: TconnectorObject; CaptionsLHandle: Integer; NotesLHandle: integer; function CheckBadFiguresByIndexes(var aIndex: Integer; var aGRPIndex: integer; aIndexName, aGRPIndexName: string): boolean; // Tolik 05/11/2018 -- begin Result := False; if aGRPIndex <> -1 then begin if aGRPIndex < FiguresList.Count then begin if TFigure(FiguresList[aGRPIndex]).ClassName = 'TSCSFigureGrp' then begin SCSFigureGrp := TSCSFigureGrp(FiguresList[aGRPIndex]); if SCSFigureGrp <> nil then begin if SCSFigureGRP.LayerHandle <> SCSLHandle then Result := True; end else Result := True; if Result then addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect ' + aGRPIndexName + ' for TOrthoLine ' + Name + ' '+ Inttostr(FIndex) + ' on ' + GCadForm.FCadListName); if not Result then begin if aIndex <> -1 then begin if aIndex < SCSFigureGRP.InFigures.Count then begin if Tfigure(SCSFigureGRP.InFigures[aIndex]).ClassName = 'TConnectorObject' then begin ObjectFromRaiseFigure := TConnectorObject(SCSFigureGRP.InFigures[aIndex]); if ObjectFromRaiseFigure.LayerHandle <> SCSLHandle then Result := True; end else Result := True; end else Result := True; end else Result := True; if Result then addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect ' + aIndexName + ' for TOrthoLine ' + Name + ' '+ Inttostr(FIndex) + ' on ' + GCadForm.FCadListName); end; end else begin Result := True; addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect ' + aGRPIndexName + ' for TOrthoLine ' + Name + ' '+ Inttostr(FIndex) + ' on ' + GCadForm.FCadListName); end; end else begin Result := True; addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect ' + aGRPIndexName + ' for TOrthoLine ' + Name + ' '+ Inttostr(FIndex) + ' on ' + GCadForm.FCadListName); end; end else begin if aIndex <> -1 then begin if aIndex < FiguresList.Count then begin if TFigure(FiguresList[aIndex]).ClassName = 'TConnectorObject' then begin ObjectFromRaiseFigure := TConnectorObject(FiguresList[aIndex]); if ObjectFromRaiseFigure.LayerHandle <> SCSLHandle then Result := True; end else Result := True; end else Result := True; end; if Result then addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect ' + aIndexName + ' for TOrthoLine ' + Name + ' '+ Inttostr(FIndex) + ' on ' + GCadForm.FCadListName); end; if Result then begin aIndex := -1; aGRPIndex := -1; end; end; // procedure ReRaiseProps; var mess: string; //SCSLHandle: integer; begin try //SCSLHandle := GCadForm.PCad.GetLayerHandle(2); If FSingleBlock = nil then FSingleBlock := TFigureGrpMod.create(SCSLHandle, self.Owner); FSingleBlock.fHasParent := True; ReCreateDrawFigureBlock; CanRaiseBlock := False; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TOrthoLine.ReRaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; begin if Deleted then // Tolik 06/11/2018 -- exit; SCSLHandle := GCadForm.PCad.GetLayerHandle(2); CaptionsLHandle := GCadForm.PCad.GetLayerHandle(3); // Tolik 06/11/2018 -- NotesLHandle := GCadForm.PCad.GetLayerHandle(5); // Tolik 06/11/2018 -- try // if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := CadFigList; // GCadForm.PCad.Figures; // Tolik -- если пришла битая фигура -- помечаем, как удаленную, выставляем признак, что проект // поднят некорректно -- дальше уже на усмотрение пользователя, а мы отсюда вываливаемся if (FIndex = 0) and (FNotesFontColor <= 0) then begin FtraceCaptionsList := Nil; OutTextNotes := nil; OutTextCaptions := nil; SetLength(FActualZOrder, 0); FDrawFigure := nil; FSingleBlock := Nil; NotesGroup := Nil; CaptionsGroup := Nil; // поднять связующие обьекты ортолинии (чтобы и коннекторы ортолинии могли нах удалиться ) if FJoinFigure1Index <> - 1 then begin // Join1 // c када if FJoinFigure1IndexForGrp = -1 then begin Join1 := TFigure(FiguresList.Items[FJoinFigure1Index]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinFigure1IndexForGrp]); if SCSFigureGrp <> nil then Join1 := TFigure(SCSFigureGrp.InFigures.Items[FJoinFigure1Index]) else Join1 := nil; end; if (Join1 <> nil) and (ConnectorDetect(Join1)) then SetJConnector1(TConnectorObject(Join1)) else begin JoinConnector1 := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector1).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector1), False); SetJConnector1(TConnectorObject(JoinConnector1)); end; end else begin JoinConnector1 := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector1).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector1), False); SetJConnector1(TConnectorObject(JoinConnector1)); end; if FJoinFigure2Index <> - 1 then begin // Join2 // c када if FJoinFigure2IndexForGrp = -1 then begin Join2 := TFigure(FiguresList.Items[FJoinFigure2Index]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinFigure2IndexForGrp]); if SCSFigureGrp <> nil then Join2 := TFigure(SCSFigureGrp.InFigures.Items[FJoinFigure2Index]) else Join2 := nil; end; if (Join2 <> nil) and (ConnectorDetect(Join2)) then SetJConnector2(Join2) else begin JoinConnector2 := TConnectorObject.Create(ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector2).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector2), False); SetJConnector2(TConnectorObject(JoinConnector2)); end; end else begin JoinConnector2 := TConnectorObject.Create(ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector2).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector2), False); SetJConnector2(TConnectorObject(JoinConnector2)); end; Inc(GExceptionCount); GProjectHasBrokenFigures := True; // признак наличия битых СКС фигур в проекте Delete; Exit; end; // ConnectedConn := nil; CaptionsGroup := nil; NotesGroup := nil; tmpCaptionsGroup := nil; tmpCaptions := nil; tmpNotesCaptions := nil; CanRaiseBlock := True; // до подъема, на всякмй случай, проверим, не создано ли чего, и все лишнее шлепаем if FSingleBlock <> nil then begin if FDrawFigure <> nil then begin if FDrawFigure.InFigures.IndexOf(FSingleBlock) <> -1 then FDrawFigure.InFigures.Remove(FSingleBlock); end; FSingleBlock.Delete; FSingleBlock := nil; end; if FDrawFigure <> Nil then FDrawFigure.Delete; FDrawfigure := nil; // // Tolik 6/11/2018 -- на всякий -- if FCaptionsGroupIndex <> -1 then begin if ((TFigure(FiguresList[FCaptionsGroupIndex]).ClassName <> 'TFigureGrpNotMod') or (TFigure(FiguresList[FCaptionsGroupIndex]).LayerHandle <> CaptionsLHandle)) then begin FCaptionsGroupIndex := -1; addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect FCaptionsGroupIndex for TOrthoLine '+ Name + ' '+InttoStr(FIndex) + ' on ' + GCadForm.FCadListName); end; end; if FNotesGroupIndex <> -1 then begin if ((TFigure(FiguresList[FNotesGroupIndex]).ClassName <> 'TFigureGrpNotMod') or (TFigure(FiguresList[FNotesGroupIndex]).LayerHandle <> NotesLHandle)) then begin FNotesGroupIndex := -1; addExceptionToLogEx('TOrthoLine.RaiseProperties:', 'Incorrect FNotesGroupIndex for TOrthoLine ' + Name + ' '+ Inttostr(FIndex) + ' on ' + GCadForm.FCadListName); end; end; { if ((FGroupObjectIndex = 0) or (FJoinFigure1Index = 0) or (FJoinFigure2Index = 0) or ( FJoinFigure1IndexForGrp = 0 ) or ( FJoinFigure2IndexForGrp = 0 ) or (FObjectFromRaisedLineIndex = 0) or (FObjectFromRaisedLineIndexForGrp = 0) or (FCaptionsGroupIndex = 0) or (FNotesGroupIndex = 0) ) then } if ((FGroupObjectIndex = 0) or (FJoinFigure1Index = 0) or (FJoinFigure2Index = 0) or ( FJoinFigure1IndexForGrp = 0 ) or ( FJoinFigure2IndexForGrp = 0 ) or ((FObjectFromRaisedLineIndex <> -1) and (FObjectFromRaisedLineIndexForGrp = -1)) or (FObjectFromRaisedLineIndexForGrp = 0)) then // begin //beep; // Tolik 05/10/2018 -- // FObjectFromRaisedLine check BadFigure := CheckBadFiguresByIndexes(FObjectFromRaisedLineIndex, FObjectFromRaisedLineIndexForGrp, 'FObjectFromRaisedLineIndex', 'FObjectFromRaisedLineIndexForGrp'); if not BadFigure then begin BadFigure := CheckBadFiguresByIndexes(FJoinFigure1Index, FJoinFigure1IndexForGrp, 'FJoinFigure1Index', 'FJoinFigure1IndexForGrp'); end; if not BadFigure then begin BadFigure := CheckBadFiguresByIndexes(FJoinFigure2Index, FJoinFigure2IndexForGrp, 'FJoinFigure2Index', 'FJoinFigure2IndexForGrp'); end; if BadFigure then begin // GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'Not SET all need figure index'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; end; end; if ((FCount <> 1) and (FMultilineCaptionBoxIndex = 0)) then begin //beep; GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'Not SET all need figure index'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; end; // FGroupObject if FGroupObjectIndex <> - 1 then FGroupObject := TSCSFigureGrp(FiguresList.Items[FGroupObjectIndex]) else FGroupObject := nil; //SCSLHandle := GCadForm.PCad.GetLayerHandle(2); //Tolik // FSingleBlock // для старых проектов if FSingleBlockIndex <> -10000 then begin if(FSingleBlockIndex = 0) or (FSingleBlockIndex = -1) then begin FSingleBlock := nil; //Tolik ReRaiseProps; // end else begin // FSingleBlock FSingleBlock := TFigureGrpMod(FiguresList.Items[FSingleBlockIndex]); try if FSingleBlock <> nil then begin if not FSingleBlock.fHasParent then begin SetLayerHandleForFigureGrp(FSingleBlock, SCSLHandle); FSingleBlock.fHasParent := true; end else begin FSingleBlock := nil; ReRaiseProps; end; end; except end; end; end; // DrawFigure //igor // Tolik // если не было пересоздания (для старых проектов) if FdrawFigure = nil then begin if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) then // битая фигура, пересоздаем нах begin FDrawFigure := nil; ReRaiseProps; end else begin FDrawFigure := TFigureGrpMod(FiguresList.Items[FDrawFigureIndex]); if FDrawFigure <> nil then begin // ФИГУРА ОТРИСОВКИ // если непустая и парента нет - поднимаем if FDrawFigure.InFigures.Count <> 0 then begin if not FDrawFigure.fHasParent then begin FDrawFigure.fHasParent := true; if FSingleBlock <> nil then // если поднялся (старый проект) begin for i := 0 to FDrawFigure.InFigures.Count - 1 do begin if FSingleBlock.ID = TFigureGrpMod(FDrawFigure.InFigures[i]).ID then begin FSingleBlock.Delete; // для старых проектов - убираем с КАДа FSingleBlock := TFigureGrpMod(FDrawFigure.InFigures[i]); // теоретически здесь сидит по-любому CanRaiseBlock := False; break; end; end; end; // не поднялся (для старых проектов) if (FSingleBlockIndex <> -10000) and (FSingleBlock = nil) then begin FDrawFigure := nil; // сброс ReRaiseProps; // пересоздаем (старый проект) end; end else // если задан парент дравфигуры - пересоздаем begin FDrawFigure := nil; ReRaiseProps; end; end // если пустая - пересоздаем else begin FDrawFigure := nil; ReRaiseProps; end; end else // фигура отрисовки не поднялась - пересоздаем ReRaiseProps; end; end; // для новых (блок отрисовки) if (CanRaiseBlock and (FSingleBlockIndex = -10000)) then // если не поднят еще, то здесь будет NIL begin if FDrawFigure <> nil then begin if FDrawFigure.InFigures.Count > 0 then FSingleBlock := TFigureGrpMod(FDrawFigure.InFigures[0]); // теоретически должен сидеть здесь if FSingleBlock = nil then // если не поднялся вдруг - пересоздаем вместе с фигурой отрисовки ReRaiseProps; end else ReRaiseProps; end; if FSingleBlock <> nil then // на всякий (вдруг проскочил), все равно с КАДа убираем TF_CAD(TF_CAD(FSingleBlock.Owner).Owner).PCad.Figures.Remove(FSingleBlock); try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; // поднять связующие обьекты ортолинии if FJoinFigure1Index <> - 1 then begin // Join1 // c када if FJoinFigure1IndexForGrp = -1 then begin Join1 := TFigure(FiguresList.Items[FJoinFigure1Index]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinFigure1IndexForGrp]); if SCSFigureGrp <> nil then Join1 := TFigure(SCSFigureGrp.InFigures.Items[FJoinFigure1Index]) else Join1 := nil; end; if (Join1 <> nil) and (ConnectorDetect(Join1)) then SetJConnector1(TConnectorObject(Join1)) else begin JoinConnector1 := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector1).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector1), False); SetJConnector1(TConnectorObject(JoinConnector1)); end; end else begin JoinConnector1 := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector1).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector1), False); SetJConnector1(TConnectorObject(JoinConnector1)); end; if FJoinFigure2Index <> - 1 then begin // Join2 // c када if FJoinFigure2IndexForGrp = -1 then begin Join2 := TFigure(FiguresList.Items[FJoinFigure2Index]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinFigure2IndexForGrp]); if SCSFigureGrp <> nil then Join2 := TFigure(SCSFigureGrp.InFigures.Items[FJoinFigure2Index]) else Join2 := nil; end; if (Join2 <> nil) and (ConnectorDetect(Join2)) then SetJConnector2(Join2) else begin JoinConnector2 := TConnectorObject.Create(ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector2).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector2), False); SetJConnector2(TConnectorObject(JoinConnector2)); end; end else begin JoinConnector2 := TConnectorObject.Create(ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector2).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector2), False); SetJConnector2(TConnectorObject(JoinConnector2)); end; if FObjectFromRaisedLineIndex = -1 then begin FObjectFromRaisedLine := Nil; FIsRaiseUpDown := False; end else begin // FObjectFromRaisedLineIndex // c када if FObjectFromRaisedLineIndexForGrp = -1 then begin FObjectFromRaisedLine := TConnectorObject(FiguresList.Items[FObjectFromRaisedLineIndex]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FObjectFromRaisedLineIndexForGrp]); if SCSFigureGrp <> nil then FObjectFromRaisedLine := TConnectorObject(SCSFigureGrp.InFigures.Items[FObjectFromRaisedLineIndex]) else FObjectFromRaisedLine := nil; end; FIsRaiseUpDown := True; LockMove := True; LockModify := True; if JoinConnector1 <> nil then if TConnectorObject(JoinConnector1).FConnRaiseType = crt_None then if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count > 0 then ConnectedConn := TConnectorObject(JoinConnector1); if JoinConnector2 <> nil then if TConnectorObject(JoinConnector2).FConnRaiseType = crt_None then if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count > 0 then ConnectedConn := TConnectorObject(JoinConnector2); if ConnectedConn <> nil then begin ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; end; end; // поднять CaptionsGroup if FCaptionsGroupIndex <> -1 then begin tmpCaptionsGroup := TFigure(FiguresList.Items[FCaptionsGroupIndex]); // CONVERT if CheckFigureByClassName(tmpCaptionsGroup, cTFigureGrpNotMod) then begin if Not TFigureGrpNotMod(tmpCaptionsGroup).fHasParent then begin TFigureGrpNotMod(tmpCaptionsGroup).fHasParent := True; tmpCaptionsGroup := TFigureGrpNotMod(tmpCaptionsGroup); // Tolik 06/03/2017 --- если не показывать длину, то воткнуть длину в описание длины if not Self.ShowLength then OutTextCaptions.Add(FormatFloat('0.00', Self.LineLength)); // // Самый новый формат if (TFigureGrpNotMod(tmpCaptionsGroup).InFigures.Count = 2) and CheckFigureByClassName(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[1], cTRichTextMod) then begin tmpCaptions := TRichTextMod(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[1]); for i := 0 to TRichTextMod(tmpCaptions).Re.Lines.Count - 1 do OutTextCaptions.Add(TRichTextMod(tmpCaptions).Re.Lines[i]); TRichTextMod(tmpCaptions).Visible := True; end else // самый старый формат begin for i := 0 to TFigureGrpNotMod(tmpCaptionsGroup).InFigures.Count - 1 do OutTextCaptions.Add(TTextMod(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[i]).Text); tmpCaptions := nil; end; end else begin tmpCaptionsGroup := nil; end; end else if CheckFigureByClassName(tmpCaptionsGroup, cTRichTextMod) then begin if Not TRichTextMod(tmpCaptionsGroup).fHasParent then begin TRichTextMod(tmpCaptionsGroup).fHasParent := True; tmpCaptionsGroup := TRichTextMod(tmpCaptionsGroup); // Tolik 06/03/2017 --- если не показывать длину, то воткнуть длину в описание длины if not Self.ShowLength then OutTextCaptions.Add(FormatFloat('0.00', Self.LineLength)); // for i := 0 to TRichTextMod(tmpCaptionsGroup).Re.Lines.Count - 1 do OutTextCaptions.Add(TRichTextMod(tmpCaptionsGroup).Re.Lines[i]); TRichTextMod(tmpCaptionsGroup).Visible := True; tmpCaptions := nil; end else begin tmpCaptionsGroup := nil; end; end else begin tmpCaptionsGroup := nil; end; if tmpCaptionsGroup <> nil then tmpCaptionsGroup.LockModify := True; end; // поднять NotesGroup if FNotesGroupIndex <> -1 then begin NotesGroup := TFigureGrpNotMod(FiguresList.Items[FNotesGroupIndex]); // if Not NotesGroup.fHasParent then begin NotesGroup.fHasParent := True; for i := 0 to NotesGroup.InFigures.Count - 1 do begin tmpNotesCaptions:= TFigure(NotesGroup.InFigures[i]); end; // // CONVERT if CheckFigureByClassName(tmpNotesCaptions, cTFigureGrpNotMod) then begin tmpNotesCaptions := TFigureGrpNotMod(tmpNotesCaptions); for i := 0 to TFigureGrpNotMod(tmpNotesCaptions).InFigures.Count - 1 do OutTextNotes.Add(TTextMod(TFigureGrpNotMod(tmpNotesCaptions).InFigures[i]).Text); TFigureGrpNotMod(NotesGroup.InFigures[1]).Visible := True; end else if CheckFigureByClassName(tmpNotesCaptions, cTRichTextMod) then begin tmpNotesCaptions := TRichTextMod(tmpNotesCaptions); for i := 0 to TRichTextMod(tmpNotesCaptions).re.Lines.Count - 1 do OutTextNotes.Add(TRichTextMod(tmpNotesCaptions).re.Lines[i]); TRichTextMod(NotesGroup.InFigures[1]).Visible := True; end else begin tmpNotesCaptions := nil; end; TFigureGrpNotMod(NotesGroup.InFigures[0]).Visible := True; NotesGroup.LockModify := True; end else begin NotesGroup := nil; end; end; //Tolik -- 13/06/2017 -- if NotesGroup <> nil then begin if IsNoteExist(NotesGroup) then NotesGroup.Visible := ShowNotes else NotesGroup.Visible := false; end; if CaptionsGroup <> nil then CaptionsGroup.Visible := ShowCaptions; // // поднять CaptionBox, если есть if FCount <> 1 then begin MultilineCaptionBox := TFigure(FiguresList.Items[FMultilineCaptionBoxIndex]); TTextMod(MultilineCaptionBox).LockMove := True; TTextMod(MultilineCaptionBox).LockModify := True; end; if DrawFigure <> nil then begin // для DrawFigure DrawFigure.FNetworkTypes := FNetworkTypes; DrawFigure.Visible := IsShowBlock; end; if FSingleBlock <> nil then begin FSingleBlock.Visible := IsShowBlock; end; // сбросить флаг просчета длины линии на MOVE FNotRecalcLength := False; LineLength := CalculLength; if FIndex = 0 then begin FIndex := GetFigureParams(ID).MarkID; end; if FIsRaiseUpDown then if LockMove then LockMove := False; // FBlockGUID if FBlockGUID = '' then FBlockGUID := GetIconGUIDByIconID(FBlockID); // размер шрифта для подписей if FCaptionsFontSize = -1 then FCaptionsFontSize := GCadForm.FLinesCaptionsFontSize; // размер шрифта для выносок if FNotesFontSize = -1 then FNotesFontSize := GCadForm.FLinesNotesFontSize; // цвет подписей if FCaptionsFontColor = - 1 then FCaptionsFontColor := GCadForm.FLinesCaptionsColor; // цвет выносок if FNotesFontColor = - 1 then FNotesFontColor := GCadForm.FLinesNotesColor; // DrawFigurePercent if (FOriginalSizeX = -1) and (FOriginalSizeY = -1) then begin FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; end; if DrawFigure <> nil then begin if DrawFigureH = -999999 then DrawFigureH := CalcHDrawFigure; end; if CaptionsGroupH = -999999 then CaptionsGroupH := CalcHCaptionsGroup; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TOrthoLine.RaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; // старая -- на всякий (* procedure TOrthoLine.RaiseProperties(CadFigList: TList); var i: integer; ConnectedConn: TConnectorObject; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; mess: string; Join1, Join2: TFigure; FiguresList: TList; l2, l3, l5: Integer; SCSLHandle: integer; SCSFigureGrp: TSCSFigureGrp; // Tolik CanAddBlock: Boolean; procedure ReRaiseProps; var i: integer; ConnectedConn: TConnectorObject; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; mess: string; Join1, Join2: TFigure; FiguresList: TList; l2, l3, l5: Integer; SCSLHandle: integer; SCSFigureGrp: TSCSFigureGrp; begin try SCSLHandle := GCadForm.PCad.GetLayerHandle(2); // DrawFigure //igor if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) or (DrawFigure = nil) then begin GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'ReSetDrawFigure'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); FDrawFigure.fHasParent := True; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); FDrawFigure.LockModify := True; end; try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; if(FSingleBlockIndex = 0) or (FSingleBlockIndex = -1) or (FSingleBlock = nil) then begin GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'ResSetSingleBlock'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FSingleBlock := TFigureGrpMod.create(SCSLHandle, self.Owner); FSingleBlock.fHasParent := True; ////GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FSingleBlock, False); // Tolik // дубль FDrawFigure.AddFigure(FSingleBlock); /////FDrawFigure.AddFigure(TFigureGrpMod(FSingleBlock.Duplicate)); // ReCreateDrawFigureBlock end; if DrawFigure <> nil then begin // для DrawFigure DrawFigure.FNetworkTypes := FNetworkTypes; DrawFigure.Visible := IsShowBlock; end; if FSingleBlock <> nil then begin FSingleBlock.Visible := IsShowBlock; end; if DrawFigure <> nil then begin if DrawFigureH = -999999 then DrawFigureH := CalcHDrawFigure; end; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TOrthoLine.ReRaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; begin try // if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := CadFigList; // GCadForm.PCad.Figures; ConnectedConn := nil; CaptionsGroup := nil; NotesGroup := nil; tmpCaptionsGroup := nil; tmpCaptions := nil; tmpNotesCaptions := nil; if ((FGroupObjectIndex = 0) or (FJoinFigure1Index = 0) or (FJoinFigure2Index = 0) or ( FJoinFigure1IndexForGrp = 0 ) or ( FJoinFigure2IndexForGrp = 0 ) or (FObjectFromRaisedLineIndex = 0) or (FObjectFromRaisedLineIndexForGrp = 0) or (FCaptionsGroupIndex = 0) or (FNotesGroupIndex = 0) ) then begin //beep; GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'Not SET all need figure index'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; end; if ((FCount <> 1) and (FMultilineCaptionBoxIndex = 0)) then begin //beep; GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'Not SET all need figure index'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; end; // FGroupObject if FGroupObjectIndex <> - 1 then FGroupObject := TSCSFigureGrp(FiguresList.Items[FGroupObjectIndex]) else FGroupObject := nil; SCSLHandle := GCadForm.PCad.GetLayerHandle(2); // DrawFigure //igor //if TFigure(FiguresList.Items[FDrawFigureIndex]).ClassName <> 'TFigureGrpMod' then if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) then begin { НЕЛЬЗЯ СОЗДАВАТЬ НИЧЕГО НА RaiseProperties иначе поплывут след. фигуры на таких конструкциях FiguresList.Items[FDrawFigureIndex]; Это делается в доп.проходе GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'Not SET DrawFigureIndex'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; //Beep; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); //MoveTextBox(FDrawFigure, ActualPoints[1], ActualPoints[2], False); FDrawFigure.LockModify := True; } //Tolik //GNeedReRaiseProperties := True; // FDrawFigure := nil; //Tolik ReRaiseProps; // end else begin FDrawFigure := TFigureGrpMod(FiguresList.Items[FDrawFigureIndex]); if FDrawFigure <> nil then begin if not FDrawFigure.fHasParent then begin FDrawFigure.fHasParent := true; end else begin //Tolik //GNeedReRaiseProperties := True; // FDrawFigure := nil; //Tolik ReRaiseProps; // end; end; end; try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; if(FSingleBlockIndex = 0) or (FSingleBlockIndex = -1) then begin { НЕЛЬЗЯ СОЗДАВАТЬ НИЧЕГО НА RaiseProperties иначе поплывут след. фигуры на таких конструкциях FiguresList.Items[FDrawFigureIndex]; Это делается в доп.проходе GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'Not SET SingleBlockIndex'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; FSingleBlock := TFigureGrpMod.create(SCSLHandle, self.Owner); //FSingleBlock.fHasParent := True; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FSingleBlock, False); FDrawFigure.AddFigure(FSingleBlock); ReCreateDrawFigureBlock } //Tolik //GNeedReRaiseProperties := True; // FSingleBlock := nil; //Tolik ReRaiseProps; // end else begin // FSingleBlock FSingleBlock := TFigureGrpMod(FiguresList.Items[FSingleBlockIndex]); try if FSingleBlock <> nil then begin if not FSingleBlock.fHasParent then begin SetLayerHandleForFigureGrp(FSingleBlock, SCSLHandle); FSingleBlock.fHasParent := true; // Tolik // if FDrawFigure <> FSingleBlock then -- здесь так не делать в силу особенностей взаимоотношения данных фигур if (FDrawFigure.ID <> FSingleBlock.ID) and (FDrawFigure.Name <> FSingleBlock.Name) then // // if (FDrawFigure <> nil) and (FSingleBlock <> nil) then ---> лишнее, так как (FSingleBlock <> nil) - порог // вхождения в эту часть программы, а FDrawFigure в крайнем случае, пересоздастся выше, если не поднялась //Tolik begin // FDrawFigure.AddFigure(FSingleBlock); // так было, но это приводит к тому, что когда давфигура поднимется уже с блоком, второй блок добавится // в список(FDrawFigure.inFigures) тоже, причем сравнение блоков ничего не даст, так как создание происходит // отдельно, а присвоение свойств - при подъеме со стрима, так что даже два одинаковых объекта будут отличаться // (хендлами), хотя и имеют один и // тот же набор свойств, во избежание ставим проверку {CanAddBlock := True; for i := 0 to FDrawFigure.InFigures.Count - 1 do begin if ((TFigure(FDrawFigure.InFigures[i]).ID = TFigure(FSingleBlock).ID) and (TFigure(FDrawFigure.InFigures[i]).Name = TFigure(FSingleBlock).Name)) then begin CanAddBlock := False; break; end; end; if CanAddBlock then} // сам блок - это шаблон, поэтому по нему создаем дубль и засовываем в дравфигуру if FDrawFigure.InFigures.Count = 0 then FDrawFigure.AddFigure(TFigureGrpMod(FSingleBlock.Duplicate)); end; // // if (FDrawFigure <> nil) // if FDrawFigure.InFigures.Count > 0 then // FDrawFigure.InFigures[0] := FSingleBlock; end else begin { НЕЛЬЗЯ СОЗДАВАТЬ НИЧЕГО НА RaiseProperties иначе поплывут след. фигуры на таких конструкциях FiguresList.Items[FDrawFigureIndex]; Это делается в доп.проходе GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'SingleBlock recreate'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FSingleBlock := TFigureGrpMod.create(SCSLHandle, self.Owner); FSingleBlock.fHasParent := True; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FSingleBlock, False); FDrawFigure.AddFigure(FSingleBlock); ReCreateDrawFigureBlock } //Tolik //GNeedReRaiseProperties := True; // FSingleBlock := nil; //Tolik ReRaiseProps; // end; end; except end; end; // поднять связующие обьекты ортолинии if FJoinFigure1Index <> - 1 then begin // Join1 // c када if FJoinFigure1IndexForGrp = -1 then begin Join1 := TFigure(FiguresList.Items[FJoinFigure1Index]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinFigure1IndexForGrp]); if SCSFigureGrp <> nil then Join1 := TFigure(SCSFigureGrp.InFigures.Items[FJoinFigure1Index]) else Join1 := nil; end; if (Join1 <> nil) and (ConnectorDetect(Join1)) then SetJConnector1(TConnectorObject(Join1)) else begin JoinConnector1 := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector1).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector1), False); SetJConnector1(TConnectorObject(JoinConnector1)); end; end else begin JoinConnector1 := TConnectorObject.Create(ActualPoints[1].x, ActualPoints[1].y, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector1).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector1), False); SetJConnector1(TConnectorObject(JoinConnector1)); end; if FJoinFigure2Index <> - 1 then begin // Join2 // c када if FJoinFigure2IndexForGrp = -1 then begin Join2 := TFigure(FiguresList.Items[FJoinFigure2Index]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FJoinFigure2IndexForGrp]); if SCSFigureGrp <> nil then Join2 := TFigure(SCSFigureGrp.InFigures.Items[FJoinFigure2Index]) else Join2 := nil; end; if (Join2 <> nil) and (ConnectorDetect(Join2)) then SetJConnector2(Join2) else begin JoinConnector2 := TConnectorObject.Create(ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector2).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector2), False); SetJConnector2(TConnectorObject(JoinConnector2)); end; end else begin JoinConnector2 := TConnectorObject.Create(ActualPoints[2].x, ActualPoints[2].y, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); TConnectorObject(JoinConnector2).ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), TConnectorObject(JoinConnector2), False); SetJConnector2(TConnectorObject(JoinConnector2)); end; if FObjectFromRaisedLineIndex = -1 then begin FObjectFromRaisedLine := Nil; FIsRaiseUpDown := False; end else begin // FObjectFromRaisedLineIndex // c када if FJoinFigure1IndexForGrp = -1 then begin FObjectFromRaisedLine := TConnectorObject(FiguresList.Items[FObjectFromRaisedLineIndex]); end else // с группы begin SCSFigureGrp := TSCSFigureGrp(FiguresList.Items[FObjectFromRaisedLineIndexForGrp]); if SCSFigureGrp <> nil then FObjectFromRaisedLine := TConnectorObject(SCSFigureGrp.InFigures.Items[FObjectFromRaisedLineIndex]) else FObjectFromRaisedLine := nil; end; FIsRaiseUpDown := True; LockMove := True; LockModify := True; if JoinConnector1 <> nil then if TConnectorObject(JoinConnector1).FConnRaiseType = crt_None then if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count > 0 then ConnectedConn := TConnectorObject(JoinConnector1); if JoinConnector2 <> nil then if TConnectorObject(JoinConnector2).FConnRaiseType = crt_None then if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count > 0 then ConnectedConn := TConnectorObject(JoinConnector2); if ConnectedConn <> nil then begin ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; end; end; // поднять CaptionsGroup if FCaptionsGroupIndex <> -1 then begin tmpCaptionsGroup := TFigure(FiguresList.Items[FCaptionsGroupIndex]); // CONVERT if CheckFigureByClassName(tmpCaptionsGroup, cTFigureGrpNotMod) then begin if Not TFigureGrpNotMod(tmpCaptionsGroup).fHasParent then begin TFigureGrpNotMod(tmpCaptionsGroup).fHasParent := True; tmpCaptionsGroup := TFigureGrpNotMod(tmpCaptionsGroup); // Самый новый формат if (TFigureGrpNotMod(tmpCaptionsGroup).InFigures.Count = 2) and CheckFigureByClassName(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[1], cTRichTextMod) then begin tmpCaptions := TRichTextMod(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[1]); for i := 0 to TRichTextMod(tmpCaptions).Re.Lines.Count - 1 do OutTextCaptions.Add(TRichTextMod(tmpCaptions).Re.Lines[i]); TRichTextMod(tmpCaptions).Visible := True; end else // самый старый формат begin for i := 0 to TFigureGrpNotMod(tmpCaptionsGroup).InFigures.Count - 1 do OutTextCaptions.Add(TTextMod(TFigureGrpNotMod(tmpCaptionsGroup).InFigures[i]).Text); tmpCaptions := nil; end; end else begin tmpCaptionsGroup := nil; end; end else if CheckFigureByClassName(tmpCaptionsGroup, cTRichTextMod) then begin if Not TRichTextMod(tmpCaptionsGroup).fHasParent then begin TRichTextMod(tmpCaptionsGroup).fHasParent := True; tmpCaptionsGroup := TRichTextMod(tmpCaptionsGroup); for i := 0 to TRichTextMod(tmpCaptionsGroup).Re.Lines.Count - 1 do OutTextCaptions.Add(TRichTextMod(tmpCaptionsGroup).Re.Lines[i]); TRichTextMod(tmpCaptionsGroup).Visible := True; tmpCaptions := nil; end else begin tmpCaptionsGroup := nil; end; end else begin tmpCaptionsGroup := nil; end; if tmpCaptionsGroup <> nil then tmpCaptionsGroup.LockModify := True; end; // поднять NotesGroup if FNotesGroupIndex <> -1 then begin NotesGroup := TFigureGrpNotMod(FiguresList.Items[FNotesGroupIndex]); // if Not NotesGroup.fHasParent then begin NotesGroup.fHasParent := True; for i := 0 to NotesGroup.InFigures.Count - 1 do begin tmpNotesCaptions:= TFigure(NotesGroup.InFigures[i]); end; // // CONVERT if CheckFigureByClassName(tmpNotesCaptions, cTFigureGrpNotMod) then begin tmpNotesCaptions := TFigureGrpNotMod(tmpNotesCaptions); for i := 0 to TFigureGrpNotMod(tmpNotesCaptions).InFigures.Count - 1 do OutTextNotes.Add(TTextMod(TFigureGrpNotMod(tmpNotesCaptions).InFigures[i]).Text); TFigureGrpNotMod(NotesGroup.InFigures[1]).Visible := True; end else if CheckFigureByClassName(tmpNotesCaptions, cTRichTextMod) then begin tmpNotesCaptions := TRichTextMod(tmpNotesCaptions); for i := 0 to TRichTextMod(tmpNotesCaptions).re.Lines.Count - 1 do OutTextNotes.Add(TRichTextMod(tmpNotesCaptions).re.Lines[i]); TRichTextMod(NotesGroup.InFigures[1]).Visible := True; end else begin tmpNotesCaptions := nil; end; TFigureGrpNotMod(NotesGroup.InFigures[0]).Visible := True; NotesGroup.LockModify := True; end else begin NotesGroup := nil; end; end; // поднять CaptionBox, если есть if FCount <> 1 then begin MultilineCaptionBox := TFigure(FiguresList.Items[FMultilineCaptionBoxIndex]); TTextMod(MultilineCaptionBox).LockMove := True; TTextMod(MultilineCaptionBox).LockModify := True; end; if DrawFigure <> nil then begin // для DrawFigure DrawFigure.FNetworkTypes := FNetworkTypes; DrawFigure.Visible := IsShowBlock; end; if FSingleBlock <> nil then begin FSingleBlock.Visible := IsShowBlock; end; // сбросить флаг просчета длины линии на MOVE FNotRecalcLength := False; LineLength := CalculLength; if FIndex = 0 then begin FIndex := GetFigureParams(ID).MarkID; end; if FIsRaiseUpDown then if LockMove then LockMove := False; // FBlockGUID if FBlockGUID = '' then FBlockGUID := GetIconGUIDByIconID(FBlockID); // размер шрифта для подписей if FCaptionsFontSize = -1 then FCaptionsFontSize := GCadForm.FLinesCaptionsFontSize; // размер шрифта для выносок if FNotesFontSize = -1 then FNotesFontSize := GCadForm.FLinesNotesFontSize; // цвет подписей if FCaptionsFontColor = - 1 then FCaptionsFontColor := GCadForm.FLinesCaptionsColor; // цвет выносок if FNotesFontColor = - 1 then FNotesFontColor := GCadForm.FLinesNotesColor; // DrawFigurePercent if (FOriginalSizeX = -1) and (FOriginalSizeY = -1) then begin FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; end; if DrawFigure <> nil then begin if DrawFigureH = -999999 then DrawFigureH := CalcHDrawFigure; end; if CaptionsGroupH = -999999 then CaptionsGroupH := CalcHCaptionsGroup; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TOrthoLine.RaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; *) // Tolik -- 23/11/2015 -- эте процедура уже не юзается, но, на всякий, подрихтовал procedure TOrthoLine.ReRaiseProperties; var i: integer; ConnectedConn: TConnectorObject; NetTypes: TObjectNetworkTypes; NotesCaptions: TRichTextMod; mess: string; Join1, Join2: TFigure; FiguresList: TList; l2, l3, l5: Integer; SCSLHandle: integer; SCSFigureGrp: TSCSFigureGrp; begin try // if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; SCSLHandle := GCadForm.PCad.GetLayerHandle(2); // DrawFigure //igor if (FDrawFigureIndex = 0) or (FDrawFigureIndex = -1) or (DrawFigure = nil) then begin GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'ReSetDrawFigure'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FDrawFigure := TFigureGrpMod.create(SCSLHandle, Self.Owner); FDrawFigure.fHasParent := True; GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FDrawFigure, False); FDrawFigure.LockModify := True; end; try if FDrawFigure <> nil then SetLayerHandleForFigureGrp(FDrawFigure, SCSLHandle); except end; if(FSingleBlockIndex = 0) or (FSingleBlockIndex = -1) or (FSingleBlock = nil) then begin GShowMessTextInAdmBuild := False; mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; addExceptionToLogEx('TOrthoLine.RaiseProperties', 'ResSetSingleBlock'); GListRaiseWithErrors := True; GShowMessTextInAdmBuild := True; GExceptionCount := GExceptionCount - 1; FSingleBlock := TFigureGrpMod.create(SCSLHandle, self.Owner); FSingleBlock.fHasParent := True; // 23/11/2015 //GCadForm.PCad.AddCustomFigure (GLN(SCSLHandle), FSingleBlock, False); //Tolik //FDrawFigure.AddFigure(FSingleBlock); //FDrawFigure.AddFigure(TFigureGrpMod(FSingleBlock.Duplicate)); // ReCreateDrawFigureBlock end; if DrawFigure <> nil then begin // для DrawFigure DrawFigure.FNetworkTypes := FNetworkTypes; DrawFigure.Visible := IsShowBlock; end; if FSingleBlock <> nil then begin FSingleBlock.Visible := IsShowBlock; end; if DrawFigure <> nil then begin if DrawFigureH = -999999 then DrawFigureH := CalcHDrawFigure; end; // LayerCheck l2 := GCadForm.PCad.GetLayerHandle(2); if DrawFigure <> nil then if DrawFigure.LayerHandle <> l2 then DrawFigure.LayerHandle := l2; except on E: Exception do begin mess := cCadClasses_Mes13 + Name + IntToStr(FIndex) + cCadClasses_Mes14; ShowMessageByType(0, smtNone, mess, '', 0); addExceptionToLogEx('TOrthoLine.ReRaiseProperties', E.Message); GListRaiseWithErrors := True; end; end; end; procedure TConnectorObject.Select; begin try // Если пустой соединитель не видимый, то отображаем только если нажат Shift или Ctrl if Not FIsDraw and (ConnectorType = ct_Clear) then if (Not(ssShift in GGlobalShiftState)) {and (Not(ssCtrl in GGlobalShiftState))} then begin //DeSelect; Exit; ///// EXIT ///// //05.04.2011 end; if not FIsHouseJoined then inherited; if FIsApproach then begin if DrawFigure <> nil then begin DrawFigure.fFromApproach := Self; DrawFigure.fFromHouse := FHouse; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.Select', E.Message); end; end; procedure TOrthoLine.SetLineLength(const Value: Double); begin try if UserLength = -1 then FLength := Value else FLength := UserLength; except on E: Exception do addExceptionToLogEx('TOrthoLine.SetLineLength', E.Message); end; end; { TFigureGrpNotMod } procedure TFigureGrpNotMod.Delete; begin try if Not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // end; except on E: Exception do addExceptionToLogEx('TFigureGrpNotMod.Delete', E.Message); end; end; function TFigureGrpNotMod.Duplicate: TFigure; var i: integer; TempFig: TFigure; begin try Result := nil; Result := TFigureGrpNotMod.Create(LayerHandle, Owner); for i := 0 to InFigures.Count - 1 do begin TempFig := TFigure(InFigures[i]).Duplicate; TempFig.Style := ord(psClear); TFigureGrpNotMod(Result).AddFigure(TempFig); Result.Style := ord(psClear); end; except on E: Exception do addExceptionToLogEx('TFigureGrpNotMod.Duplicate', E.Message); end; end; procedure TFigureGrpNotMod.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); begin try inherited GetBounds(figMaxX, figMaxY, figMinX, figMinY); except on E: Exception do addExceptionToLogEx('TFigureGrpNotMod.GetBounds', E.Message); end; end; procedure TFigureGrpNotMod.select; begin inherited; end; procedure TFigureGrpNotMod.GetModPoints(ModList: TMyList); begin inherited; end; function TFigureGrpNotMod.IsPointIn(x, y: Double): Boolean; begin Result := false; Result := inherited isPointIn(x, y); end; procedure TFigureGrpNotMod.Move(deltax, deltay: Double); var i: integer; SCSObject: TFigure; Line: TOrthoLine; LNbr: Integer; mp: TModPoint; Button: TMouseButton; begin try // Shadow if GShadowObject = Self then begin inherited; exit; end; if ssShift in GGlobalShiftState then begin inherited; end else begin if GCadForm.PCad.SelectedCount > 1 then begin inherited; exit; end; // From SCS object LNbr := GCadForm.PCad.ActiveLayer; if (LNbr <> 5) and (LNbr <> 6) then begin inherited; // Caption Line Move if DrawStyle = mydsNormal then begin if LNbr = 3 then begin Line := Nil; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin if TOrthoLine(GCadForm.PCad.Figures[i]).CaptionsGroup <> nil then // if TOrthoLine(GCadForm.PCad.Figures[i]).CaptionsGroup.ID = ID then if TOrthoLine(GCadForm.PCad.Figures[i]).CaptionsGroup = Self then begin Line := TOrthoLine(GCadForm.PCad.Figures[i]); break; end; end; end; if Line <> nil then // Tolik -- 04/12/2015 // Line.CaptionsGroupH := Line.CalcHCaptionsGroup; -- так было // если пользователь переместил подпись линии, то выставить выравнивание для подписи линии в АВТО Line.CaptionsGroupH := Line.CalcHCaptionsGroup; Line.FCaptionsViewType := cv_Auto; // end; end; Exit; end; if DrawStyle = mydsNormal then begin if (deltax <> 0) or (deltay <> 0) then begin SCSObject := Nil; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin if TConnectorObject(GCadForm.PCad.Figures[i]).NotesGroup <> nil then // if TConnectorObject(GCadForm.PCad.Figures[i]).NotesGroup.ID = ID then if TConnectorObject(GCadForm.PCad.Figures[i]).NotesGroup = Self then begin SCSObject := TConnectorObject(GCadForm.PCad.Figures[i]); break; end; end else if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin if TOrthoLine(GCadForm.PCad.Figures[i]).NotesGroup <> nil then // if TOrthoLine(GCadForm.PCad.Figures[i]).NotesGroup.ID = ID then if TOrthoLine(GCadForm.PCad.Figures[i]).NotesGroup = Self then begin SCSObject := TOrthoLine(GCadForm.PCad.Figures[i]); break; end; end; end; if SCSObject <> nil then begin if CheckFigureByClassName(SCSObject, cTConnectorObject) then ModifyConnNoteAfterMove(TConnectorObject(SCSObject), deltax, deltay) else if CheckFigureByClassName(SCSObject, cTOrthoLine) then ModifyLineNoteAfterMove(TOrthoLine(SCSObject), deltax, deltay); end; end; end; end; except on E: Exception do addExceptionToLogEx('TFigureGrpNotMod.Move', E.Message); end; end; procedure TFigureGrpNotMod.WriteToStream(Stream: TStream); begin if Self <> GShadowObject then inherited; end; procedure TFigureGrpNotMod.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); begin inherited; fHasParent := false; end; /////////////////////////////////////////////////////////////////////////////// procedure TFigureGrpMod.WriteToStream(Stream: TStream); begin inherited; end; procedure TFigureGrpMod.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); begin inherited; fHasParent := false; end; //procedure TOrthoLine.SetJConnector1(jc: TFigure); procedure TOrthoLine.SetJConnector1(jc: TFigure; CanChangeActuals: Boolean = True); begin try JoinConnector1 := jc; // Tolik -- 14/04/2017 -- -- проверка нужна, во избежание...были преценденты.... if TConnectorObject(jc).JoinedOrtholinesList.IndexOf(Self) = -1 then // TConnectorObject(jc).JoinedOrtholinesList.Add(Self); // Tolik -- 20/04/2017 -- if CanChangeActuals then begin Self.SetActual(1,TConnectorObject(jc).ActualPoints[1]); Self.ActualZOrder[1] := TConnectorObject(jc).ActualZOrder[1]; end; // except on E: Exception do addExceptionToLogEx('TOrthoLine.SetJConnector1', E.Message); end; end; procedure TOrthoLine.SetJConnector2(jc: TFigure; CanChangeActuals: Boolean = True); begin try JoinConnector2 := jc; // Tolik -- 14/04/2017 -- проверка нужна, во избежание...были преценденты.... if TConnectorObject(jc).JoinedOrtholinesList.IndexOf(Self) = -1 then // TConnectorObject(jc).JoinedOrtholinesList.Add(Self); // Tolik -- 20/04/2017 -- if CanChangeActuals then begin Self.SetActual(2, TConnectorObject(jc).ActualPoints[1]); Self.ActualZOrder[2] := TConnectorObject(jc).ActualZOrder[1]; end; // except on E: Exception do addExceptionToLogEx('TOrthoLine.SetJConnector2', E.Message); end; end; procedure TConnectorObject.DrawRaiseUp(ADEngine: TPCDrawEngine; AObjectFromRaise: TConnectorObject); var CrossPoint1, CrossPoint2: TDoublePoint; BasisPoints: TDoublePoint; Points: TDoublePointArr; PenStyle: TPenStyle; RaiseLine: TOrthoLine; isDrawRaise: Boolean; RaizeKoeff: Double; Brush: Tbrush; // Tolik 17/03/2021 -- //Tolik -- чтобы не подъёбывала отрисовка райза function getRaiseDrawPoint: TDoublePoint; var p1, p2: TDoublePoint; Conn1, Conn2: TConnectorObject; begin Result.x := 0; Result.y := 0; Result.z := 0; Conn1 := TConnectorObject(RaiseLine.JoinConnector1); Conn2 := TConnectorObject(RaiseLine.JoinConnector2); if Conn1.JoinedConnectorsList.Count > 0 then Conn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]); if Conn2.JoinedConnectorsList.Count > 0 then Conn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]); p1 := GetBasisPointByObjFromRaise(Conn1); p2 := GetBasisPointByObjFromRaise(Conn2); //точка, которая правее if CompareValue(p1.x, p2.x) = 1 then Result := p1 else Result := p2; end; // begin // Tolik 17/03/2021 -- Brush := ADEngine.Canvas.Brush; // Tolik 17/03/2021 -- ADEngine.Canvas.Brush.Style := bsSolid; ADEngine.Canvas.Brush.Color := clBlack; // try if (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_TrunkDown) or (FConnRaiseType = crt_TrunkUp) then isDrawRaise := True else isDrawRaise := GCadForm.FShowRaise; if isDrawRaise then begin RaizeKoeff := 1; PenStyle := ADEngine.Canvas.Pen.Style; ADEngine.Canvas.Pen.Style := psSolid; RaiseLine := GetRaiseLine(Self); if ((RaiseLine <> nil) and (not RaiseLine.Deleted)) then // Tolik 17/12/2020 -- begin RaizeKoeff := RaiseLine.FDrawFigurePercent / 100; if RaiseLine.Selected then begin ADEngine.Canvas.Pen.Color := clRed; ADEngine.Canvas.Brush.Color := clRed; //ADEngine.Canvas.Pen.Width := Round(2*RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; end else if RaiseLine.isSnap then begin ADEngine.Canvas.Pen.Color := clRed; ADEngine.Canvas.Brush.Color := clRed; //ADEngine.Canvas.Pen.Width := Round(2*RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; end else if RaiseLine.isTraceShow then begin ADEngine.Canvas.Pen.Color := clRed; ADEngine.Canvas.Brush.Color := clRed; //ADEngine.Canvas.Pen.Width := Round(2*RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; end else if RaiseLine.InsideCabinet then begin ADEngine.Canvas.Pen.Color := $1f7ffa; ADEngine.Canvas.Brush.Color := $1f7ffa; //ADEngine.Canvas.Pen.Width := Round(2 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; end else begin ADEngine.Canvas.Pen.Color := RaiseLine.FTraceColor; ADEngine.Canvas.Brush.Color := RaiseLine.FTraceColor; //ADEngine.Canvas.Pen.Width := Round(1*RaizeKoeff); ADEngine.Canvas.Pen.Width := 1; end; end else begin ADEngine.Canvas.Pen.Color := clBlack; ADEngine.Canvas.Brush.Color := clBlack; //ADEngine.Canvas.Pen.Width := Round(1*RaizeKoeff); ADEngine.Canvas.Pen.Width := 1; end; //27.04.2013 //if AObjectFromRaise.DrawFigure = nil then //begin // BasisPoints.x := AObjectFromRaise.ActualPoints[1].x + AObjectFromRaise.GrpSizeX / 2; // BasisPoints.y := AObjectFromRaise.ActualPoints[1].y - AObjectFromRaise.GrpSizeY / 2; //end //else //begin // if AObjectFromRaise.DrawFigure.InFigures.Count = 0 then // begin // BasisPoints.x := AObjectFromRaise.ActualPoints[1].x + AObjectFromRaise.GrpSizeX / 2; // BasisPoints.y := AObjectFromRaise.ActualPoints[1].y - AObjectFromRaise.GrpSizeY / 2; // end // else // begin // BasisPoints.x := AObjectFromRaise.DrawFigure.CenterPoint.x + AObjectFromRaise.GrpSizeX / 2 - 0.5; // BasisPoints.y := AObjectFromRaise.DrawFigure.CenterPoint.y - AObjectFromRaise.GrpSizeY / 2 + 0.5; // end; //end; // Tolik 10/04/2018 -- //BasisPoints := GetBasisPointByObjFromRaise(AObjectFromRaise);//27.04.2013 BasisPoints := getRaiseDrawPoint; // // Линия с-п (рисуется также под стрелкой) CrossPoint1.x := BasisPoints.x; CrossPoint1.y := BasisPoints.y; //CrossPoint2.x := BasisPoints.x + Round(4*RaizeKoeff); //CrossPoint2.y := BasisPoints.y - Round(4*RaizeKoeff); CrossPoint2.x := BasisPoints.x + Round4(4 * RaizeKoeff); CrossPoint2.y := BasisPoints.y - Round4(4 * RaizeKoeff); ADEngine.drawline(CrossPoint1, CrossPoint2); // стрелка с-п SetLength(Points, 4); // обычный if FConnRaiseType = crt_OnFloor then begin ADEngine.Canvas.Pen.Color := clBlack; ADEngine.Canvas.Brush.Color := clBlack; end // межэтажный else if (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_BetweenFloorUp) then begin ADEngine.Canvas.Pen.Color := clBlue; ADEngine.Canvas.Brush.Color := clBlue; end // магистраль else if (FConnRaiseType = crt_TrunkDown) or (FConnRaiseType = crt_TrunkUp) then begin ADEngine.Canvas.Pen.Color := clGreen; ADEngine.Canvas.Brush.Color := clGreen; end; //Points[0] := DoublePoint(BasisPoints.x + Round(2*RaizeKoeff), BasisPoints.y - Round(3*RaizeKoeff)); //Points[1] := DoublePoint(BasisPoints.x + Round(4*RaizeKoeff), BasisPoints.y - Round(4*RaizeKoeff)); //Points[2] := DoublePoint(BasisPoints.x + Round(3*RaizeKoeff), BasisPoints.y - Round(2*RaizeKoeff)); //Points[3] := DoublePoint(BasisPoints.x + Round(2*RaizeKoeff), BasisPoints.y - Round(3*RaizeKoeff)); Points[0] := DoublePoint(BasisPoints.x + Round4(2 * RaizeKoeff), BasisPoints.y - Round4(3 * RaizeKoeff)); Points[1] := DoublePoint(BasisPoints.x + Round4(4 * RaizeKoeff), BasisPoints.y - Round4(4 * RaizeKoeff)); Points[2] := DoublePoint(BasisPoints.x + Round4(3 * RaizeKoeff), BasisPoints.y - Round4(2 * RaizeKoeff)); Points[3] := DoublePoint(BasisPoints.x + Round4(2 * RaizeKoeff), BasisPoints.y - Round4(3 * RaizeKoeff)); ADEngine.drawpolyline(Points, True); ADEngine.Canvas.Pen.Style := PenStyle; end; //Tolik SetLength(Points,0); // except on E: Exception do addExceptionToLogEx('TConnectorObject.DrawRaiseUp', E.Message); end; ADEngine.Canvas.Brush := Brush; // Tolik 17/03/2021 -- end; procedure TConnectorObject.DrawRaiseDown(ADEngine: TPCDrawEngine; AObjectFromRaise: TConnectorObject); var CrossPoint1, CrossPoint2: TDoublePoint; BasisPoints: TDoublePoint; Points: TDoublePointArr; PenStyle: TPenStyle; RaiseLine: TOrthoLine; isDrawRaise: Boolean; RaizeKoeff: Double; Brs: TBrush; // Tolik 17/03/2021 -- begin Brs := ADEngine.Canvas.Brush; // Tolik 17/03/2021 -- try if (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_BetweenFloorUp) or (FConnRaiseType = crt_TrunkDown) or (FConnRaiseType = crt_TrunkUp) then isDrawRaise := True else isDrawRaise := GCadForm.FShowRaise; if isDrawRaise then begin RaizeKoeff := 1; PenStyle := ADEngine.Canvas.Pen.Style; // Tolik 17/03/2021 -- ADEngine.Canvas.Brush.Style := bsSolid; ADEngine.Canvas.Brush.Color := clBlack; // ADEngine.Canvas.Pen.Style := psSolid; RaiseLine := GetRaiseLine(Self); //if RaiseLine <> nil then if ((RaiseLine <> nil) and (not RaiseLine.Deleted)) then begin RaizeKoeff := RaiseLine.FDrawFigurePercent / 100; if RaiseLine.Selected then begin ADEngine.Canvas.Pen.Color := clRed; //ADEngine.Canvas.Pen.Width := Round(2 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; ADEngine.Canvas.Brush.Color := clRed; end else if RaiseLine.isSnap then begin ADEngine.Canvas.Pen.Color := clRed; //ADEngine.Canvas.Pen.Width := Round(2 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; ADEngine.Canvas.Brush.Color := clRed; end else if RaiseLine.isTraceShow then begin ADEngine.Canvas.Pen.Color := clRed; //ADEngine.Canvas.Pen.Width := Round(2 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; ADEngine.Canvas.Brush.Color := clRed; end else if RaiseLine.InsideCabinet then begin ADEngine.Canvas.Pen.Color := $1f7ffa; //ADEngine.Canvas.Pen.Width := Round(2 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; ADEngine.Canvas.Brush.Color := $1f7ffa; end else begin ADEngine.Canvas.Pen.Color := RaiseLine.FTraceColor; //ADEngine.Canvas.Pen.Width := Round(1 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 1; ADEngine.Canvas.Brush.Color := RaiseLine.FTraceColor; end; end else begin ADEngine.Canvas.Pen.Color := clBlack; //ADEngine.Canvas.Pen.Width := Round(1 * RaizeKoeff); ADEngine.Canvas.Pen.Width := 2; ADEngine.Canvas.Brush.Color := clBlack; end; //27.04.2013 //if AObjectFromRaise.DrawFigure = nil then //begin // BasisPoints.x := AObjectFromRaise.ActualPoints[1].x + AObjectFromRaise.GrpSizeX / 2; // BasisPoints.y := AObjectFromRaise.ActualPoints[1].y - AObjectFromRaise.GrpSizeY / 2; //end //else //begin // if AObjectFromRaise.DrawFigure.InFigures.Count = 0 then // begin // BasisPoints.x := AObjectFromRaise.ActualPoints[1].x + AObjectFromRaise.GrpSizeX / 2; // BasisPoints.y := AObjectFromRaise.ActualPoints[1].y - AObjectFromRaise.GrpSizeY / 2; // end // else // begin // BasisPoints.x := AObjectFromRaise.DrawFigure.CenterPoint.x + AObjectFromRaise.GrpSizeX / 2 - 0.5; // BasisPoints.y := AObjectFromRaise.DrawFigure.CenterPoint.y - AObjectFromRaise.GrpSizeY / 2 + 0.5; // end; //end; BasisPoints := GetBasisPointByObjFromRaise(AObjectFromRaise);//27.04.2013 // Линия с-п (рисуется также под стрелкой) CrossPoint1.x := BasisPoints.x; CrossPoint1.y := BasisPoints.y; CrossPoint2.x := BasisPoints.x + Round4(4 * RaizeKoeff); CrossPoint2.y := BasisPoints.y - Round4(4 * RaizeKoeff); ADEngine.drawline(CrossPoint1, CrossPoint2); // стрелка с-п SetLength(Points, 4); // обычный if FConnRaiseType = crt_OnFloor then begin ADEngine.Canvas.Pen.Color := clBlack; ADEngine.Canvas.Brush.Color := clBlack; end // межэтажный else if (FConnRaiseType = crt_BetweenFloorDown) or (FConnRaiseType = crt_BetweenFloorUp) then begin ADEngine.Canvas.Pen.Color := clBlue; ADEngine.Canvas.Brush.Color := clBlue; end // магистраль else if (FConnRaiseType = crt_TrunkDown) or (FConnRaiseType = crt_TrunkUp) then begin ADEngine.Canvas.Pen.Color := clGreen; ADEngine.Canvas.Brush.Color := clGreen; end; Points[0] := DoublePoint(BasisPoints.x + Round4(1 * RaizeKoeff), BasisPoints.y - Round4(2 * RaizeKoeff)); Points[1] := DoublePoint(BasisPoints.x, BasisPoints.y); Points[2] := DoublePoint(BasisPoints.x + Round4(2 * RaizeKoeff), BasisPoints.y - Round4(1 * RaizeKoeff)); Points[3] := DoublePoint(BasisPoints.x + Round4(1 * RaizeKoeff), BasisPoints.y - Round4(2 * RaizeKoeff)); ADEngine.drawpolyline(Points, True); ADEngine.Canvas.Pen.Style := PenStyle; end; //Tolik SetLength(Points, 0); // except on E: Exception do addExceptionToLogEx('TConnectorObject.DrawRaiseDown', E.Message); end; ADEngine.Canvas.Brush := brs; // Tolik 17/03/2021 -- end; procedure TOrthoLine.DrawTraceStyle(ADEngine: TPCDrawEngine); begin try if GCadForm.FKeepLineTypesRules then begin // ADEngine.Canvas.Pen.Color := clBlack; if FLineType = ts_UnderFalseFloor then begin ADEngine.Canvas.Pen.Style := psDash; ADEngine.Canvas.Pen.Width := 1; end; if FLineType = ts_ClearTrace then begin ADEngine.canvas.Pen.Style := psDashDot; //psSolid{FTraceStyle}; //ADEngine.canvas.Pen.Color := clGray; ADEngine.Canvas.Pen.Width := 1{FTraceWidth}; end; if FLineType = ts_Until10 then begin ADEngine.canvas.Pen.Style := psSolid; ADEngine.Canvas.Pen.Width := 1; end; if FLineType = ts_Until10InCorob then begin ADEngine.canvas.Pen.Style := psSolid; // Внешние СКС if GCadForm.FShowLineCaptionsType = skExternalSCS then ADEngine.Canvas.Pen.Width := 1 else ADEngine.Canvas.Pen.Width := 2; end; if FLineType = ts_Over10 then begin ADEngine.canvas.Pen.Style := psSolid; // Внешние СКС if GCadForm.FShowLineCaptionsType = skExternalSCS then ADEngine.Canvas.Pen.Width := 1 else ADEngine.Canvas.Pen.Width := 3; end; if FIsRaiseUpDown then begin ADEngine.canvas.Pen.Style := psClear; ADEngine.Canvas.Pen.Width := 1; end; if GCadForm.FShowLineCaptionsType = skExternalSCS then begin if FObjectType = 1 then begin if GCadForm.FPrintType = pt_Black then begin ADEngine.Canvas.Pen.Style := psDash; ADEngine.Canvas.Pen.Color := clBlack; ADEngine.Canvas.Pen.Width := 2; end; if GCadForm.FPrintType = pt_Color then begin ADEngine.Canvas.Pen.Style := psDash; ADEngine.Canvas.Pen.Color := clRed; ADEngine.Canvas.Pen.Width := 1; end; end; end; end else begin // ADEngine.Canvas.Pen.Color := FTraceColor; ADEngine.Canvas.Pen.Style := FTraceStyle; ADEngine.Canvas.Pen.Width := FTraceWidth; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.DrawTraceStyle', E.Message); end; end; procedure TFigureGrpNotMod.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var adim2: double; aZoomScale: integer; begin try if Visible then inherited; if GIsDrawShadow then begin if Self = GShadowObject then begin adim2 := dim2; aZoomScale := 0; if (GCadForm.PCad <> nil) then aZoomScale := GCadForm.PCad.ZoomScale; if (aZoomScale > 100) then adim2 := adim2 / (aZoomScale / 100); //Tolik 23/09/2021 -- {DEngine.DrawRect(ShadowCP.x - adim2, ShadowCP.y - adim2, ShadowCP.x + adim2, ShadowCP.y + adim2, clGray, 2, ord(psSolid), clGray, ord(bsClear));} DEngine.DrawRect(ShadowCP.x - adim2, ShadowCP.y - adim2, ShadowCP.x + adim2, ShadowCP.y + adim2, $00E8731A, 2, ord(psSolid), $00E8731A, ord(bsClear)); // GCadForm.PCad.Repaint; //Зачем тут Update если он выполняется в Repaint - Митяй Д.В // GCadForm.PCad.Update; end; end; except on E: Exception do addExceptionToLogEx('TFigureGrpNotMod.draw', E.Message); end; end; procedure TFigureGrpMod.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var IsDraw: Boolean; begin //31.10.2011 try if Visible then begin inherited; end; //31.10.2011 except //31.10.2011 on E: Exception do addExceptionToLogEx('TFigureGrpMod.draw', E.Message); //31.10.2011 end; end; procedure TOrthoLine.SetDrawFigure(const Value: TFigureGrpMod); var deltax, deltay: Double; BlockBnd: TDoubleRect; DrawFigureBnd: TDoubleRect; cp: TDoublePoint; BlockDelta: double; DrawFigureKoeff: Double; RaiseConn: TConnectorObject; BasisPoint, CrossPoint1, CrossPoint2: TDoublePoint; begin //Tolik if Value <> nil then begin // try if ((FSingleBlock <> nil) and (DrawFigure <> nil)) then // на всякий begin DrawFigure.RemoveFromGrp(FSingleBlock); //28.04.2011 DrawFigure.InFigures.Remove(FSingleBlock); end; if FSingleBlock <> nil then begin if FSingleBlock.ID <> Value.ID then begin RemoveInFigureGrp(FSingleBlock); // Tolik теоретически должно работать, но в случае траблов, лучше юзать DELETE if FSingleBlock.Owner <> nil then // 09/11/2015 if TPowerCad(FSingleBlock.Owner).Figures.IndexOF(FSingleBlock) <> -1 then TPowerCad(FSingleBlock.Owner).Figures.Remove(FSingleBlock); FreeAndNil(FSingleBlock); // FSingleBlock.Delete; end; // FsingleBlock на КАДе уже как отдельной фигуры нет // GCadForm.PCad.Figures.Remove(FSingleBlock); end; if DrawFigure <> nil then begin //Tolik //RemoveInFigureGrp(DrawFigure); //GCadForm.PCad.Figures.Remove(DrawFigure); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! // Выше сделан ремув FSingleBlock из FdrawFigure, иначе RemoveInFigureGrp(DrawFigure) сделает // FreeAndNil для FSingleBlock и потом, уже на возникновении события удаления FSingleBlock он уже получится // непонятно что, так как память - уже йок...(может быть занята кем-нибудь другим, а ссылка у нас есть и получим херню) // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! GCadForm.PCad.Figures.Remove(DrawFigure); if FDrawFigure.ID <> Value.ID then begin RemoveInFigureGrp(DrawFigure); // теоретически должно работать, но в случае траблов, лучше юзать DELETE FreeAndNil(FDrawFigure); // FDrawFigure.Delete; end; // end; // Создать новый дубликат //Tolik //FSingleBlock := TFigureGrpMod.create(LayerHandle, Owner); // FSingleBlock := TFigureGrpMod(Value); ////FSingleBlock := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), FSingleBlock, False)); FDrawFigure := GetAllBlocks(FSingleBlock); if FSingleBlock.InFigures.Count = 0 then begin BlockBnd := FSingleBlock.GetBoundRect; end else begin BlockBnd := TFigure(FSingleBlock.InFigures[0]).GetBoundRect; end; DrawFigureBnd := DrawFigure.GetBoundRect; GrpSizeX := DrawFigureBnd.Right - DrawFigureBnd.Left; GrpSizeY := BlockBnd.Bottom - BlockBnd.Top; FOriginalSizeX := {GrpSizeX}BlockBnd.Right - BlockBnd.Left; FOriginalSizeY := GrpSizeY; BlockDelta := 0.2 / 2 * (FSingleBlock.InFigures.Count - 1); //27.04.2013 Для с-п уменьшаем УГО в два раза if FIsRaiseUpDown then begin DrawFigureKoeff := FDrawFigurePercent/100; FDrawFigure.Scale(0.5 * DrawFigureKoeff, 0.5 * DrawFigureKoeff, FDrawFigure.CenterPoint); //deltax := deltax - 4; //deltay := deltay - 4; //DrawFigure.move(4*DrawFigureKoeff, -4.5*DrawFigureKoeff); //4, потому что стрелка с-п рисуется со сдвигом на 4, во втором патаметре добавляем половину высоты УГО, чтобы было по центру //DrawFigure.move(4*DrawFigureKoeff, -1*(4.25*DrawFigureKoeff + (Abs(GrpSizeY)/2) )); //RaiseConn := GetRaiseByRaiseLine(Self); //if RaiseConn <> nil then // RaiseConn := GetRaiseConn(RaiseConn); //DrawFigure.move(4*DrawFigureKoeff, -1*(4*DrawFigureKoeff )); if FObjectFromRaisedLine <> nil then begin BasisPoint := GetBasisPointByObjFromRaise(FObjectFromRaisedLine); //if FObjectFromRaisedLine.DrawFigure.InFigures.Count > 0 then begin BasisPoint.x := BasisPoint.x - 1; BasisPoint.y := BasisPoint.y + 1; end; end else begin BasisPoint.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; BasisPoint.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; end; CrossPoint1.x := BasisPoint.x; CrossPoint1.y := BasisPoint.y; CrossPoint2.x := BasisPoint.x + Round(4*DrawFigureKoeff); CrossPoint2.y := BasisPoint.y - Round(4*DrawFigureKoeff); DrawFigure.ActualPoints[1] := DoublePoint((DrawFigureBnd.Left + DrawFigureBnd.Right) / 2, (BlockBnd.Top + BlockBnd.Bottom) / 2); deltax := BasisPoint.x - DrawFigure.ActualPoints[1].x; deltay := BasisPoint.y - DrawFigure.ActualPoints[1].y; deltax := deltax + 2.7*DrawFigureKoeff; deltay := deltay - 2.7*DrawFigureKoeff; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False)); GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False); DrawFigure.move(deltax, deltay); DrawFigure.LockModify := True; MoveTextBox(DrawFigure, CrossPoint1, CrossPoint2, True); end else begin cp.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; cp.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; DrawFigure.ActualPoints[1] := DoublePoint((DrawFigureBnd.Left + DrawFigureBnd.Right) / 2 - GrpSizeX / 2, (BlockBnd.Top + BlockBnd.Bottom) / 2 - GrpSizeY / 2); deltax := cp.x - GrpSizeX / 2 - DrawFigure.ActualPoints[1].x; deltay := cp.y - GrpSizeY / 2 - DrawFigure.ActualPoints[1].y; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False)); GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False); DrawFigure.move(deltax, deltay); DrawFigure.LockModify := True; MoveTextBox(DrawFigure, ActualPoints[1], ActualPoints[2], True); end; except on E: Exception do addExceptionToLogEx('TOrthoLine.SetDrawFigure', E.Message); end; end; end; procedure TOrthoLine.SetOrthoLineType(const Value: TOrthoLineType); var i: integer; deltax, deltay: Double; Bnd: TDoubleRect; cp: TDoublePoint; begin try GTestSingleBlock := FSingleBlock; if FSingleBlock <> nil then begin RemoveInFigureGrp(FSingleBlock); GCadForm.PCad.Figures.Remove(FSingleBlock); // FreeAndNil(FSingleBlock); end; if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); GCadForm.PCad.Figures.Remove(DrawFigure); // FreeAndNil(FDrawFigure); end; FOrthoLineType := Value; // Создать новый дубликат FDrawFigure := TFigureGrpMod.create(LayerHandle, Owner); FSingleBlock := GetOrthoLineImg(FOrthoLineType); //FSingleBlock := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), FSingleBlock, False)); GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), FSingleBlock, False); FDrawFigure := GetAllBlocks(FSingleBlock); // Tolik -- 23/11/2015 // убираем с КАДа GCadForm.PCad.Figures.Remove(FSingleBlock); // if DrawFigure <> nil then Bnd := DrawFigure.GetBoundRect; GrpSizeX := Bnd.Right - Bnd.Left; GrpSizeY := Bnd.Bottom - Bnd.Top; FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; if (GCadForm.PCad <> nil) AND (DrawStyle <> dsTrace) then begin cp.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; cp.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; // Задать точки для отрисовки прямоугольника, верхнюю левую и нижнюю правую Bnd := DrawFigure.GetBoundRect; GrpSizeX := Bnd.Right - Bnd.Left; GrpSizeY := Bnd.Bottom - Bnd.Top; FOriginalSizeX := GrpSizeX; FOriginalSizeY := GrpSizeY; DrawFigure.ActualPoints[1] := DoublePoint((Bnd.Left + Bnd.Right) / 2 - GrpSizeX / 2, (Bnd.Top + Bnd.Bottom) / 2 - GrpSizeY / 2); deltax := cp.x - GrpSizeX / 2 - DrawFigure.ActualPoints[1].x; deltay := cp.y - GrpSizeY / 2 - DrawFigure.ActualPoints[1].y; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False)); GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False); DrawFigure.move(deltax, deltay); DrawFigure.LockModify := True; MoveTextBox(DrawFigure, ActualPoints[1], ActualPoints[2], True); end else begin if FSingleBlock <> nil then begin RemoveInFigureGrp(FSingleBlock); GCadForm.PCad.Figures.Remove(FSingleBlock); end; if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); GCadForm.PCad.Figures.Remove(DrawFigure); end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.SetOrthoLineType', E.Message); end; end; function TOrthoLine.GetAllBlocks(ADuplicateBlock: TFigureGrpMod): TFigureGrpMod; var i: integer; tmpFigureGrp: TFigureGrpMod; Step: Double; NewStep: Double; Bnd: TDoubleRect; LLength: Double; BlkLength: Double; BlkCount: Integer; //Tolik j: Integer; // Tolik 06/09/2017 -- // не добавлять блоки на обозначения пересечения трасс (* function CheckCanAddBlock(aBlock: TfigureGrpMod): Boolean; var MaxX, MaxY, MinX, MinY: Double; PointInfo: POrthoLineCrossInfo; i: Integer; FirstLinePoint: TDoublePoint; dist1, dist2, dist3: Double; begin Result := True; if Self.CrossList.Count = 0 then exit; {dist1 := Sqrt(sqr(Self.JoinConnector1.AP1.x) + sqr(Self.JoinConnector1.AP1.y)); dist2 := Sqrt(sqr(Self.JoinConnector2.AP1.x) + sqr(Self.JoinConnector2.AP1.y)); //начальная точка ортолинии if CompareValue(dist1, dist2) = -1 then FirstLinePoint := Self.AP1 else FirstLinePoint := Self.AP2; } if CompareValue(Ap1.x, Ap2.x) = -1 then FirstLinePoint := Ap1 else FirstLinePoint := Ap2; aBlock.GetBounds(MaxX, MaxY, MinX, MinY); for i := 0 to CrossList.Count - 1 do begin PointInfo := POrthoLineCrossInfo(CrossList[i]); // if PointNear(DoublePoint(MaxX, MaxY), PointInfo.StartPoint, 5) then dist1 := Sqrt(Sqr(Minx - FirstLinePoint.x) + Sqr(MinY - FirstLinePoint.y)); dist2 := Sqrt(Sqr(MaxX - FirstLinePoint.x) + Sqr(MaxY - FirstLinePoint.y)); dist3 := Sqrt(Sqr(PointInfo.StartPoint.x - FirstLinePoint.x) + Sqr(PointInfo.StartPoint.y - FirstLinePoint.y)); // dist1 := Sqrt(Sqr((Minx + MaxX)/2 - FirstLinePoint.x) + Sqr((MinY + MaxY)/2 - FirstLinePoint.y)); if CompareValue(ABS(dist1 - dist3{PointInfo.disttoFirstPoint}), 10) = -1 then begin Result := False; break; end else //if PointNear(DoublePoint(MinX, MinY), PointInfo.StartPoint, 5) then if CompareValue(ABS(Dist2 - Dist3{PointInfo.disttoFirstPoint}), 10) = -1 then begin Result := False; break; end; end; end; *) begin try //Tolik ////ADuplicateBlock.Visible := True; // Result := nil; Result := TFigureGrpMod.create(LayerHandle, GCadForm.PCad); Bnd := FSingleBlock.GetBoundRect; BlkLength := Bnd.Right - Bnd.Left; if Not FIsRaiseUpDown then //22.04.2013 begin // calc block and length sizes LLength := SQRT(SQR(ActualPoints[1].x - ActualPoints[2].x) + SQR(ActualPoints[1].y - ActualPoints[2].y)); Step := BlockStep; try BlkCount := round((LLength - Step) / (BlkLength + Step)); except BlkCount := 0; end; if BlkCount > 0 then begin // calc block count ADuplicateBlock.Visible := True; Result.AddFigure(ADuplicateBlock); //Tolik NewStep := (LLength - BlkLength * BlkCount) / (BlkCount + 1); // for i := 1 to BlkCount - 1 do begin tmpFigureGrp := TFigureGrpMod(ADuplicateBlock.Duplicate); //Tolik tmpFigureGrp.move((NewStep + BlkLength) * i, 0); //tmpFigureGrp.move((Step + BlkLength) * i, 0); // tmpFigureGrp.Visible := True; // Tolik 06/09/20107 -- Result.AddFigure(tmpFigureGrp); { if CheckCanAddBlock(tmpFigureGrp) then Result.AddFigure(tmpFigureGrp) else tmpFigureGrp.Free;} end; end else begin ADuplicateBlock.Visible := False; Result.AddFigure(ADuplicateBlock); end; end else begin {tmpFigureGrp := TFigureGrpMod(ADuplicateBlock.Duplicate); //tmpFigureGrp.move((NewStep + BlkLength) * i, 0); tmpFigureGrp.move(BlkLength, 0); tmpFigureGrp.Visible := True; Result.AddFigure(tmpFigureGrp);} ADuplicateBlock.Visible := True; Result.AddFigure(ADuplicateBlock); end; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetAllBlocks', E.Message); end; {if Result <> nil then if CrossList.Count > 0 then CheckDrawFigure(Result);} ////ADuplicateBlock.Visible := False; end; Procedure TOrthoLine.CheckDrawFigure(aFigure: TFigureGrpMod); var MaxX, MaxY, MinX, MinY: Double; PointInfo: POrthoLineCrossInfo; j, i: Integer; FirstLinePoint: TDoublePoint; dist1, dist2, dist3: Double; aBlock: TFigureGrpMod; CanRemoveBlock: Boolean; begin try if Self.CrossList.Count = 0 then exit; dist1 := Sqrt(sqr(Self.JoinConnector1.AP1.x) + sqr(Self.JoinConnector1.AP1.y)); dist2 := Sqrt(sqr(Self.JoinConnector2.AP1.x) + sqr(Self.JoinConnector2.AP1.y)); //сбросить невидимые блоки для перерасчета for j := 0 to aFigure.InFigures.Count - 1 do begin aBlock := TFigureGrpMod(aFigure.InFigures[j]); aBlock.Visible := True; end; //начальная точка ортолинии FirstLinePoint := AP1; if CompareValue(dist2, dist1) = -1 then FirstLinePoint := Self.AP2; CanRemoveBlock := True; While CanRemoveBlock do begin CanRemoveBlock := False; for j := 0 to aFigure.InFigures.Count - 1 do begin aBlock := TFigureGrpMod(aFigure.InFigures[j]); if aBlock.Visible then begin { if CompareValue(dist1, dist2) = -1 then FirstLinePoint := Self.AP1 else FirstLinePoint := Self.AP2;} {if CompareValue(Ap1.x, Ap2.x) = -1 then FirstLinePoint := Ap1 else FirstLinePoint := Ap2; } aBlock.GetBounds(MaxX, MaxY, MinX, MinY); for i := 0 to CrossList.Count - 1 do begin PointInfo := POrthoLineCrossInfo(CrossList[i]); dist1 := Sqrt(Sqr((Minx + MaxX)/2 - FirstLinePoint.x) + Sqr((MinY + MaxY)/2 - FirstLinePoint.y)); // от центра блока dist2 := Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))/2; // пол блока dist3 := Sqrt(Sqr(PointInfo.StartPoint.x - FirstLinePoint.x) + Sqr(PointInfo.StartPoint.y - FirstLinePoint.y)); if CompareValue(ABS(dist1 - dist3), Dist2 + 1) < 1 then begin CanRemoveBlock := True; break; end; end; if CanRemoveBlock then begin aBlock.Visible := False; break; end; end; end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.CheckDrawFigure', E.Message); end; end; // procedure TOrthoLine.ReCreateDrawFigureBlock; var i: integer; deltax, deltay: Double; Bnd: TDoubleRect; cp, Fcp: TDoublePoint; DrawFigureBnd: TDoubleRect; BlockBnd: TDoubleRect; BlockDelta: double; InFigure: TFigureGrpMod; //Tolik DeltaXX, DeltaYY: Double; P1, P2: TDoublePoint; begin try if Self.deleted then exit; GTestSingleBlock := FSingleBlock; // Tolik // if FSingleBlock <> nil then if ((FSingleBlock <> nil) and (DrawFigure <> nil)) then // на всякий begin DrawFigure.RemoveFromGrp(FSingleBlock); //28.04.2011 DrawFigure.InFigures.Remove(FSingleBlock); end; if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); //Tolik 09/11/2015 // GCadForm.PCad.Figures.Remove(DrawFigure); TPowerCad(DrawFigure.Owner).Figures.Remove(DrawFigure); // end; if FSingleBlock <> nil then begin FSingleBlock.Visible := True; FSingleBlock.Rotate(0 - FDrawFigureAngle, FSingleBlock.CenterPoint); if ((FDrawFigure <> nil) and (FDrawFigure.ID <> FSingleBlock.ID) ) then FreeAndNil(FDrawFigure); // FDrawfigure.Delete; FSingleBlock.Visible := False; end else if (FDrawFigure <> nil) then FreeAndNil(FDrawFigure); // FDrawfigure.Delete; // Создать новый дубликат // FDrawFigure := TFigureGrpMod.create(LayerHandle, Owner); // FDrawFigure := GetAllBlocks(FSingleBlock); if (GCadForm.PCad <> nil) AND (DrawStyle <> dsTrace) then begin cp.x := (ActualPoints[1].x + ActualPoints[2].x) / 2; cp.y := (ActualPoints[1].y + ActualPoints[2].y) / 2; // Задать точки для отрисовки прямоугольника, верхнюю левую и нижнюю правую if FSingleBlock.InFigures.Count = 0 then begin BlockBnd := FSingleBlock.GetBoundRect; end else begin BlockBnd := TFigure(FSingleBlock.InFigures[0]).GetBoundRect; end; DrawFigureBnd := DrawFigure.GetBoundRect; GrpSizeX := DrawFigureBnd.Right - DrawFigureBnd.Left; GrpSizeY := BlockBnd.Bottom - BlockBnd.Top; BlockDelta := 0.2 / 2 * (FSingleBlock.InFigures.Count - 1); DrawFigure.ActualPoints[1] := DoublePoint((DrawFigureBnd.Left + DrawFigureBnd.Right) / 2 - GrpSizeX / 2, (BlockBnd.Top + BlockBnd.Bottom) / 2 - GrpSizeY / 2); deltax := cp.x - GrpSizeX / 2 - DrawFigure.ActualPoints[1].x; deltay := cp.y - GrpSizeY / 2 - DrawFigure.ActualPoints[1].y; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False)); GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False); DrawFigure.move(deltax, deltay); DrawFigure.LockModify := True; MoveTextBox(DrawFigure, ActualPoints[1], ActualPoints[2], True); // поворачивает фигуру отрисовки // Tolik 09/11/2017 -- if CrossList.Count > 0 then CheckDrawFigure(DrawFigure); // end else begin if FSingleBlock <> nil then begin DrawFigure.RemoveFromGrp(FSingleBlock); //28.04.2011 DrawFigure.InFigures.Remove(FSingleBlock); end; if DrawFigure <> nil then begin RemoveInFigureGrp(DrawFigure); GCadForm.PCad.Figures.Remove(DrawFigure); end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.ReCreateDrawFigureBlock', E.Message); end; end; function TOrthoLine.CreateNotesRowGroup(ANotesRowsType: TNotesRowsType; aDeltaLineX: Double = -1; aDeltaLineY: Double = -1): TFigureGrpNotMod; var Row1: TLine; Row2: TLine; Row3: TLine; BasisPoint: TDoublePoint; Point1, Point2: TDoublePoint; BasePoint: TDoublePoint; GetPoints1: TDoublePoint; GetPoints2: TDoublePoint; Koef: Double; AngleDeg: Double; NotesLHandle: integer; DeltaLineX: Double; DeltaLineY: Double; ObjectFromRaise: TConnectorObject; PointObject: TConnectorObject; begin try Result := nil; if Self.deleted then exit; NotesLHandle := GCadForm.PCad.GetLayerHandle(5); // calc base points if ActualPoints[1].x > ActualPoints[2].x then Koef := 0.7 else Koef := 0.3; if FIsRaiseUpDown then begin ObjectFromRaise := nil; // 1 if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then begin if TConnectorObject(JoinConnector1).FConnRaiseType <> crt_None then ObjectFromRaise := TConnectorObject(JoinConnector1).FObjectFromRaise; end else begin PointObject := TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]); if PointObject.FConnRaiseType <> crt_None then ObjectFromRaise := PointObject.FObjectFromRaise; end; // 2 if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then begin if TConnectorObject(JoinConnector2).FConnRaiseType <> crt_None then ObjectFromRaise := TConnectorObject(JoinConnector2).FObjectFromRaise; end else begin PointObject := TConnectorObject(TConnectorObject(JoinConnector2).JoinedConnectorsList[0]); if PointObject.FConnRaiseType <> crt_None then ObjectFromRaise := PointObject.FObjectFromRaise; end; if ObjectFromRaise = nil then ObjectFromRaise := FObjectFromRaisedLine; // Tolik -- 09/11/2016-- Для битой фигуры !!! -- не удалять этот кусок !!! if not CheckFigureByClassName(ObjectFromRaise, cTConnectorObject) then begin Self.Deleted := True; exit; end; if ObjectFromRaise.DrawFigure.InFigures.Count = 0 then begin BasisPoint.x := ObjectFromRaise.ActualPoints[1].x + ObjectFromRaise.GrpSizeX / 2; BasisPoint.y := ObjectFromRaise.ActualPoints[1].y - ObjectFromRaise.GrpSizeY / 2; end else begin BasisPoint.x := ObjectFromRaise.DrawFigure.CenterPoint.x + ObjectFromRaise.GrpSizeX / 2 - 0.5; BasisPoint.y := ObjectFromRaise.DrawFigure.CenterPoint.y - ObjectFromRaise.GrpSizeY / 2 + 0.5; end; Point1.x := BasisPoint.x; Point1.y := BasisPoint.y; Point2.x := BasisPoint.x + 4; Point2.y := BasisPoint.y - 4; BasePoint.x := (Point1.x + Point2.x) / 2; BasePoint.y := (Point1.y + Point2.y) / 2; AngleDeg := 0; end else begin BasePoint.x := ActualPoints[1].x + Koef * (ActualPoints[2].x - ActualPoints[1].x); BasePoint.y := ActualPoints[1].y + Koef * (ActualPoints[2].y - ActualPoints[1].y); AngleDeg := GetAngle(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); end; // if aDeltaLineX = - 1 then begin DeltaLineX := (4 * Sin (45 * pi / 180)); end else begin DeltaLineX := aDeltaLineX; end; if aDeltaLineY = - 1 then begin DeltaLineY := (4 * Cos (45 * pi / 180)); end else begin DeltaLineY := aDeltaLineY; end; // if ANotesRowsType = nr_AutoSide then begin if (AngleDeg > 0) and (AngleDeg < 90) then ANotesRowsType := nr_UpRightSide else if (AngleDeg > 90) and (AngleDeg < 180) then ANotesRowsType := nr_UpLeftSide else if (AngleDeg > 180) and (AngleDeg < 270) then ANotesRowsType := nr_UpRightSide else if (AngleDeg > 270) and (AngleDeg < 360) then ANotesRowsType := nr_UpLeftSide else if (AngleDeg = 0) or (AngleDeg = 90) or (AngleDeg = 180) or (AngleDeg = 270) or (AngleDeg = 360) then ANotesRowsType := nr_UpLeftSide; FNotesRowsType := ANotesRowsType; end; if ANotesRowsType = nr_UpLeftSide then begin GetPoints1.x := BasePoint.x - (2 * Sin (20 * pi / 180)); GetPoints1.y := BasePoint.y - (2 * Cos (20 * pi / 180)); GetPoints2.x := BasePoint.x + (2 * Sin (20 * pi / 180)); GetPoints2.y := BasePoint.y + (2 * Cos (20 * pi / 180)); Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x - DeltaLineX; GetPoints2.y := BasePoint.y - DeltaLineY; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x - 7; GetPoints2.y := GetPoints2.y; Row3 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; if ANotesRowsType = nr_DownLeftSide then begin GetPoints1.x := BasePoint.x + (2 * Sin (20 * pi / 180)); GetPoints1.y := BasePoint.y - (2 * Cos (20 * pi / 180)); GetPoints2.x := BasePoint.x - (2 * Sin (20 * pi / 180)); GetPoints2.y := BasePoint.y + (2 * Cos (20 * pi / 180)); Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x - DeltaLineX; GetPoints2.y := BasePoint.y + DeltaLineY; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x - 7; GetPoints2.y := GetPoints2.y; Row3 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; if ANotesRowsType = nr_UpRightSide then begin GetPoints1.x := BasePoint.x + (2 * Sin (20 * pi / 180)); GetPoints1.y := BasePoint.y - (2 * Cos (20 * pi / 180)); GetPoints2.x := BasePoint.x - (2 * Sin (20 * pi / 180)); GetPoints2.y := BasePoint.y + (2 * Cos (20 * pi / 180)); Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x + DeltaLineX; GetPoints2.y := BasePoint.y - DeltaLineY; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x + 7; GetPoints2.y := GetPoints2.y; Row3 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; if ANotesRowsType = nr_DownRightSide then begin GetPoints1.x := BasePoint.x - (2 * Sin (20 * pi / 180)); GetPoints1.y := BasePoint.y - (2 * Cos (20 * pi / 180)); GetPoints2.x := BasePoint.x + (2 * Sin (20 * pi / 180)); GetPoints2.y := BasePoint.y + (2 * Cos (20 * pi / 180)); Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x + DeltaLineX; GetPoints2.y := BasePoint.y + DeltaLineY; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x + 7; GetPoints2.y := GetPoints2.y; Row3 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; Result := TFigureGrpNotMod.create(NotesLHandle, Owner); Result.AddFigure(Row1); Result.AddFigure(Row2); Result.AddFigure(Row3); Result.Visible := True; Result.Radius := -3; except on E: Exception do addExceptionToLogEx('TOrthoLine.CreateNotesRowGroup', E.Message); end; end; function TConnectorObject.CreateNotesRowGroup(ANotesRowsType: TNotesRowsType; aDeltaLineX: Double = -1; aDeltaLineY: Double = -1): TFigureGrpNotMod; var Row1: TLine; Row2: TLine; BasePoint: TDoublePoint; GetPoints1: TDoublePoint; GetPoints2: TDoublePoint; AngleDeg: Double; NotesLHandle: integer; DeltaLineX, DeltaLineY: Double; begin try Result := nil; NotesLHandle := GCadForm.PCad.GetLayerHandle(6); // if aDeltaLineX = -1 then DeltaLineX := (4 * Sin (45 * pi / 180)) else DeltaLineX := aDeltaLineX; if aDeltaLineY = -1 then DeltaLineY := (4 * Cos (45 * pi / 180)) else DeltaLineY := aDeltaLineY; // if ANotesRowsType = nr_AutoSide then begin ANotesRowsType := nr_DownLeftSide; FNotesRowsType := ANotesRowsType; end; if ANotesRowsType = nr_UpLeftSide then begin // *** if DrawFigure.InFigures.Count > 0 then begin BasePoint.x := DrawFigure.CenterPoint.x - GrpSizeX / 2 + 0.5; BasePoint.y := DrawFigure.CenterPoint.y - GrpSizeY / 2 + 0.5; end else begin BasePoint.x := ActualPoints[1].x - GrpSizeX / 2 + 0.5; BasePoint.y := ActualPoints[1].y - GrpSizeY / 2 + 0.5; end; // GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x - DeltaLineX; GetPoints2.y := BasePoint.y - DeltaLineY; Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x - 7; GetPoints2.y := GetPoints2.y; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; if ANotesRowsType = nr_DownLeftSide then begin // *** if DrawFigure.InFigures.Count > 0 then begin BasePoint.x := DrawFigure.CenterPoint.x - GrpSizeX / 2 + 0.5; BasePoint.y := DrawFigure.CenterPoint.y + GrpSizeY / 2 - 0.5; end else begin BasePoint.x := ActualPoints[1].x - GrpSizeX / 2 + 0.5; BasePoint.y := ActualPoints[1].y + GrpSizeY / 2 - 0.5; end; // GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x - DeltaLineX; GetPoints2.y := BasePoint.y + DeltaLineY; Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x - 7; GetPoints2.y := GetPoints2.y; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; if ANotesRowsType = nr_UpRightSide then begin // *** if DrawFigure.InFigures.Count > 0 then begin BasePoint.x := DrawFigure.CenterPoint.x + GrpSizeX / 2 - 0.5; BasePoint.y := DrawFigure.CenterPoint.y - GrpSizeY / 2 + 0.5; end else begin BasePoint.x := ActualPoints[1].x + GrpSizeX / 2 - 0.5; BasePoint.y := ActualPoints[1].y - GrpSizeY / 2 + 0.5; end; // GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x + DeltaLineX; GetPoints2.y := BasePoint.y - DeltaLineY; Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x + 7; GetPoints2.y := GetPoints2.y; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; if ANotesRowsType = nr_DownRightSide then begin // *** if DrawFigure.InFigures.Count > 0 then begin BasePoint.x := DrawFigure.CenterPoint.x + GrpSizeX / 2 - 0.5; BasePoint.y := DrawFigure.CenterPoint.y + GrpSizeY / 2 - 0.5; end else begin BasePoint.x := ActualPoints[1].x + GrpSizeX / 2 - 0.5; BasePoint.y := ActualPoints[1].y + GrpSizeY / 2 - 0.5; end; // GetPoints1.x := BasePoint.x; GetPoints1.y := BasePoint.y; GetPoints2.x := BasePoint.x + DeltaLineX; GetPoints2.y := BasePoint.y + DeltaLineY; Row1 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); GetPoints1.x := GetPoints2.x; GetPoints1.y := GetPoints2.y; GetPoints2.x := GetPoints2.x + 7; GetPoints2.y := GetPoints2.y; Row2 := TLine.create(GetPoints1.x, GetPoints1.y, GetPoints2.x, GetPoints2.y, 1, ord(psSolid), clBlack, 0, NotesLHandle, mydsNormal, Owner); end; Result := TFigureGrpNotMod.create(NotesLHandle, Owner); Result.AddFigure(Row1); Result.AddFigure(Row2); Result.Visible := True; except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateNotesRowGroup', E.Message); end; end; procedure TConnectorObject.ReCreateNotesGroup(aNeedReCreate: Boolean = False); var i: integer; NotesRows: TFigureGrpNotMod; NotesCaptions: TRichTextMod; NotesRowsPoints: TDoublePoint; NotesLHandle: Integer; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; NotesStrings: TStrings; FRecreate: Boolean; GetResLine: TLine; GetDeltaLineX, GetDeltaLineY: Double; begin try if Self.deleted then exit; if aNeedReCreate then FRecreate := True else begin if ConnectorType = ct_Clear then Exit; if NotesGroup <> nil then begin NotesCaptions := TRichTextMod(NotesGroup.InFigures[1]); NotesStrings := NotesCaptions.re.Lines; end else NotesStrings := nil; FRecreate := IsStringListsDifferent(OutTextNotes, NotesStrings); end; if FRecreate then begin NotesLHandle := GCadForm.PCad.GetLayerHandle(6); // удалить TextBoxesGroup if NotesGroup <> nil then begin NotesRows := TFigureGrpNotMod(TFigureGrp(NotesGroup.InFigures[0])); GetResLine := TLine(NotesRows.InFigures[0]); GetDeltaLineX := abs(GetResLine.ActualPoints[1].x - GetResLine.ActualPoints[2].x); GetDeltaLineY := abs(GetResLine.ActualPoints[1].y - GetResLine.ActualPoints[2].y); end else begin GetDeltaLineX := -1; GetDeltaLineY := -1; end; if NotesGroup <> nil then begin RemoveInFigureGrp(NotesGroup); GCadForm.PCad.Figures.Remove(NotesGroup); FreeAndNil(NotesGroup); end; {!!!} //11.10.2011 }RefreshCAD(GCadForm.PCad); NotesRows := CreateNotesRowGroup(FNotesRowsType, GetDeltaLineX, GetDeltaLineY); NotesRows.Visible := True; {NotesCaptions := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note); NotesCaptions.RE.Lines.Clear; NotesCaptions.RE.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; for i := 0 to OutTextNotes.Count - 1 do NotesCaptions.re.Lines.Add(OutTextNotes[i]); // ПОЛУЧИТЬ СВОЙСТВА xCanvas := TMetafileCanvas.Create(NotesCaptions.Metafile, 0); xCanvas.Font.Name := NotesCaptions.re.Font.Name; xCanvas.Font.Size := NotesCaptions.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * NotesCaptions.re.Lines.Count + 1; w := 0; for i := 0 to NotesCaptions.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(NotesCaptions.Re.Lines[i]) then w := xCanvas.TextWidth(NotesCaptions.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // ПЕРЕСОЗДАТЬ С НОВЫМИ СВОЙСТВАМИ if NotesCaptions <> nil then begin FreeAndNil(NotesCaptions); end;{} GetTextSize(FNotesFontSize, [], FNotesFontName, '', OutTextNotes, h, w); NotesCaptions := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, NotesLHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note); NotesCaptions.RE.Lines.Clear; NotesCaptions.RE.Font.Size := FNotesFontSize; NotesCaptions.re.Font.Name := FNotesFontName; NotesCaptions.re.Font.Color := FNotesFontColor; for i := 0 to OutTextNotes.Count - 1 do begin OutTextNotes[i] := FastReplace(OutTextNotes[i],#13#10,' '); NotesCaptions.re.Lines.Add(OutTextNotes[i]); end; // сдвиг под NotesRowsPoints NotesRowsPoints.x := (TLine(NotesRows.InFigures[1]).ActualPoints[1].x + TLine(NotesRows.InFigures[1]).ActualPoints[2].x) / 2; NotesRowsPoints.y := (TLine(NotesRows.InFigures[1]).ActualPoints[1].y + TLine(NotesRows.InFigures[1]).ActualPoints[2].y) / 2; NotesCaptions.Move(NotesRowsPoints.x - NotesCaptions.CenterPoint.x, NotesRowsPoints.y - NotesCaptions.CenterPoint.y - (h - 1) / 2); NotesCaptions.Visible := True; NotesGroup := TFigureGrpNotMod.create(NotesLHandle, Owner); NotesGroup.AddFigure(NotesRows); NotesGroup.AddFigure(NotesCaptions); NotesGroup.LockModify := True; GCadForm.PCad.AddCustomFigure (GLN(NotesLHandle), NotesGroup, False); end; except on E: Exception do addExceptionToLogEx('TConnectorObject.ReCreateNotesGroup', E.Message); end; end; procedure TConnectorObject.ReCreateCaptionsGroup(aNeedReCreate: Boolean; aReturnToPos: Boolean); var i: integer; CaptionsLHandle: integer; Bnd: TDoubleRect; CapSizeX, CapSizeY: Double; AConnAngle: Double; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; CapStrings: TStrings; FRecreate: Boolean; SavedCaptionPos: TDoublePoint; BetweenCurr: TDoublePoint; BetweenSaved: TDoublePoint; deltaCurr, deltaSaved: Double; a1: double; OutTextStrings: TStringList; begin if Self.deleted then exit; //Tolik OutTextStrings := nil; try if aNeedReCreate then FRecreate := True else begin if ConnectorType = ct_Clear then Exit; if CaptionsGroup <> nil then CapStrings := CaptionsGroup.re.Lines else CapStrings := nil; FRecreate := IsStringListsDifferent(OutTextCaptions, CapStrings); end; if CaptionsGroup <> nil then SavedCaptionPos := CaptionsGroup.CenterPoint; if FRecreate then begin CaptionsLHandle := GCadForm.PCad.GetLayerHandle(4); if CaptionsGroup <> nil then begin GCadForm.PCad.Figures.Remove(CaptionsGroup); FreeAndNil(CaptionsGroup); end; OutTextStrings := TStringList.Create; if GCadForm.FShowObjectCaptionsType = st_Short then begin if OutTextCaptions.Count > 0 then OutTextStrings.Add(OutTextCaptions[0]); end else if GCadForm.FShowObjectCaptionsType = st_Full then begin for i := 1 to OutTextCaptions.Count - 1 do OutTextStrings.Add(OutTextCaptions[i]); end; {//11.10.2011 - Упрощен способ расчета размеров CaptionsGroup := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption); CaptionsGroup.RE.Lines.Clear; CaptionsGroup.RE.Font.Size := FCaptionsFontSize; CaptionsGroup.re.Font.Name := FCaptionsFontName; CaptionsGroup.re.Font.Color := FCaptionsFontColor; //11.10.2011 // //if GCadForm.FShowObjectCaptionsType = st_Short then //begin // if OutTextCaptions.Count > 0 then // CaptionsGroup.re.Lines.Add(OutTextCaptions[0]); //end //else //if GCadForm.FShowObjectCaptionsType = st_Full then //begin // for i := 1 to OutTextCaptions.Count - 1 do // CaptionsGroup.re.Lines.Add(OutTextCaptions[i]); //end; // for i := 1 to OutTextStrings.Count - 1 do CaptionsGroup.re.Lines.Add(OutTextStrings[i]); //11.10.2011 // ПОЛУЧИТЬ СВОЙСТВА xCanvas := TMetafileCanvas.Create(CaptionsGroup.Metafile, 0); xCanvas.Font.Name := CaptionsGroup.re.Font.Name; xCanvas.Font.Size := CaptionsGroup.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * CaptionsGroup.re.Lines.Count + 1; w := 0; for i := 0 to CaptionsGroup.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(CaptionsGroup.Re.Lines[i]) then w := xCanvas.TextWidth(CaptionsGroup.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // ПЕРЕСОЗДАТЬ С НОВЫМИ СВОЙСТВАМИ if CaptionsGroup <> nil then begin FreeAndNil(CaptionsGroup); end; } GetTextSize(FCaptionsFontSize, [], FCaptionsFontName, '', OutTextStrings, h, w); // CaptionsGroup := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, CaptionsLHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption); CaptionsGroup.RE.Lines.Clear; CaptionsGroup.RE.Font.Size := FCaptionsFontSize; CaptionsGroup.re.Font.Name := FCaptionsFontName; CaptionsGroup.re.Font.Color := FCaptionsFontColor; //11.10.2011 //if GCadForm.FShowObjectCaptionsType = st_Short then //begin // if OutTextCaptions.Count > 0 then // CaptionsGroup.re.Lines.Add(OutTextCaptions[0]); //end //else //if GCadForm.FShowObjectCaptionsType = st_Full then //begin // for i := 1 to OutTextCaptions.Count - 1 do // CaptionsGroup.re.Lines.Add(OutTextCaptions[i]); //end; //ShowMessage('Start bug'); for i := 0 to OutTextStrings.Count - 1 do begin OutTextStrings[i] := FastReplace(OutTextStrings[i],#13#10,' '); CaptionsGroup.re.Lines.Add(OutTextStrings[i]); //11.10.2011 end; //ShowMessage('End bug'); GCadForm.PCad.AddCustomFigure(GLN (CaptionsLHandle), CaptionsGroup, False); // Tolik -- 12/11/2016 -- //OutTextStrings.Free; FreeAndNil(OutTextStrings); // end else // *** NEW *** begin a1 := GetLineAngle(CaptionsGroup.ap1, CaptionsGroup.ap2); a1 := DegToRad(a1); CaptionsGroup.Rotate(-a1); end; // *** if DrawFigure.InFigures.Count > 0 then begin CaptionsGroup.Move(RoundTo((DrawFigure.CenterPoint.x - CaptionsGroup.CenterPoint.x), -2), RoundTo((DrawFigure.CenterPoint.y - CaptionsGroup.CenterPoint.y), -2)); end else begin CaptionsGroup.Move(ActualPoints[1].x - CaptionsGroup.CenterPoint.x, ActualPoints[1].y - CaptionsGroup.CenterPoint.y); end; // Bnd := CaptionsGroup.GetBoundRect; CapSizeX := Bnd.Right - Bnd.Left; CapSizeY := Bnd.Bottom - Bnd.Top; AConnAngle := round(FDrawFigureAngle * 180 / pi); // ReplaceAfterRotate if FCaptionsViewType = cv_Right then AConnAngle := 0; if FCaptionsViewType = cv_Down then AConnAngle := 90; if FCaptionsViewType = cv_Left then AConnAngle := 180; if FCaptionsViewType = cv_Up then AConnAngle := 270; if (AConnAngle >= 0) and (AConnAngle <= 45) then begin CaptionsGroup.Move(CapSizeX / 2 + GrpSizeX / 2 + 1, 0); end else if (AConnAngle > 45) and (AConnAngle < 135) then begin CaptionsGroup.Move(0, CapSizeX / 2 + GrpSizeX / 2 + 1); CaptionsGroup.Rotate(- (90 * pi / 180), CaptionsGroup.CenterPoint); end else if (AConnAngle >= 135) and (AConnAngle <= 225) then begin CaptionsGroup.Move( - CapSizeX / 2 - GrpSizeX / 2 - 1, 0); end else if (AConnAngle > 225) and (AConnAngle < 315) then begin CaptionsGroup.Move(0, - CapSizeX / 2 - GrpSizeX / 2 - 1); CaptionsGroup.Rotate(- (90 * pi / 180), CaptionsGroup.CenterPoint); end else if (AConnAngle >= 315) and (AConnAngle <= 360) then begin CaptionsGroup.Move(CapSizeX / 2 + GrpSizeX / 2 + 1, 0); end; // вернуть позицию подписи перед модификацией if aReturnToPos then begin BetweenCurr.x := abs(DrawFigure.CenterPoint.x - CaptionsGroup.CenterPoint.x); BetweenCurr.y := abs(DrawFigure.CenterPoint.y - CaptionsGroup.CenterPoint.y); BetweenSaved.x := abs(DrawFigure.CenterPoint.x - SavedCaptionPos.x); BetweenSaved.y := abs(DrawFigure.CenterPoint.y - SavedCaptionPos.y); deltaCurr := SQRT(SQR(BetweenCurr.x) + SQR(BetweenCurr.y)); deltaSaved := SQRT(SQR(BetweenSaved.x) + SQR(BetweenSaved.y)); if deltaSaved > deltaCurr then CaptionsGroup.Move(SavedCaptionPos.x - CaptionsGroup.CenterPoint.x, SavedCaptionPos.y - CaptionsGroup.CenterPoint.y); end; except on E: Exception do addExceptionToLogEx('TConnectorObject.ReCreateCaptionsGroup', E.Message); end; end; procedure TFrame.RaiseProperties; begin try except on E: Exception do addExceptionToLogEx('TFrame.RaiseProperties', E.Message); end; end; constructor TFrame.create(LHandle: Integer; aOwner: TComponent); begin inherited; end; function TFigureGrpNotMod.Edit: Boolean; var i: Integer; FFigure: TFigure; tempstr: string; ParentLine: TOrthoLine; Height: double; begin Result := False; // двойной клик на подписи трассы - редкатор высоты if GCadForm.FShowLineCaptionsType = skDetail then begin ParentLine := nil; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then if TOrthoLine(FFigure).CaptionsGroup <> nil then // if TOrthoLine(FFigure).CaptionsGroup.ID = ID then if TOrthoLine(FFigure).CaptionsGroup = Self then begin ParentLine := TOrthoLine(FFigure); Break; end; end; if (ParentLine <> nil) and (not ParentLine.FIsRaiseUpDown) then begin tempstr := FormatFloat(ffMask, MetreToUOM(ParentLine.ActualZOrder[1])); if InputQuery(cCadClasses_Mes28, cCadClasses_Mes29, tempstr) then begin try StrToFloat_My(tempstr); except ShowMessage(cSizePos_Mes1); Exit; end; // выше комнаты if StrToFloat_My(tempstr) > MetreToUOM(GCadForm.FRoomHeight) then begin tempstr := FormatFloat(ffMask, MetreToUOM(GCadForm.FRoomHeight)); end; // обработать if tempstr <> '' then begin Height := StrToFloat_My(tempstr); Height := UOMToMetre(Height); // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; RaiseLineOnHeight(ParentLine, Height, nil); RefreshCAD(GCadForm.PCad); {$IF Defined(ES_GRAPH_SC)} GCadForm.CurrentLayer := 8; {$else} GCadForm.CurrentLayer := 2; {$ifend} // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; end; end; end; procedure TFigureGrpNotMod.GetBoundsWithoutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); begin GetBounds(figMaxX, figMaxY, figMinX, figMinY); end; { TSCSHDimLine } class function TSCSHDimLine.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var x3, y3: double; begin try Result := nil; Result := TSCSHDimLine.Create(LHandle, mydsNormal, aOwner); result.ActualPoints[1] := Shadow.ap1; result.ActualPoints[2] := Shadow.ap2; y3 := Shadow.ap3.y; x3 := (Shadow.ap1.x + Shadow.ap2.x) / 2; result.ActualPoints[3] := DoublePoint(x3,y3); TSCSHDimLine(result).LStyle := TSCSHDimLine(Shadow).Lstyle; if GCadForm.FDimLinesType = dlt_None then TSCSHDimLine(result).EndType := etClear; if GCadForm.FDimLinesType = dlt_Row then TSCSHDimLine(result).EndType := etRow; if GCadForm.FDimLinesType = dlt_Stroke then TSCSHDimLine(result).EndType := etNick; TSCSHDimLine(Result).FValue := -1; //TSCSHDimLine(Result).Edit; except on E: Exception do addExceptionToLogEx('TSCSHDimLine.CreateFromShadow', E.Message); end; end; Function TSCSHDimLine.ShadowClick(ClickIndex:Integer;x,y:Double):Boolean; begin result := false; ActualPoints[ClickIndex] := DoublePoint(x,y); if ClickIndex = 2 then begin ActualPoints[3] := DoublePoint(ActualPoints[2].x, ActualPoints[2].y); if ActualPoints[2].y = ActualPoints[1].y then begin ActualPoints[2] := DoublePoint(ActualPoints[2].x, ActualPoints[1].y + 5); ActualPoints[1] := DoublePoint(ActualPoints[1].x, ActualPoints[1].y + 5); end else ActualPoints[2] := DoublePoint(ActualPoints[2].x, ActualPoints[1].y); result := true; end; end; function TSCSHDimLine.ShadowTrace(ClickIndex:Integer; x, y:Double): Boolean; begin if ClickIndex = 1 then begin ActualPoints[2] := DoublePoint(x,y); ActualPoints[3] := DoublePoint(x,y); if abs(ActualPoints[1].x-ActualPoints[2].x) < 10 then Lstyle := hlsRight else LStyle := hlsInner; end else if ClickIndex = 2 then begin ActualPoints[3] := DoublePoint(x,y); end; result := true; end; class function TSCSHDimLine.CreateShadow(x, y: Double): TFigure; begin result := TSCSHDimLine.Create(0,dsTrace,nil); result.ActualPoints[1] := DoublePoint(x,y); result.ActualPoints[2] := DoublePoint(x,y); result.ActualPoints[3] := DoublePoint(x,y); result.color := clLime; TSCSHDimLine(result).Lstyle := hlsInner; end; procedure TSCSHDimLine.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); begin inherited; end; // Tolik 11/08/2021 -- старая закомменчена - см ниже .... //function TSCSHDimLine.Edit: Boolean; Function TSCSHDimLine.Edit: Boolean; var oldVal, newVal: Double; xAction: TUndoAction; ActionVal: integer; s: TMemoryStream; koef: Double; // Tolik 31/10/2022 - List: TSCSList; begin try Result := False; if GuserScaleVal = 0 then begin F_DimLineDialog.Caption := cCadClasses_Mes15; F_DimLineDialog.lbMessage.Caption := cCadClasses_Mes16; if FValue = -1 then FValue := GetValue; // Tolik 13/10/2020 -- //F_DimLineDialog.edDimValue.Properties.EditMask := '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; F_DimLineDialog.edDimValue.Properties.EditMask := '\d?\d?\d?\d?\d?\d?' + DecimalSeparator + '\d?\d?\d?'; //F_DimLineDialog.edDimValue.Text := FormatFloat(ffMask, MetreToUOM(FValue)); F_DimLineDialog.edDimValue.Text := FormatFloat('0.000', MetreToUOM(FValue)); // if F_DimLineDialog.ShowModal = mrOk then begin // *UNDO* // Tolik -- 03/02/2017 -- эта херня не работает, а потом нельзя отменить мастабирование... // так что сорри ... { if Assigned(Self.Owner) then //Tolik -- 15/10/2020 -- как раз работает...а вот Undo -- в данном случае херня... if Self.Owner.Owner = GCadForm then GCadForm.PCad.RecordModifyUndo(Self);} // для ундо все-таки запишем {if Assigned(GCadForm) then begin if GCadForm.FCanSaveForUndo then GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; // 15/10/2020 -- end;} // Tolik 15/10/2020 if assigned(Self.Owner) then if Self.Owner is TPowerCad then if TPowerCad(Self.Owner).RecordUndo then begin xAction := TUndoAction.Create(uaDimLine); xAction.List.Add(Self); // Tolik 15/10/2020 //xAction.Params.Add(Pointer(0)); //xAction.Params.Add(Pointer(ActionVal)); s := TMemoryStream.Create; WriteToStream(s); xAction.Params.Add(s); GCadForm.PCad.InsertUndoAction(xAction); end; // newVal := StrToFloat_My(F_DimLineDialog.edDimValue.Text); newVal := UOMToMetre(newVal); // Tolik 13/10/2020 -- //DLabel := FormatFloat(ffMask, newVal); DLabel := FormatFloat('0.000', newVal); // AutoText := True; Modified := True; Result := True; //Tolik 02/02/2024 if FValue = -1 then FValue := GetValue; // oldVal := FValue; koef := NewVal/OldVal; // Tolik 31/10/2022 -- ReScaleHCAD(oldVal, newVal); FValue := newVal; if Assigned(Self.Owner) then begin if Self.Owner.Owner = GCadForm then ReScaleAllDimLines; TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep := RoundN(TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep*koef, 7); List := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(Self.Owner.Owner).FCADListID); if List <> nil then List.Setting.CADRuleStep := TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep; end; end; end else begin newVal := GuserScaleVal; GuserScaleVal := 0; GisUserDimLine := false; DLabel := FormatFloat('0.000', newVal); FSCS_Main.tbSelectExpert.Click; // AutoText := True; Modified := True; Result := True; //Tolik 02/02/2024 -- if FValue = -1 then FValue := GetValue; // oldVal := FValue; koef := NewVal/oldVal; ReScaleHCAD(oldVal, newVal); FValue := newVal; if Assigned(Self.Owner) then begin if Self.Owner.Owner = GCadForm then ReScaleAllDimLines; TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep := RoundN(TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep*koef, 7); List := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(Self.Owner.Owner).FCADListID); if List <> nil then List.Setting.CADRuleStep := TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep; end; end; except on E: Exception do begin GisUserDimLine := False; GuserScaleVal := 0; addExceptionToLogEx('TSCSHDimLine.Edit', E.Message); end; end; end; (* function TSCSHDimLine.Edit: Boolean; var oldVal, newVal: Double; xAction: TUndoAction; ActionVal: integer; s: TMemoryStream; begin try Result := False; F_DimLineDialog.Caption := cCadClasses_Mes15; F_DimLineDialog.lbMessage.Caption := cCadClasses_Mes16; if FValue = -1 then FValue := GetValue; // Tolik 13/10/2020 -- //F_DimLineDialog.edDimValue.Properties.EditMask := '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; F_DimLineDialog.edDimValue.Properties.EditMask := '\d?\d?\d?\d?\d?\d?' + DecimalSeparator + '\d?\d?\d?'; //F_DimLineDialog.edDimValue.Text := FormatFloat(ffMask, MetreToUOM(FValue)); F_DimLineDialog.edDimValue.Text := FormatFloat('0.000', MetreToUOM(FValue)); // if F_DimLineDialog.ShowModal = mrOk then begin // *UNDO* // Tolik -- 03/02/2017 -- эта херня не работает, а потом нельзя отменить мастабирование... // так что сорри ... { if Assigned(Self.Owner) then //Tolik -- 15/10/2020 -- как раз работает...а вот Undo -- в данном случае херня... if Self.Owner.Owner = GCadForm then GCadForm.PCad.RecordModifyUndo(Self);} // для ундо все-таки запишем {if Assigned(GCadForm) then begin if GCadForm.FCanSaveForUndo then GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; // 15/10/2020 -- end;} // Tolik 15/10/2020 if assigned(Self.Owner) then if Self.Owner is TPowerCad then if TPowerCad(Self.Owner).RecordUndo then begin xAction := TUndoAction.Create(uaDimLine); xAction.List.Add(Self); // Tolik 15/10/2020 //xAction.Params.Add(Pointer(0)); //xAction.Params.Add(Pointer(ActionVal)); s := TMemoryStream.Create; WriteToStream(s); xAction.Params.Add(s); GCadForm.PCad.InsertUndoAction(xAction); end; // newVal := StrToFloat_My(F_DimLineDialog.edDimValue.Text); newVal := UOMToMetre(newVal); // Tolik 13/10/2020 -- //DLabel := FormatFloat(ffMask, newVal); DLabel := FormatFloat('0.000', newVal); // AutoText := True; Modified := True; Result := True; oldVal := FValue; ReScaleHCAD(oldVal, newVal); FValue := newVal; if Assigned(Self.Owner) then if Self.Owner.Owner = GCadForm then ReScaleAllDimLines; end; except on E: Exception do addExceptionToLogEx('TSCSHDimLine.Edit', E.Message); end; end; *) function TSCSHDimLine.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean; begin try Result := False; inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); FValue := GetValue; except on E: Exception do addExceptionToLogEx('TSCSHDimLine.EndModification', E.Message); end; end; //Tolik 14/07/2023 -- если так юзать, то тут MapScale отчень даже отличается от того, что на каде в данній момент...херня получается... { function TSCSHDimLine.GetValue: Double; begin try Result := 0; Result := (abs(ap1.x - ap2.x) * MapScale) / 1000; //Result := round(Result * 100) / 100; Result := round(Result * 1000) / 1000; except on E: Exception do addExceptionToLogEx('TSCSHDimLine.GetValue', E.Message); end; end; } function TSCSHDimLine.GetValue: Double; begin try Result := 0; //Result := (abs(ap1.x - ap2.x) * MapScale) / 1000; Result := (abs(ap1.x - ap2.x) * TPowerCad(Owner).MapScale) / 1000; // так правильно... //Result := round(Result * 100) / 100; Result := round(Result * 1000) / 1000; except on E: Exception do addExceptionToLogEx('TSCSHDimLine.GetValue', E.Message); end; end; // procedure TSCSHDimLine.ReScaleHCAD(aOldValue, aNewValue: Double); begin try if compareValue(ap1.x, ap2.x) = 0 then // Tolik 16/10/2020 -- чтобы не было системной ошибки деления на ноль exit; // если пользоватлье каким-либо образом выставит размер линии в ноль //MapScale := aNewValue * MapScale / aOldValue; //Tolik 25/11/2021 -- //MapScale := aNewValue * 1000 / RoundN(abs(ap1.x - ap2.x), 4); // 05.11.2012 Igor - для корректного расчета масштаба {TODO} MapScale := RoundN(aNewValue * 1000 / RoundN(abs(ap1.x - ap2.x), 4), 7); // 05.11.2012 Igor - для корректного расчета масштаба {TODO} // //GCadForm.PCad.MapScale := MapScale; if Assigned(Self.Owner) then TPowerCad(Self.Owner).MapScale := MapScale; {if Assigned(Self.Owner) then begin if Assigned(Self.Owner.Owner) then begin if TF_CAD(TPowerCad(Self.Owner).Owner).FCanSaveForUndo then begin TF_CAD(TPowerCad(Self.Owner).Owner).SaveForUndo(uat_None, True, False); TF_CAD(TPowerCad(Self.Owner).Owner).FCanSaveForUndo := False; end; end; TPowerCad(Self.Owner).MapScale := MapScale; end; } // except on E: Exception do addExceptionToLogEx('TSCSHDimLine.ReScaleHCAD', E.Message); end; end; procedure TSCSHDimLine.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var xDbl: Double; begin try inherited; case xCode of 221: FValue := pDouble(data)^; end; except on E: Exception do addExceptionToLogEx('TSCSHDimLine.SetPropertyFromStream', E.Message); end; end; procedure TSCSHDimLine.WriteToStream(Stream: TStream); var xDbl: Double; begin try inherited; xDbl := FValue; WriteField(221, Stream, xDbl, sizeof(xDbl)); except on E: Exception do addExceptionToLogEx('TSCSHDimLine.WriteToStream', E.Message); end; end; { TSCSVDimLine } class function TSCSVDimLine.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var x3, y3: double; begin try Result := nil; Result := TSCSVDimLine.Create(LHandle, mydsNormal, aOwner); result.ActualPoints[1] := Shadow.ap1; result.ActualPoints[2] := Shadow.ap2; x3 := Shadow.ap3.x; y3 := (Shadow.ap1.y + Shadow.ap2.y) / 2; result.ActualPoints[3] := DoublePoint(x3, y3); TSCSVDimLine(result).LStyle := TSCSVDimLine(Shadow).Lstyle; if GCadForm.FDimLinesType = dlt_None then TSCSVDimLine(result).EndType := etClear; if GCadForm.FDimLinesType = dlt_Row then TSCSVDimLine(result).EndType := etRow; if GCadForm.FDimLinesType = dlt_Stroke then TSCSVDimLine(result).EndType := etNick; TSCSVDimLine(Result).FValue := -1; except on E: Exception do addExceptionToLogEx('TSCSVDimLine.CreateFromShadow', E.Message); end; end; Function TSCSVDimLine.ShadowClick(ClickIndex:Integer;x,y:Double):Boolean; begin result := false; ActualPoints[ClickIndex] := DoublePoint(x,y); if ClickIndex = 2 then begin ActualPoints[3] := DoublePoint(ActualPoints[2].x, ActualPoints[2].y); if ActualPoints[2].x = ActualPoints[1].x then begin ActualPoints[2] := DoublePoint(ActualPoints[2].x + 5, ActualPoints[2].y); ActualPoints[1] := DoublePoint(ActualPoints[1].x + 5, ActualPoints[1].y); end else ActualPoints[2] := DoublePoint(ActualPoints[1].x, ActualPoints[2].y); result := true; end; end; function TSCSVDimLine.ShadowTrace(ClickIndex:Integer; x, y:Double): Boolean; begin if ClickIndex = 1 then begin ActualPoints[2] := DoublePoint(x,y); ActualPoints[3] := DoublePoint(x,y); end else if ClickIndex = 2 then begin ActualPoints[3] := DoublePoint(x,y); end; if abs(ActualPoints[1].y-ActualPoints[2].y) < 10 then LStyle := vlsTop else Lstyle := vlsInner; result := true; end; class function TSCSVDimLine.CreateShadow(x, y: Double): TFigure; begin result := TSCSVDimLine.Create(0,dsTrace,nil); result.ActualPoints[1] := DoublePoint(x,y); result.ActualPoints[2] := DoublePoint(x,y); result.ActualPoints[3] := DoublePoint(x,y); result.color := clLime; end; procedure TSCSVDimLine.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); begin inherited; end; function TSCSVDimLine.Edit: Boolean; var oldVal, newVal: Double; xAction: TUndoAction; s: TMemoryStream; koef: double; List: TSCSList; begin try Result := False; F_DimLineDialog.Caption := cCadClasses_Mes17; F_DimLineDialog.lbMessage.Caption := cCadClasses_Mes18; if FValue = -1 then FValue := GetValue; // Tolik 13/10/2020 -- три знака перед запятой - слишком мало...иногда полачается наебка из-за того, что реальный // размер не "влазит в маску"...тогда обрезается чосло, что не есть гут... особенно, если это будут сантиметры, например... // или вообще, миллиметры.... F_DimLineDialog.edDimValue.Properties.EditMask := '\d?\d?\d?\d?\d?\d?' + DecimalSeparator + '\d?\d?\d?'; //F_DimLineDialog.edDimValue.Properties.EditMask := '\d?\d?\d?' + DecimalSeparator + '\d?\d?'; // //Tolik 13/10/2020 -*- чтоб было 3 знака после запятой... //F_DimLineDialog.edDimValue.Text := FormatFloat(ffMask, MetreToUOM(FValue)); F_DimLineDialog.edDimValue.Text := FormatFloat('0.000', MetreToUOM(FValue)); // if F_DimLineDialog.ShowModal = mrOk then begin // *UNDO* // Tolik 15/10/2020 -- {if Assigned(Self.Owner) then if Self.Owner.Owner = GCadForm then GCadForm.PCad.RecordModifyUndo(Self);} // Tolik 15/10/2020 if assigned(Self.Owner) then if Self.Owner is TPowerCad then if TPowerCad(Self.Owner).RecordUndo then begin xAction := TUndoAction.Create(uaDimLine); xAction.List.Add(Self); s := TMemoryStream.Create; WriteToStream(s); xAction.Params.Add(s); GCadForm.PCad.InsertUndoAction(xAction); end; // // xAction := TUndoAction.Create(uaDimLine); // xAction.List.Add(Self); // xAction.Params.Add(Pointer(0)); // GCadForm.PCad.InsertUndoAction(xAction); newVal := StrToFloat_My(F_DimLineDialog.edDimValue.Text); newVal := UOMToMetre(newVal); // Tolik 13/10/2020 -- //DLabel := FormatFloat(ffMask, newVal); DLabel := FormatFloat('0.000', newVal); // AutoText := True; Modified := True; Result := True; //Tolik 02/02/2024 -- if FValue = -1 then FValue := GetValue; // oldVal := FValue; koef := newVal/oldVal; ReScaleVCAD(oldVal, newVal); FValue := newVal; if Assigned(Self.Owner) then begin if Self.Owner.Owner = GCadForm then ReScaleAllDimLines; TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep := RoundN(TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep*koef, 7); List := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(Self.Owner.Owner).FCADListID); if List <> nil then List.Setting.CADRuleStep := TF_Cad(Self.Owner.Owner).FListSettings.CADRuleStep; end; end; except on E: Exception do addExceptionToLogEx('TSCSVDimLine.Edit', E.Message); end; end; function TSCSVDimLine.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean; begin try Result := False; inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); FValue := GetValue; except on E: Exception do addExceptionToLogEx('TSCSVDimLine.EndModification', E.Message); end; end; //Tolik 14/07/2023 -- { function TSCSVDimLine.GetValue: Double; begin try Result := 0; Result := (abs(ap1.y - ap2.y) * MapScale) / 1000; //Result := Round(Result * 100) / 100; Result := Round(Result * 1000) / 1000; // except on E: Exception do addExceptionToLogEx('TSCSVDimLine.GetValue', E.Message); end; end; } function TSCSVDimLine.GetValue: Double; begin try Result := 0; //Result := (abs(ap1.y - ap2.y) * MapScale) / 1000; Result := (abs(ap1.y - ap2.y) * TPowerCad(Owner).MapScale) / 1000; //Result := Round(Result * 100) / 100; Result := Round(Result * 1000) / 1000; // except on E: Exception do addExceptionToLogEx('TSCSVDimLine.GetValue', E.Message); end; end; // procedure TSCSVDimLine.ReScaleVCAD(aOldValue, aNewValue: Double); begin try if compareValue(ap1.y, ap2.y) = 0 then // Tolik 16/10/2020 -- чтобы не было системной ошибки деления на ноль exit; // если пользоватлье каким-либо образом выставит размер линии в ноль //MapScale := aNewValue * MapScale / aOldValue; //25/11/2021 -- Tolik -- немножко округлим до 7 знаков. //MapScale := aNewValue * 1000 / RoundN(abs(ap1.y - ap2.y), 4); // 05.11.2012 Igor - для корректного расчета масштаба {TODO} //MapScale := aNewValue * 1000 / RoundN(abs(ap1.y - ap2.y), 4); // 05.11.2012 Igor - для корректного расчета масштаба {TODO} MapScale := RoundN(aNewValue * 1000 / RoundN(abs(ap1.y - ap2.y), 4), 7); // 05.11.2012 Igor - для корректного расчета масштаба {TODO} // //GCadForm.PCad.MapScale := MapScale; if Assigned(Self.Owner) then TPowerCad(Self.Owner).MapScale := MapScale; { //Tolik -- try UNDO 13/10/2020 if Assigned(Self.Owner) then begin if Assigned(Self.Owner.Owner) then begin if TF_CAD(TPowerCad(Self.Owner).Owner).FCanSaveForUndo then begin TF_CAD(TPowerCad(Self.Owner).Owner).SaveForUndo(uat_None, True, False); TF_CAD(TPowerCad(Self.Owner).Owner).FCanSaveForUndo := False; end; end; TPowerCad(Self.Owner).MapScale := MapScale; end; } except on E: Exception do addExceptionToLogEx('TSCSVDimLine.ReScaleVCAD', E.Message); end; end; procedure TSCSVDimLine.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var xDbl: Double; begin try inherited; case xCode of 221: FValue := pDouble(data)^; end; except on E: Exception do addExceptionToLogEx('TSCSVDimLine.SetPropertyFromStream', E.Message); end; end; procedure TSCSVDimLine.WriteToStream(Stream: TStream); var xDbl: Double; begin try inherited; xDbl := FValue; WriteField(221, Stream, xDbl, sizeof(xDbl)); except on E: Exception do addExceptionToLogEx('TSCSVDimLine.WriteToStream', E.Message); end; end; procedure TFrame.Move(deltax, deltay: double); var i: Integer; Figure: TFigure; begin try inherited; {//17.11.2011 if GCadForm.FFrameProjectName <> nil then if not GCadForm.FFrameProjectName.Selected then GCadForm.FFrameProjectName.Move(deltax, deltay); if GCadForm.FFrameListName <> nil then if not GCadForm.FFrameListName.Selected then GCadForm.FFrameListName.Move(deltax, deltay); if GCadForm.FFrameCodeName <> nil then if not GCadForm.FFrameCodeName.Selected then GCadForm.FFrameCodeName.Move(deltax, deltay); if GCadForm.FFrameIndexName <> nil then if not GCadForm.FFrameIndexName.Selected then GCadForm.FFrameIndexName.Move(deltax, deltay);} for i := 0 to GCadForm.FFrameObjects.Count - 1 do begin Figure := TFigure(GCadForm.FFrameObjects.Objects[i]); if Figure <> nil then if not Figure.Selected then Figure.Move(deltax, deltay); end; except on E: Exception do addExceptionToLogEx('TFrame.Move', E.Message); end; end; destructor TFrame.Destroy; begin try inherited; except on E: Exception do addExceptionToLogEx('TFrame.Destroy', E.Message); end; end; { TRichTextMod } constructor TRichTextMod.create(aX1, aY1, aX2, aY2: Double; w, s, c, abrs, abrc, LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent; aObjectType: TRtfObjectType; aNoteType: TRtfNoteType; aAlignment: Integer = 0; AText: Boolean=true); //Tolik var FCanvas: TCanvas; // begin try inherited create(aX1, aY1, aX2, aY2, w, s, c, abrs, abrc, LHandle, aDrawStyle, aOwner, AText); fHasParent := True; Re.Font.Color := clBlack; if aObjectType = rot_Line then begin if aNoteType = rnt_Caption then begin Re.Font.Color := GCadForm.FLinesCaptionsColor; Re.Font.Size := GCadForm.FLinesCaptionsFontSize; end; if aNoteType = rnt_Note then begin Re.Font.Color := GCadForm.FLinesNotesColor; Re.Font.Size := GCadForm.FLinesNotesFontSize; end; end; if aObjectType = rot_Conn then begin if aNoteType = rnt_Caption then begin Re.Font.Color := GCadForm.FConnectorsCaptionsColor; Re.Font.Size := GCadForm.FConnectorsCaptionsFontSize; end; if aNoteType = rnt_Note then begin Re.Font.Color := GCadForm.FConnectorsNotesColor; Re.Font.Size := GCadForm.FConnectorsNotesFontSize; end; end; Re.Font.Style := []; LockModify := True; Re.Alignment := TAlignment(aAlignment); except on E: Exception do addExceptionToLogEx('TRichTextMod.create', E.Message); end; end; procedure TRichTextMod.Delete; begin try if not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // end; except on E: Exception do addExceptionToLogEx('TRichTextMod.Delete', E.Message); end; end; procedure TRichTextMod.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); begin //try if Visible then inherited; //except // on E: Exception do addExceptionToLogEx('TRichTextMod.draw', E.Message); //end; end; function TRichTextMod.edit: Boolean; var i: integer; EditForm: TfrmRichEdit; xStream: TMemorystream; tempstr: string; begin try result := false; exit; inherited edit; if assigned(Lines) then begin EditForm := TFrmRichEdit.Create(owner); EditForm.Caption := cCadClasses_Mes19; xStream := TmemoryStream.Create; Lines.SaveToStream(xStream); xStream.Position := 0; EditForm.RichEdit1.Lines.LoadFromStream(xStream); xStream.Free; if EditForm.ShowModal = mrOk then begin Lines.Clear; for i := 0 to EditForm.RichEdit1.Lines.Count - 1 do begin tempstr := EditForm.RichEdit1.Lines[i]; Lines.Add(tempstr); end; end; editform.free; result := true; end; except on E: Exception do addExceptionToLogEx('TRichTextMod.edit', E.Message); end; end; procedure TRichTextMod.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); begin inherited; fHasParent := False; end; procedure TRichTextMod.WriteToStream(Stream: TStream); begin inherited; end; function TOrthoLine.CreateDuplicate: TOrthoLine; var i: integer; FBlock: TFigure; tempstr: string; x1, x2, y1, y2, z1, z2: double; ObjParams: TObjectParams; JoinConn1, JoinConn2: TConnectorObject; ObjFromRaise: TConnectorObject; // Tolik OldAP1, OldAP2: TDoublePoint; NewAP1, NewAP2: TDoublePoint; ResPoints: TDoublePoint; BoundRect: TRect; deltax, deltay: Double; // begin try Result := nil; x1 := GLastTracedLinePoints1.x; x2 := GLastTracedLinePoints2.x; y1 := GLastTracedLinePoints1.y; y2 := GLastTracedLinePoints2.y; z1 := ActualZOrder[1]; z2 := ActualZOrder[2]; Result := TOrthoLine.Create(x1, y1, z1, x2, y2, z2, FTraceWidth, ord(FTraceStyle), FTraceColor, ord(RowStyle), LayerHandle, mydsNormal, GCadForm.PCad, True, False); Result.OrthoLineType := OrthoLineType; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), Result, False); // Tolik 20/11/2015 //Result.Name := cCadClasses_Mes20; Result.Name := Self.Name; // забыли про спуски/поъембы // SetNewObjectNameInPM(Result.ID, Result.Name); ObjParams := GetFigureParams(Result.ID); Result.Name := ObjParams.Name; Result.FIndex := ObjParams.MarkID; JoinConn1 := TConnectorObject.Create(x1, y1, ActualZOrder[1], LayerHandle, mydsNormal, GCadForm.PCad); JoinConn1.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), JoinConn1, False); JoinConn2 := TConnectorObject.Create(x2, y2, ActualZOrder[2], LayerHandle, mydsNormal, GCadForm.PCad); JoinConn2.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), JoinConn2, False); Result.SetJConnector1(JoinConn1); Result.SetJConnector2(JoinConn2); // Result.JoinConnector1.LockModify := JoinConnector1.LockModify; // Result.JoinConnector1.LockMove := JoinConnector1.LockMove; // Result.JoinConnector1.LockSelect := JoinConnector1.LockSelect; // Result.JoinConnector2.LockModify := JoinConnector2.LockModify; // Result.JoinConnector2.LockMove := JoinConnector2.LockMove; // Result.JoinConnector2.LockSelect := JoinConnector2.LockSelect; Result.JoinConnector1.LockModify := False; Result.JoinConnector1.LockMove := False; Result.JoinConnector1.LockSelect := False; Result.JoinConnector2.LockModify := False; Result.JoinConnector2.LockMove := False; Result.JoinConnector2.LockSelect := False; // присвоение признаков с-п if FIsRaiseUpDown then begin // FConnRaiseType if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then JoinConn1.FConnRaiseType := TConnectorObject(JoinConnector1).FConnRaiseType else JoinConn1.FConnRaiseType := TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]).FConnRaiseType; if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then JoinConn2.FConnRaiseType := TConnectorObject(JoinConnector2).FConnRaiseType else JoinConn2.FConnRaiseType := TConnectorObject(TConnectorObject(JoinConnector2).JoinedConnectorsList[0]).FConnRaiseType; // FObjectFromRaise if JoinConn1.FConnRaiseType <> crt_None then JoinConn1.FObjectFromRaise := JoinConn2 else JoinConn1.FObjectFromRaise := nil; if JoinConn2.FConnRaiseType <> crt_None then JoinConn2.FObjectFromRaise := JoinConn1 else JoinConn2.FObjectFromRaise := nil; Result.FObjectFromRaisedLine := nil; // FObjectFromRaisedLine if FObjectFromRaisedLine <> nil then begin ObjFromRaise := FObjectFromRaisedLine; if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then begin if JoinConnector1 = ObjFromRaise then Result.FObjectFromRaisedLine := JoinConn1; end else begin if TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]) = ObjFromRaise then Result.FObjectFromRaisedLine := JoinConn1; end; if TConnectorObject(JoinConnector2).JoinedConnectorsList.Count = 0 then begin if JoinConnector2 = ObjFromRaise then Result.FObjectFromRaisedLine := JoinConn2; end else begin if TConnectorObject(TConnectorObject(JoinConnector2).JoinedConnectorsList[0]) = ObjFromRaise then Result.FObjectFromRaisedLine := JoinConn2; end; end; Result.JoinConnector1.LockModify := JoinConnector1.LockModify; Result.JoinConnector1.LockMove := JoinConnector1.LockMove; Result.JoinConnector1.LockSelect := JoinConnector1.LockSelect; Result.JoinConnector2.LockModify := JoinConnector2.LockModify; Result.JoinConnector2.LockMove := JoinConnector2.LockMove; Result.JoinConnector2.LockSelect := JoinConnector2.LockSelect; end; /// Result.isSnap := isSnap; Result.isTraceShow := isTraceShow; Result.IsShowBlock := IsShowBlock; Result.FIsRaiseUpDown := FIsRaiseUpDown; Result.FIsVertical := FIsVertical; Result.ShowLength := ShowLength; Result.ShowCaptions := ShowCaptions; Result.ShowNotes := ShowNotes; Result.IsLengthAboveLimit := IsLengthAboveLimit; Result.FNotRecalcLength := FNotRecalcLength; // св-ва измененнных полей Result.FIsNameChanged := FIsNameChanged; Result.FIsCaptionsChanged := FIsCaptionsChanged; Result.FIsNotesChanged := FIsNameChanged; Result.FIsBlockChanged := FIsBlockChanged; Result.FCount := FCount; Result.FBlockID := FBlockID; Result.FObjectType := FObjectType; Result.FBlockGUID := FBlockGUID; Result.FTraceWidth := FTraceWidth; Result.BlockStep := BlockStep; Result.FGap := FGap; Result.UserLength := UserLength; Result.CalculLength := CalculLength; Result.FDrawFigureAngle := FDrawFigureAngle; Result.SaveCaption := SaveCaption; Result.tmpCaptionsGroup := tmpCaptionsGroup; Result.tmpNotesCaptions := tmpNotesCaptions; Result.FCableFullnessSide1 := FCableFullnessSide1; Result.FCableFullnessSide2 := FCableFullnessSide2; Result.FCableChannelFullness := FCableChannelFullness; Result.FCableChannelClosedSide1 := FCableChannelClosedSide1; Result.FCableChannelClosedSide2 := FCableChannelClosedSide2; Result.FLineType := FLineType; Result.FLineRaiseType := FLineRaiseType; Result.FNetworkTypes := FNetworkTypes; Result.FNotesRowsType := FNotesRowsType; Result.FCaptionsViewType := FCaptionsViewType; // вид отображения трасс Result.FTraceColor := FTraceColor; Result.FTraceStyle := FTraceStyle; Result.ActualZOrder[1] := ActualZOrder[1]; Result.ActualZOrder[2] := ActualZOrder[2]; Result.LineLength := LineLength; Result.FCabinetID := FCabinetID; Result.FConnectingLine := FConnectingLine; Result.FConnectingPos := FConnectingPos; Result.FCaptionsFontBold := FCaptionsFontBold; Result.FCaptionsFontSize := FCaptionsFontSize; Result.FNotesFontSize := FNotesFontSize; Result.FExistOtherObjectType := FExistOtherObjectType; Result.FSingleBlockDelta := FSingleBlockDelta; Result.FOriginalSizeX := FOriginalSizeX; Result.FOriginalSizeY := FOriginalSizeY; Result.FDrawFigurePercent := FDrawFigurePercent; // dupl CaptionsGroup Result.OutTextCaptions.Clear; for i := 0 to OutTextCaptions.Count - 1 do begin tempstr := OutTextCaptions.Strings[i]; Result.OutTextCaptions.Add(tempstr); end; // dupl NotesGroup Result.OutTextNotes.Clear; for i := 0 to OutTextNotes.Count - 1 do begin tempstr := OutTextNotes.Strings[i]; Result.OutTextNotes.Add(tempstr); end; DublicateObjectComponents(ID, Result.ID); // передать усл. обозначение for i := 0 to FSingleBlock.InFigures.Count - 1 do begin FBlock := TFigure(FSingleBlock.InFigures[i]).Duplicate; Result.FSingleBlock.AddFigure(FBlock); end; Result.ReCreateDrawFigureBlock; Result.ReCreateCaptionsGroup(false, false); Result.ReCreateNotesGroup; Result.LockModify := LockModify; Result.LockMove := LockMove; Result.LockSelect := LockSelect; Result.tmpDrawShadow := False; Result.Move(0.01, 0.01); Result.Move(-0.01, -0.01); // Tolik // deltax := Self.CaptionsGroup.ActualPoints[1].x - Result.CaptionsGroup.ActualPoints[1].x; // deltay := Self.CaptionsGroup.ActualPoints[1].y - Result.CaptionsGroup.ActualPoints[1].y; // dupl CaptionsGroup { Result.OutTextCaptions.Clear; Result.CaptionsGroup.Move(deltax, deltay); for i := 0 to OutTextCaptions.Count - 1 do begin tempstr := OutTextCaptions.Strings[i]; Result.OutTextCaptions.Add(tempstr); end; Result.ReCreateCaptionsGroup(false, false);} // except on E: Exception do addExceptionToLogEx('TOrthoLine.CreateDuplicate', E.Message); end; end; function TConnectorObject.CreateDuplicate(x, y: double): TConnectorObject; var i: integer; tempstr: string; z: double; ObjParams: TObjectParams; DrawDeltaX, DrawDeltaY: Double; begin try Result := nil; z := ActualZOrder[1]; Result := TConnectorObject.Create(x, y, z, LayerHandle, mydsNormal, GCadForm.PCad); Result.ConnectorType := ConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), Result, False); Result.Name := cCadClasses_Mes21; SetNewObjectNameInPM(Result.ID, Result.Name); ObjParams := GetFigureParams(Result.ID); Result.Name := ObjParams.Name; Result.FIndex := ObjParams.MarkID; // Properties Result.isPrevSnap := isPrevSnap; Result.isSnap := isSnap; Result.AsEndPoint := False; //AsEndPoint; Result.ShowCaptions := ShowCaptions; Result.ShowNotes := ShowNotes; Result.FCornerTypeChangedByUser := FCornerTypeChangedByUser; // св-ва измененнных полей Result.FIsNameChanged := FIsNameChanged; Result.FIsCaptionsChanged := FIsCaptionsChanged; Result.FIsNotesChanged := FIsNotesChanged; Result.FIsBlockChanged := FIsBlockChanged; // для межэтажных переходов Result.FBlockID := FBlockID; Result.FObjectType := FObjectType; Result.FBlockGUID := FBlockGUID; // св-во для шкафа, привязка к листу Result.FLHandle := FLHandle; Result.FDrawFigureAngle := FDrawFigureAngle; Result.tmpCaptionsGroup := tmpCaptionsGroup; Result.tmpNotesCaptions := tmpNotesCaptions; Result.FConnFullness := FConnFullness; // для подъемов Result.FNetworkTypes := FNetworkTypes; Result.FNotesRowsType := FNotesRowsType; Result.FCaptionsViewType := FCaptionsViewType; // тип уголка для коннектора Result.FCornerType := FCornerType; Result.ActualZOrder[1] := ActualZOrder[1]; Result.DrawFigure := TFigureGrpMod(DrawFigure.Duplicate); // Tolik 20/10/2016 -- { DrawDeltaX := DrawFigure.ActualPoints[1].x - Result.ActualPoints[1].x; DrawDeltaY := DrawFigure.ActualPoints[1].y - Result.ActualPoints[1].y; Result.DrawFigure.move(-DrawDeltaX, -DrawDeltaY); } // Result.FCabinetID := FCabinetID; Result.FTrunkName := FTrunkName; Result.FDisableTracing := FDisableTracing; Result.FMirrored := FMirrored; Result.FCaptionsFontSize := FCaptionsFontSize; Result.FNotesFontSize := FNotesFontSize; Result.FOriginalSizeX := FOriginalSizeX; Result.FOriginalSizeY := FOriginalSizeY; Result.FDrawFigurePercent := FDrawFigurePercent; // dupl CaptionsGroup Result.OutTextCaptions.Clear; for i := 0 to OutTextCaptions.Count - 1 do begin tempstr := OutTextCaptions.Strings[i]; Result.OutTextCaptions.Add(tempstr); end; // dupl NotesGroup Result.OutTextNotes.Clear; for i := 0 to OutTextNotes.Count - 1 do begin tempstr := OutTextNotes.Strings[i]; Result.OutTextNotes.Add(tempstr); end; // дублировать все комплектующие в ПМ DublicateObjectComponents(ID, Result.ID); Result.ReCreateNotesGroup; Result.ReCreateCaptionsGroup(false, false); if Result.DrawFigure <> nil then begin AutoShiftObject(Result); end; Result.LockModify := LockModify; Result.LockMove := LockMove; Result.LockSelect := LockSelect; except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateDuplicate', E.Message); end; end; function TConnectorObject.CreateCrossATSDuplicate(x, y: double): TConnectorObject; var DupConn: TConnectorObject; DupLine: TOrthoLine; i, j: Integer; Line: TOrthoLine; Traces: TList; MovedConnsList: TList; deltax, deltay: Double; begin try Result := nil; DupConn := CreateDuplicate(x, y); Traces := GetAllConnectingTraces(Self); deltax := DupConn.ActualPoints[1].x - ActualPoints[1].x; deltay := DupConn.ActualPoints[1].y - ActualPoints[1].y; MovedConnsList := TList.Create; for i := 0 to Traces.Count - 1 do begin Line := TOrthoLine(Traces[i]); GLastTracedLinePoints1 := Line.ActualPoints[1]; GLastTracedLinePoints2 := Line.ActualPoints[2]; DupLine := Line.CreateDuplicate; if CheckNoFigureInList(DupLine.JoinConnector1, MovedConnsList) then begin DupLine.JoinConnector1.Move(deltax, deltay); MovedConnsList.Add(DupLine.JoinConnector1); end; if CheckNoFigureInList(DupLine.JoinConnector2, MovedConnsList) then begin DupLine.JoinConnector2.Move(deltax, deltay); MovedConnsList.Add(DupLine.JoinConnector2); end; //Tolik -- //SnapConnectorToPointObject(TConnectorObject(DupLine.JoinConnector2), DupConn); CheckingSnapPointObjectToConnector(DupConn, TConnectorObject(DupLine.JoinConnector2), False, True); // DupLine.JoinConnector2.LockSelect := True; DupLine.JoinConnector2.LockMove := True; DupLine.JoinConnector2.LockModify := True; GLastTracedLinePoints1 := DoublePoint(-10000, -10000); GLastTracedLinePoints2 := DoublePoint(-10000, -10000); end; Result := DupConn; FreeAndNil(MovedConnsList); FreeAndNil(Traces); except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateCrossATSDuplicate', E.Message); end; end; function TConnectorObject.CreateDistribCabDuplicate(x, y: double): TConnectorObject; var i, j: Integer; DupConn: TConnectorObject; DupLine: TOrthoLine; Line: TOrthoLine; Traces: TList; MovedConnsList: TList; deltax, deltay: Double; begin try Result := nil; // Exit; DupConn := CreateDuplicate(x, y); Traces := GetAllConnectingTraces(Self); deltax := DupConn.ActualPoints[1].x - ActualPoints[1].x; deltay := DupConn.ActualPoints[1].y - ActualPoints[1].y; MovedConnsList := TList.Create; for i := 0 to Traces.Count - 1 do begin Line := TOrthoLine(Traces[i]); GLastTracedLinePoints1 := Line.ActualPoints[1]; GLastTracedLinePoints2 := Line.ActualPoints[2]; DupLine := Line.CreateDuplicate; if CheckNoFigureInList(DupLine.JoinConnector1, MovedConnsList) then begin DupLine.JoinConnector1.Move(deltax, deltay); MovedConnsList.Add(DupLine.JoinConnector1); end; if CheckNoFigureInList(DupLine.JoinConnector2, MovedConnsList) then begin DupLine.JoinConnector2.Move(deltax, deltay); MovedConnsList.Add(DupLine.JoinConnector2); end; // Tolik 03/04/2018 -- //SnapConnectorToPointObject(TConnectorObject(DupLine.JoinConnector2), DupConn); CheckingSnapPointObjectToConnector(DupConn, TConnectorObject(DupLine.JoinConnector2), False, True); // DupLine.JoinConnector2.LockSelect := True; DupLine.JoinConnector2.LockMove := True; DupLine.JoinConnector2.LockModify := True; GLastTracedLinePoints1 := DoublePoint(-10000, -10000); GLastTracedLinePoints2 := DoublePoint(-10000, -10000); end; Result := DupConn; FreeAndNil(MovedConnsList); FreeAndNil(Traces); except on E: Exception do addExceptionToLogEx('TConnectorObject.CreateDistribCabDuplicate', E.Message); end; end; { TPlanObject } constructor TPlanObject.create(LHandle: Integer; aOwner: TComponent); begin try inherited create(LHandle, aOwner); JoinedConnectors := TList.Create; SetLength(FJoinedConnectorsIndexes, 0); FSCSID := -1; FMoveWithConnector := True; except on E: Exception do addExceptionToLogEx('TPlanObject.create', E.Message); end; end; //Tolik 23/02/2018 -- destructor TPlanObject.Destroy; var i, j: Integer; JoinConn: TPlanConnector; begin try for i := 0 to JoinedConnectors.Count - 1 do begin JoinConn := TPlanConnector(JoinedConnectors[i]); JoinConn.JoinedPlanObject := nil; JoinConn.LockModify := False; JoinConn.LockMove := False; JoinConn.LockSelect := False; end; except on E: Exception do addExceptionToLogEx('TPlanObject.Delete', E.Message); end; //Tolik SetLength(FJoinedConnectorsIndexes,0); JoinedConnectors.Clear; JoinedConnectors.Free; JoinedConnectors := Nil; inherited; end; procedure TPlanObject.Delete; var i, j: Integer; JoinConn: TPlanConnector; begin try if not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // for i := 0 to JoinedConnectors.Count - 1 do begin JoinConn := TPlanConnector(JoinedConnectors[i]); JoinConn.JoinedPlanObject := nil; JoinConn.LockModify := False; JoinConn.LockMove := False; JoinConn.LockSelect := False; end; end; except on E: Exception do addExceptionToLogEx('TPlanObject.Delete', E.Message); end; //Tolik SetLength(FJoinedConnectorsIndexes,0); JoinedConnectors.Clear; // Tolik 07/06/2021 - - это здесь низзя!!!! //JoinedConnectors.Free; end; function TPlanObject.Edit: Boolean; var Caption: TRichText; i, k: Integer; CaptionsList: TStringList; LHandle: Integer; Block: TBlock; BlockBnd: TDoubleRect; BlockX, BlockY: double; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; BlockCP: TDoublePoint; begin try Result := false; Caption := nil; if CheckFigureByClassName(TFigure(InFigures[0]), 'TRichText') then begin Caption := TRichText(InFigures[0]); Block := TBlock(InFigures[1]); end else if CheckFigureByClassName(TFigure(InFigures[1]), 'TRichText') then begin Caption := TRichText(InFigures[1]); Block := TBlock(InFigures[0]); end; if Caption <> nil then begin Caption.edit; end; // Correct caption CaptionsList := TStringList.Create; for i := 0 to Caption.re.Lines.Count - 1 do CaptionsList.Add(Caption.re.Lines[i]); RemoveFromGrp(Caption); //28.04.2011 InFigures.Remove(Caption); FreeAndNil(Caption); BlockBnd := Block.GetBoundRect; BlockX := abs(BlockBnd.Left - BlockBnd.Right); BlockY := abs(BlockBnd.Top - BlockBnd.Bottom); for k := 14 downto 1 do begin //11.10.2011 - Упрощен способ расчета размеров {Caption := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.re.Font.Size := k; Caption.RE.Lines.Clear; for i := 0 to CaptionsList.Count - 1 do Caption.re.Lines.Add(CaptionsList[i]); GCadForm.PCad.AddCustomFigure(1, Caption, False); RefreshCAD(GCadForm.PCad); // получить свойства xCanvas := TMetafileCanvas.Create(Caption.Metafile, 0); xCanvas.Font.Name := Caption.re.Font.Name; xCanvas.Font.Size := Caption.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Caption.re.Lines.Count + 1; w := 0; for i := 0 to Caption.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(Caption.Re.Lines[i]) then w := xCanvas.TextWidth(Caption.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // пересоздать с новыми свойствами if Caption <> nil then begin GCadForm.PCad.Figures.Remove(Caption); FreeAndNil(Caption); end;} GetTextSize(k, [], GCadForm.PCad.Font.Name, '', CaptionsList, h, w); //11.10.2011 ширина w не нужна if (k = 1) or (w < BlockX) and (h < BlockY) then begin Caption := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.re.Font.Size := k; Caption.RE.Lines.Clear; for i := 0 to CaptionsList.Count - 1 do begin CaptionsList[i] := FastReplace(CaptionsList[i],#13#10,' '); Caption.re.Lines.Add(CaptionsList[i]); end; RefreshCAD(GCadForm.PCad); Break; end; end; // подгонка подписи под УО BlockCP.x := BlockBnd.Left + BlockX / 2; BlockCP.y := BlockBnd.Top + BlockY / 2; Caption.Move(BlockCP.x - Caption.CenterPoint.x, BlockCP.y - Caption.CenterPoint.y); AddFigure(Caption); FreeAndNil(CaptionsList); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TPlanObject.Edit', E.Message); end; end; function TPlanObject.IsPointIn(x, y: Double): Boolean; var CP: TDoublePoint; begin try Result := False; CP := CenterPoint; if (x >= CP.x - FSizeX / 2) and (x <= CP.x + FSizeX / 2) and (y >= CP.y - FSizeY / 2) AND (y <= CP.y + FSizeY / 2) then Result := True; except on E: Exception do addExceptionToLogEx('TPlanObject.IsPointIn', E.Message); end; end; procedure TPlanObject.move(deltax, deltay: double); var i, j: integer; JoinTrace: TPlanTrace; JoinConn: TPlanConnector; p1, p2: TDoublePoint; OtherConn: TPlanConnector; otherdeltax, otherdeltay: double; begin try deltax := GetCoordXWithSnapToGrid(deltax); deltay := GetCoordYWithSnapToGrid(deltay); inherited; for i := 0 to JoinedConnectors.Count - 1 do begin JoinConn := TPlanConnector(JoinedConnectors[i]); JoinConn.move(deltax, deltay); for j := 0 to JoinConn.JoinedTraces.Count - 1 do begin JoinTrace := TPlanTrace(JoinConn.JoinedTraces[j]); if JoinTrace.JoinObject1 = JoinConn then begin p1 := DoublePoint(JoinTrace.ActualPoints[1].x - deltax, JoinTrace.ActualPoints[1].y - deltay); p2 := DoublePoint(JoinTrace.ActualPoints[2].x, JoinTrace.ActualPoints[2].y); if FMoveWithConnector then begin if CheckFigureByClassName(JoinTrace.JoinObject2, cTPlanConnector) then begin otherdeltax := deltax; otherdeltay := deltay; if abs(p1.x - p2.x) < 0.1 then otherdeltay := 0; if abs(p1.y - p2.y) < 0.1 then otherdeltax := 0; OtherConn := TPlanConnector(JoinTrace.JoinObject2); OtherConn.Move(otherdeltax, otherdeltay); end; end; end; if JoinTrace.JoinObject2 = JoinConn then begin p1 := DoublePoint(JoinTrace.ActualPoints[1].x, JoinTrace.ActualPoints[1].y); p2 := DoublePoint(JoinTrace.ActualPoints[2].x - deltax, JoinTrace.ActualPoints[2].y - deltay); if FMoveWithConnector then begin if CheckFigureByClassName(JoinTrace.JoinObject1, cTPlanConnector) then begin otherdeltax := deltax; otherdeltay := deltay; if abs(p1.x - p2.x) < 0.1 then otherdeltay := 0; if abs(p1.y - p2.y) < 0.1 then otherdeltax := 0; OtherConn := TPlanConnector(JoinTrace.JoinObject1); OtherConn.Move(otherdeltax, otherdeltay); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TPlanObject.move', E.Message); end; end; procedure TPlanObject.RaiseProperties(CadFigList: TList); var i: integer; Connector: TPlanConnector; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else //Tolik // FiguresList := GCadForm.PCad.Figures; FiguresList := CadFigList; // FMoveWithConnector := True; for i := 0 to Length(FJoinedConnectorsIndexes) - 1 do begin Connector := TPlanConnector(FiguresList.Items[FJoinedConnectorsIndexes[i]]); JoinedConnectors.Add(Connector); end; except on E: Exception do addExceptionToLogEx('TPlanObject.RaiseProperties', E.Message); end; end; procedure TPlanObject.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var FindCode: Integer; xInt: Integer; begin try inherited; case xCode of 27: begin xInt := pInt(data)^; FFloorNumber := xInt; end; 28: begin xInt := pInt(data)^; FCabNumber := xInt; end; 29: begin xInt := pInt(data)^; FSCSID := xInt; end; 230: FSizeX := pDouble(data)^; 231: FSizeY := pDouble(data)^; end; if (xCode >= 30) AND (xCode <= 60) then begin FindCode := Length(FJoinedConnectorsIndexes); FindCode := FindCode + 1; SetLength(FJoinedConnectorsIndexes, FindCode); xInt := pInt(data)^; FJoinedConnectorsIndexes[FindCode - 1] := xInt; end; if JoinedConnectors = nil then JoinedConnectors := TList.Create; except on E: Exception do addExceptionToLogEx('TPlanObject.SetPropertyFromStream', E.Message); end; end; procedure TPlanObject.WriteToStream(Stream: TStream); var i: integer; xInt: Integer; xDbl: Double; xBool: Boolean; FiguresList: TList; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; xInt := FFloorNumber; WriteField(27, Stream, xInt, sizeof(xInt)); xInt := FCabNumber; WriteField(28, Stream, xInt, sizeof(xInt)); xInt := FSCSID; WriteField(29, Stream, xInt, sizeof(xInt)); for i := 0 to JoinedConnectors.Count - 1 do begin xInt := FiguresList.IndexOf(JoinedConnectors[i]); if ((30 + i) <= 60) then WriteField(30 + i, Stream, xInt, sizeof(xInt)) end; xDbl := FSizeX; WriteField(230, Stream, xDbl, sizeof(xDbl)); xDbl := FSizeY; WriteField(231, Stream, xDbl, sizeof(xDbl)); except on E: Exception do addExceptionToLogEx('TPlanObject.WriteToStream', E.Message); end; end; { TPlanTrace } constructor TPlanTrace.create(aX1, aY1, aX2, aY2: Double; w, s, c, row, LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); begin try inherited create(aX1, aY1, aX2, aY2, w, s, c, row, LHandle, aDrawStyle, aOwner); // Tolik -- 23/02/2018 -- //JoinObject1 := TFigure.Create(LHandle, mydsNormal, aOwner); //JoinObject2 := TFigure.Create(LHandle, mydsNormal, aOwner); JoinObject1 := Nil; JoinObject2 := Nil; // OriginalPoints[1] := DoublePoint(aX1,aY1); OriginalPoints[2] := DoublePoint(aX2,aY2); ActualPoints[1] := DoublePoint(aX1,aY1); ActualPoints[2] := DoublePoint(aX2,aY2); Caption := nil; except on E: Exception do addExceptionToLogEx('TPlanTrace.create', E.Message); end; end; //Tolik 23/02/2018 -- destructor TPlanTrace.destroy; begin { if Caption <> nil then begin if GCadForm.PCad.Figures.IndexOf(Caption) = -1 then FreeAndNil(Caption); end; } JoinObject1 := Nil; JoinObject2 := Nil; //TPlanConnector(JoinObject1).JoinedTraces.Remove(Self); //TPlanConnector(JoinObject2).JoinedTraces.Remove(Self); end; function TPlanTrace.CreateModification: TFigure; begin try Result := nil; Result := TPlanTrace.Create(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y, 1, ord(psSolid), clBlack, 0, 0, dsTrace, nil); except on E: Exception do addExceptionToLogEx('TPlanTrace.CreateModification', E.Message); end; end; procedure TPlanTrace.Delete; begin try if not Deleted then begin Deleted := true; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); //Tolik 22/06/2021 -- if Caption <> nil then begin Caption.Deleted := True; TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); end; // end; TPlanConnector(JoinObject1).JoinedTraces.Remove(Self); TPlanConnector(JoinObject2).JoinedTraces.Remove(Self); except on E: Exception do addExceptionToLogEx('TPlanTrace.Delete', E.Message); end; end; procedure TPlanTrace.Draw(DEngine: TPCDrawEngine; isFlue: Boolean); var x1, x2, y1, y2: Double; points: array[0..1] of TDoublePoint; Conn1, Conn2: TPlanConnector; begin try If Deleted then Exit; if (DrawStyle = dsTrace) then begin DEngine.Canvas.Pen.Mode := pmXor; DEngine.Canvas.Pen.Color := clBlue xor clWhite; DEngine.Canvas.Pen.Style := psDash; DEngine.Canvas.Pen.Width := 2; DEngine.Canvas.Brush.Style := bsClear; DEngine.Canvas.Brush.Color := clBlack; x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; RowStyle := ord(rsNone); end else begin DEngine.Canvas.Pen.Mode := pmCopy; DEngine.Canvas.Pen.Color := color; DEngine.Canvas.Pen.Width := width; DEngine.Canvas.Pen.Style := TPenStyle(style); x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; Conn1 := TPlanConnector(JoinObject1); Conn2 := TPlanConnector(JoinObject2); RowStyle := ord(rsNone); if ((Conn1 <> nil) and (Conn2 <> nil)) and (SCSClassDetect(Conn1) and SCSClassDetect(Conn2)) then begin if (Conn1.JoinedPlanObject <> nil) and (Conn2.JoinedPlanObject = nil) then RowStyle := ord(rsLeftSolid); if (Conn1.JoinedPlanObject = nil) and (Conn2.JoinedPlanObject <> nil) then RowStyle := ord(rsRightSolid); if (Conn1.JoinedPlanObject <> nil) and (Conn2.JoinedPlanObject <> nil) then RowStyle := ord(rsBothSolid); end; if Selected then begin DEngine.Canvas.Pen.Width := 2; DEngine.Canvas.Pen.Style := psSolid; DEngine.Canvas.Pen.Color := clYellow; end; end; points[0].x := x1; points[0].y := y1; points[1].x := x2; points[1].y := y2; DEngine.drawline(points[0], points[1], ord(DEngine.Canvas.Pen.Color), DEngine.Canvas.Pen.Width, Style, ord(RowStyle), rowL, rowH, rowWhite); except on E: Exception do addExceptionToLogEx('TPlanTrace.Draw', E.Message); end; end; procedure TPlanTrace.GetModPoints(ModList: TMyList); begin // inherited; end; function TPlanTrace.isPointIn(x, y: Double): boolean; var x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6: Double; len, f, Gap2: Extended; RegHandle: HRGN; Points: array[0..4] of TPoint; BasisPoints: TDoublePoint; begin try Result := false; x1 := ActualPoints[1].x; y1 := ActualPoints[1].y; x2 := ActualPoints[2].x; y2 := ActualPoints[2].y; Gap2 := 0.5; len := sqrt(sqr(x1 - x2) + sqr(y1 - y2)); if len = 0 then len := 0.001; f := arcsin((abs(y1 - y2) / len)) * 180 / pi; if ((x1 < x2) and (y1 > y2)) or ((x1 > x2) and (y1 < y2)) then f := f * (-1); try x3 := Gap2 * cos((f - 90) * pi / 180) + x1; y3 := Gap2 * sin((f - 90) * pi / 180) + y1; x4 := Gap2 * cos((f + 90) * pi / 180) + x1; y4 := Gap2 * sin((f + 90) * pi / 180) + y1; x5 := Gap2 * cos((f - 90) * pi / 180) + x2; y5 := Gap2 * sin((f - 90) * pi / 180) + y2; x6 := Gap2 * cos((f + 90) * pi / 180) + x2; y6 := Gap2 * sin((f + 90) * pi / 180) + y2; except Result := false; Exit; end; Points[0].x := round(x3 * 100); Points[0].y := round(y3 * 100); Points[1].x := round(x5 * 100); Points[1].y := round(y5 * 100); Points[2].x := round(x6 * 100); Points[2].y := round(y6 * 100); Points[3].x := round(x4 * 100); Points[3].y := round(y4 * 100); RegHandle := CreatePolygonRgn(Points, 4, WINDING); result := PtInRegion(RegHandle, round(x * 100), round(y * 100)); DeleteObject(RegHandle); except on E: Exception do addExceptionToLogEx('TPlanTrace.isPointIn', E.Message); end; end; procedure TPlanTrace.Move(deltax, deltay: Double); begin try if DrawStyle = dsTrace then begin if abs(ActualPoints[1].x - ActualPoints[2].x) < 0.1 then begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y); ActualPoints[2] := DoublePoint(ActualPoints[2].x + deltax, ActualPoints[2].y); end else if abs(ActualPoints[1].y - ActualPoints[2].y) < 0.1 then begin ActualPoints[1] := DoublePoint(ActualPoints[1].x, ActualPoints[1].y + deltay); ActualPoints[2] := DoublePoint(ActualPoints[2].x, ActualPoints[2].y + deltay); end else begin ActualPoints[1] := DoublePoint(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); ActualPoints[2] := DoublePoint(ActualPoints[2].x + deltax, ActualPoints[2].y + deltay); end; end else begin if abs(ActualPoints[1].x - ActualPoints[2].x) < 0.1 then deltay := 0 else if abs(ActualPoints[1].y - ActualPoints[2].y) < 0.1 then deltax := 0; if not JoinObject1.Selected then TPlanConnector(JoinObject1).Move(deltax, deltay); if not JoinObject2.Selected then TPlanConnector(JoinObject2).Move(deltax, deltay); end; except on E: Exception do addExceptionToLogEx('TPlanTrace.Move', E.Message); end; end; procedure TPlanTrace.RaiseProperties(CadFigList: TList); var FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else //Tolik // FiguresList := GCadForm.PCad.Figures; FiguresList := CadfigList; // SetJConnector1(FiguresList.Items[FJoinObject1Index]); SetJConnector2(FiguresList.Items[FJoinObject2Index]); if FCaptionIndex = - 1 then Caption := Nil else Caption := TRichText(FiguresList.Items[FCaptionIndex]); except on E: Exception do addExceptionToLogEx('TPlanTrace.RaiseProperties', E.Message); end; end; procedure TPlanTrace.SetJConnector1(aObject: TFigure); begin try if CheckFigureByClassName(aObject, cTPlanConnector) then begin JoinObject1 := aObject; TPlanConnector(aObject).JoinedTraces.Add(Self); end; except on E: Exception do addExceptionToLogEx('TPlanTrace.SetJConnector1', E.Message); end; end; procedure TPlanTrace.SetJConnector2(aObject: TFigure); begin try if CheckFigureByClassName(aObject, cTPlanConnector) then begin JoinObject2 := aObject; TPlanConnector(aObject).JoinedTraces.Add(Self); end; except on E: Exception do addExceptionToLogEx('TPlanTrace.SetJConnector2', E.Message); end; end; procedure TPlanTrace.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); var xInt: integer; xStr: string; DataP: PChar; begin try inherited; case xCode of 29: begin xInt := pInt(data)^; FCaptionIndex := xInt; end; 30: begin xInt := pInt(data)^; FJoinObject1Index := xInt; end; 31: begin xInt := pInt(data)^; FJoinObject2Index := xInt; end; 32: begin xInt := pInt(data)^; FBegSCSID := xInt; end; 33: begin xInt := pInt(data)^; FEndSCSID := xInt; end; 215: begin DataP := data; xStr := DataP; FBegType := xStr; end; 216: begin DataP := data; xStr := DataP; FEndType := xStr; end; end; except on E: Exception do addExceptionToLogEx('TPlanTrace.SetPropertyFromStream', E.Message); end; end; procedure TPlanTrace.WriteToStream(Stream: TStream); var xInt: Integer; xStr: string; FiguresList: TList; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; if Caption <> nil then begin xInt := FiguresList.IndexOf(Caption); WriteField(29, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(29, Stream, xInt, sizeof(xInt)); end; if JoinObject1 <> nil then begin xInt := FiguresList.IndexOf(JoinObject1); WriteField(30, Stream, xInt, sizeof(xInt)); end; if JoinObject2 <> nil then begin xInt := FiguresList.IndexOf(JoinObject2); WriteField(31, Stream, xInt, sizeof(xInt)); end; xInt := FBegSCSID; WriteField(32, Stream, xInt, sizeof(xInt)); xInt := FEndSCSID; WriteField(33, Stream, xInt, sizeof(xInt)); xStr := FBegType; WriteStrField(215, Stream, xStr); xStr := FEndType; WriteStrField(216, Stream, xStr); except on E: Exception do addExceptionToLogEx('TPlanTrace.WriteToStream', E.Message); end; end; { TPlanConnector } constructor TPlanConnector.Create(aX, aY, aZ: Double; LHandle: Longint; aDrawStyle: TDrawStyle; aOwner: TComponent); begin try inherited Create(aX, aY, aZ, LHandle, aDrawStyle, aOwner); JoinedTraces := TList.Create; SetLength(FJoinedTracesIndexes, 0); // Tolik 23/02/2018 - - JoinedPlanObject := Nil; // except on E: Exception do addExceptionToLogEx('TPlanConnector.Create', E.Message); end; end; // Tolik -- 23/02/2018 -- destructor TPlanConnector.destroy; begin setLength(FJoinedTracesIndexes, 0); JoinedTraces.Clear; JoinedTraces.Free; JoinedTraces := Nil; if JoinedPlanObject <> nil then begin if Assigned(JoinedPlanObject.JoinedConnectors) then JoinedPlanObject.JoinedConnectors.Remove(Self); JoinedPlanObject := nil; end; inherited; end; // procedure TPlanConnector.Delete; var i, j: Integer; JoinTrace: TPlanTrace; begin try if not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // i := 0; while i < JoinedTraces.Count do begin TPlanTrace(JoinedTraces[i]).Delete; end; if JoinedPlanObject <> nil then JoinedPlanObject.JoinedConnectors.Remove(Self); end; setLength(FJoinedTracesIndexes, 0); except on E: Exception do addExceptionToLogEx('TPlanConnector.Delete', E.Message); end; end; function TPlanConnector.IsPointIn(x, y: Double): Boolean; begin try Result := False; if (x >= ActualPoints[1].x - 0.5) and (x <= ActualPoints[1].x + 0.5) and (y >= ActualPoints[1].y - 0.5) AND (y <= ActualPoints[1].y + 0.5) then Result := True; except on E: Exception do addExceptionToLogEx('TPlanConnector.IsPointIn', E.Message); end; end; procedure TPlanConnector.move(deltax, deltay: double); var i: integer; CurTrace: TPlanTrace; JoinConn: TConnectorObject; NeedPoints: TDoublePoint; TraceCP: TDoublePoint; MvAngle: Double; Bnd: TDoubleRect; h: double; CurAngle: double; begin try NeedPoints := GetCoordsWithSnapToGrid(ActualPoints[1].x + deltax, ActualPoints[1].y + deltay); ActualPoints[1] := DoublePoint(NeedPoints.x, NeedPoints.y); for i := 0 to JoinedTraces.Count - 1 do begin CurTrace := TPlanTrace(JoinedTraces[i]); if CurTrace.JoinObject1 = Self then begin CurTrace.ActualPoints[1] := DoublePoint(NeedPoints.x, NeedPoints.y); end; if CurTrace.JoinObject2 = Self then begin CurTrace.ActualPoints[2] := DoublePoint(NeedPoints.x, NeedPoints.y); end; // if CurTrace.Caption <> nil then begin TraceCP.x := (CurTrace.ActualPoints[1].x + CurTrace.ActualPoints[2].x) / 2; TraceCP.y := (CurTrace.ActualPoints[1].y + CurTrace.ActualPoints[2].y) / 2; CurAngle := CurTrace.Caption.AngletoPoint; CurTrace.Caption.Rotate( - CurAngle, CurTrace.Caption.CenterPoint); CurTrace.Caption.Move(TraceCP.x - CurTrace.Caption.CenterPoint.x, TraceCP.y - CurTrace.Caption.CenterPoint.y); Bnd := CurTrace.Caption.GetBoundRect; h := abs(Bnd.Bottom - Bnd.Top); CurTrace.Caption.Move(0, - h / 2); MvAngle := GetPlanTraceAngle(CurTrace.ActualPoints[1], CurTrace.ActualPoints[2]); MvAngle := MvAngle * pi / 180; CurTrace.Caption.Rotate(MvAngle, CurTrace.Caption.CenterPoint); end; end; except on E: Exception do addExceptionToLogEx('TPlanConnector.move', E.Message); end; end; procedure TPlanConnector.RaiseProperties(CadFigList: TList); var i: integer; Trace: TPlanTrace; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else //Tolik // FiguresList := GCadForm.PCad.Figures; FiguresList := CadFigList; // if FJoinedPlanObjectIndex = - 1 then begin JoinedPlanObject := Nil; end else begin JoinedPlanObject := TPlanObject(FiguresList.Items[FJoinedPlanObjectIndex]); LockMove := True; LockModify := True; LockSelect := True; end; except on E: Exception do addExceptionToLogEx('TPlanConnector.RaiseProperties', E.Message); end; end; procedure TPlanConnector.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var FindCode: Integer; xInt: Integer; xStr: string; DataP: PChar; begin try inherited; case xCode of 61: begin xInt := pInt(data)^; FBegSCSID := xInt; end; 62: begin xInt := pInt(data)^; FEndSCSID := xInt; end; 63: begin xInt := pInt(data)^; FJoinedPlanObjectIndex := xInt; end; 215: begin DataP := data; xStr := DataP; FBegType := xStr; end; 216: begin DataP := data; xStr := DataP; FEndType := xStr; end; end; if (xCode >= 65) AND (xCode <= 80) then begin FindCode := Length(FJoinedTracesIndexes); FindCode := FindCode + 1; SetLength(FJoinedTracesIndexes, FindCode); xInt := pInt(data)^; FJoinedTracesIndexes[FindCode - 1] := xInt; end; if JoinedTraces = nil then JoinedTraces := TList.Create; except on E: Exception do addExceptionToLogEx('TPlanConnector.SetPropertyFromStream', E.Message); end; end; procedure TPlanConnector.WriteToStream(Stream: TStream); var i: integer; xInt: Integer; xStr: string; FiguresList: TList; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; xInt := FBegSCSID; WriteField(61, Stream, xInt, sizeof(xInt)); xInt := FEndSCSID; WriteField(62, Stream, xInt, sizeof(xInt)); if JoinedPlanObject <> nil then begin xInt := FiguresList.IndexOf(JoinedPlanObject); WriteField(63, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(63, Stream, xInt, sizeof(xInt)); end; for i := 0 to JoinedTraces.Count - 1 do begin xInt := FiguresList.IndexOf(JoinedTraces[i]); if ((65 + i) <= 80) then WriteField(65 + i, Stream, xInt, sizeof(xInt)); end; xStr := FBegType; WriteStrField(215, Stream, xStr); xStr := FEndType; WriteStrField(216, Stream, xStr); except on E: Exception do addExceptionToLogEx('TPlanConnector.WriteToStream', E.Message); end; end; { TCabinet } constructor TCabinet.create(aX1, aY1, aX2, aY2: Double; w, s, c, abrs, abrc, LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); var p: TDoublePoint; begin try inherited create(aX1, aY1, aX2, aY2, w, s, c, abrs, abrc, LHandle, aDrawStyle, aOwner); FSCSID := -1; FIndex := -1; FType := ct_Virtual; FNumberObject := nil; FNumberObjectIndex := -1; //Tolik FCabinetSquare := -1; // Visible := False; if aDrawStyle <> dsTrace then TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; CabinetConfig.aWorkRoom := true; CabinetConfig.NumRadius := 3; except on E: Exception do addExceptionToLogEx('TCabinet.create', E.Message); end; end; class function TCabinet.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var ObjParams: TObjectParams; GetSCSID, GetIndex: Integer; begin try // создание с тулсы на панели КАД // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; Result := nil; Result := TCabinet.Create(Shadow.ActualPoints[1].x, Shadow.ActualPoints[1].y, Shadow.ActualPoints[3].x, Shadow.ActualPoints[3].y, 2, ord(psSolid), clMaroon, ord(bsClear), clBlack, LHandle, mydsNormal, aOwner); TCabinet(Result).FType := ct_Visual; ObjParams := CreateRoomFromCADToPM(GCadForm.FCADListID); GetSCSID := ObjParams.ID; GetIndex := ObjParams.MarkID; TCabinet(Result).FSCSID := GetSCSID; TCabinet(Result).ID := GetSCSID;//08.11.2011 TCabinet(Result).FIndex := GetIndex; TCabinet(Result).FNumberObject := CreateNumberObjectOnCAD(TCabinet(Result), GCadForm.FShowCabinetsNumbers); TCabinet(Result).FNumberObject.IsCabinetExt := false; TCabinet(Result).FNumberObject.FPositionIndex := 4; TCabinet(Result).FNumberObject.CircleRadius := 3; //Tolik TCabinet(Result).FCabinetSquare := -1; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), Result, False); GCadForm.AddSCSFigure(Result); //08.11.2011 TCabinet(Result).FNumberObject.Draw(GCadForm.PCad.DEngine, false); MoveObjectsToCabinetOnCreate(TCabinet(Result)); if GCadForm.FShowCabinetsBounds then TCabinet(Result).Visible := True; Result := nil; // *UNDO* GCadForm.FCanSaveForUndo := True; TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TCabinet.CreateFromShadow', E.Message); end; end; procedure TCabinet.Delete; var aFigure: TFigure; j: Integer; begin try if not Self.Deleted then begin if Owner <> nil then //08.11.2011 TF_CAD(TPowerCad(Owner).Owner).RemoveSCSFigure(Self); Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // if FNumberObject <> nil then FNumberObject.Delete; //Проверка фигуры на вхождение в кабинет GCadForm.UpdateCheckedFigures; for j := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[j]); GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; end; except on E: Exception do addExceptionToLogEx('TCabinet.Delete', E.Message); end; end; procedure TCabinet.Draw(DEngine: TPCDrawEngine; isFlue: Boolean); var CabCP: TDoublePoint; CabCP2: TDoublePoint; aHRGN: HRGN; aFont: TFont; SCSList: TSCSList; RoomObject: TSCSCatalog; aText: string; xCanvas: TMetafileCanvas; h, w: double; aFontSize: integer; aFontName: string; begin try if fType = ct_Visual then if Visible then begin aText := ''; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(Owner).Owner).FCADListID); if SCSList <> nil then begin RoomObject := SCSList.GetCatalogFromReferencesBySCSID(self.FSCSID); if RoomObject <> nil then aText := RoomObject.NameShort; end; if aText <> '' then begin aFont := TFont.Create; aFont.Name := TF_CAD(TPowerCad(Owner).Owner).PCad.Font.Name; //TF_CAD(TPowerCad(Owner).Owner).Font.Name; aFont.Size := 10; aFont.color := clMaroon; //clBlack; aFontSize := aFont.Size; aFontName := aFont.Name; GetTextSize(aFontSize, [], aFontName, aText, nil, h, w); //В зависимости от положения высчитываем новые координаты Case Self.CabinetConfig.CabinetSignPos of 1: begin //Верхний правый CabCP.x := (self.ActualPoints[1].x + self.ActualPoints[3].x) / 2; CabCP.x := CabCP.x + Abs(self.ActualPoints[1].x - self.ActualPoints[3].x) / 2 - 1 - w * 1.3; //CabCP.x := CabCP.x + Abs(self.ActualPoints[1].x - self.ActualPoints[3].x) / 2 - 2.4 - 1.1*(length(aText) - 1); CabCP.y := (self.ActualPoints[1].y + self.ActualPoints[3].y) / 2; CabCP.y := CabCP.y - Abs(self.ActualPoints[1].y - self.ActualPoints[3].y) / 2 + h / 2 - 1; //CabCP.y := CabCP.y - Abs(self.ActualPoints[1].y - self.ActualPoints[3].y) / 2 + 1.3; CabCP2.x := CabCP.x + w; CabCP2.y := CabCP.y + h; //CabCP2.x := CabCP.x + 3; //CabCP2.y := CabCP.y + 3; end; 2: begin //Верхний левый CabCP.x := (self.ActualPoints[1].x + self.ActualPoints[3].x) / 2; CabCP.x := CabCP.x - Abs(self.ActualPoints[1].x - self.ActualPoints[3].x) / 2 + 1 + w * 1.3; CabCP.y := (self.ActualPoints[1].y + self.ActualPoints[3].y) / 2; CabCP.y := CabCP.y - Abs(self.ActualPoints[1].y - self.ActualPoints[3].y) / 2 + h / 2 - 1; CabCP2.x := CabCP.x - w; CabCP2.y := CabCP.y + h; end; 3: begin //Нижний правый CabCP.x := (self.ActualPoints[1].x + self.ActualPoints[3].x) / 2; CabCP.x := CabCP.x + Abs(self.ActualPoints[1].x - self.ActualPoints[3].x) / 2 - 1 - w * 1.3; CabCP.y := (self.ActualPoints[1].y + self.ActualPoints[3].y) / 2; CabCP.y := CabCP.y + Abs(self.ActualPoints[1].y - self.ActualPoints[3].y) / 2 - h / 2 + 1; CabCP2.x := CabCP.x + w; CabCP2.y := CabCP.y - h/2; end; 4: begin //Нижний левый CabCP.x := (self.ActualPoints[1].x + self.ActualPoints[3].x) / 2; CabCP.x := CabCP.x - Abs(self.ActualPoints[1].x - self.ActualPoints[3].x) / 2 + 1 + w * 1.3; CabCP.y := (self.ActualPoints[1].y + self.ActualPoints[3].y) / 2; CabCP.y := CabCP.y + Abs(self.ActualPoints[1].y - self.ActualPoints[3].y) / 2 - h / 2 + 1; CabCP2.x := CabCP.x - w; CabCP2.y := CabCP.y - h/2; end; end; //DEngine.DrawLabel(CabCP, CabCP2, aText, aFont, 3, clNone, 3, ord(psClear), clNone, ord(bsClear), aHRGN); if Self.CabinetConfig.CabinetSignPos > 0 then DEngine.DrawLabel(CabCP, CabCP2, aText, aFont, h, clNone, RoundUp(w), ord(psClear), clNone, ord(bsClear), aHRGN); if aHRGN <> 0 then DeleteObject(aHrgn); FreeAndNil(aFont); end; inherited; end; except on E: Exception do addExceptionToLogEx('TCabinet.Draw', E.Message); end; end; function TCabinet.Edit: Boolean; begin Result := False; ShowRoomPropsInCAD(GCadForm.FCADListID, FSCSID); // SetCabinetFalseFloor(Self); end; function TCabinet.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean; var CP: TDoublePoint; begin try Result := false; Result := inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); if FNumberObject <> nil then begin CP.x := (ActualPoints[1].x + ActualPoints[3].x) / 2; CP.y := (ActualPoints[1].y + ActualPoints[3].y) / 2; FNumberObject.move(CP.x - FNumberObject.CenterPoint.x, CP.y - FNumberObject.CenterPoint.y); end; MoveObjectsToCabinetOnMove(Self); except on E: Exception do addExceptionToLogEx('TCabinet.EndModification', E.Message); end; end; function TCabinet.isPointIn(x, y: Double): boolean; begin try Result := False; if Visible then Result := inherited isPointIn(x, y); except on E: Exception do addExceptionToLogEx('TCabinet.isPointIn', E.Message); end; end; function TCabinet.isPointInMod(x, y: Double): boolean; var MinX, MinY, MaxX, MaxY: double; ActualArrayX: array of Double; ActualArrayY: array of Double; begin try Result := False; SetLength(ActualArrayX, 4); SetLength(ActualArrayY, 4); ActualArrayX[0] := ActualPoints[1].x; ActualArrayX[1] := ActualPoints[2].x; ActualArrayX[2] := ActualPoints[3].x; ActualArrayX[3] := ActualPoints[4].x; ActualArrayY[0] := ActualPoints[1].y; ActualArrayY[1] := ActualPoints[2].y; ActualArrayY[2] := ActualPoints[3].y; ActualArrayY[3] := ActualPoints[4].y; MinX := MinValue(ActualArrayX); MaxX := MaxValue(ActualArrayX); MinY := MinValue(ActualArrayY); MaxY := MaxValue(ActualArrayY); // Tolik SetLength(ActualArrayX, 0); SetLength(ActualArrayY, 0); // if (x >= MinX) and (x <= MaxX) and (y >= MinY) AND (y <= MaxY) then Result := True; except on E: Exception do addExceptionToLogEx('TCabinet.isPointInMod', E.Message); end; end; procedure TCabinet.Move(deltax, deltay: Double); begin try inherited; if FNumberObject <> nil then if not FNumberObject.Selected then FNumberObject.move(deltax, deltay); MoveObjectsToCabinetOnMove(Self); except on E: Exception do addExceptionToLogEx('TCabinet.Move', E.Message); end; end; procedure TCabinet.RaiseProperties(CadFigList: TList); var LHandle9: Integer; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else //Tolik // FiguresList := GCadForm.PCad.Figures; FiguresList := CadFigList; // if FNumberObjectIndex = - 1 then FNumberObject := Nil else begin FNumberObject := TCabinetNumber(FiguresList.Items[FNumberObjectIndex]); FNumberObject.Visible := CabinetConfig.aWorkRoom; FNumberObject.CircleRadius := CabinetConfig.NumRadius; FNumberObject.IsCabinetExt := false; FNumberObject.FPositionIndex := CabinetConfig.CabinetNumPos; end; Visible := False; // если на старом слое - перенести на новый LHandle9 := GCadForm.PCad.GetLayerHandle(9); if LayerHandle <> LHandle9 then begin LayerHandle := LHandle9; if FNumberObject <> nil then FNumberObject.LayerHandle := LHandle9; end; except on E: Exception do addExceptionToLogEx('TCabinet.RaiseProperties', E.Message); end; end; procedure TCabinet.select; begin try if fType = ct_Visual then if Visible then inherited; except on E: Exception do addExceptionToLogEx('TCabinet.select', E.Message); end; end; procedure TCabinet.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); var xInt: Integer; xBool: Boolean; xDbl: Double; begin try inherited; case xCode of 30: begin xInt := pInt(data)^; FSCSID := xInt; FFalseFloorHeight := GCadForm.FFalseFloorHeight; ID := xInt; //08.11.2011 if ID <> 0 then //08.11.2011 TF_CAD(TPowerCad(Owner).Owner).AddSCSFigure(Self); end; 31: begin xInt := pInt(data)^; FIndex := xInt; end; 32: begin xInt := pInt(data)^; FType := TCabinetType(xInt); end; 33: begin xInt := pInt(data)^; FNumberObjectIndex := xInt; end; 230:begin xDbl := pDouble(data)^; FFalseFloorHeight := xDbl; end; 240:begin CabinetConfig := ProomConfig(data)^; end; 241:begin xDbl := pDouble(data)^; FCabinetSquare := xDbl; end; end; TF_CAD(TPowerCad(Owner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TCabinet.SetPropertyFromStream', E.Message); end; end; procedure TCabinet.WriteToStream(Stream: TStream); var xInt: Integer; xBool: Boolean; xDbl: Double; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; inherited; xInt := FSCSID; WriteField(30, Stream, xInt, sizeof(xInt)); xInt := FIndex; WriteField(31, Stream, xInt, sizeof(xInt)); xInt := Ord(FType); WriteField(32, Stream, xInt, sizeof(xInt)); if FNumberObject <> nil then begin xInt := FiguresList.IndexOf(FNumberObject); WriteField(33, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(33, Stream, xInt, sizeof(xInt)); end; xDbl := FFalseFloorHeight; WriteField(230, Stream, xDbl, sizeof(xDbl)); WriteField(240, Stream, CabinetConfig, sizeof(CabinetConfig)); //Tolik WriteField(241, Stream, FCabinetSquare, sizeof(FCabinetSquare)); // except on E: Exception do addExceptionToLogEx('TCabinet.WriteToStream', E.Message); end; end; procedure TCabinet.Initialize; begin inherited; FClassIndex := ciCabinet; cabinetconfig.aWorkRoom := true; cabinetconfig.IsCabinetExt := False; cabinetconfig.POintCount := Self.PointCount; CabinetConfig.CabinetNumPos := 4; CabinetConfig.CabinetSignPos := 1; CabinetConfig.NumRadius := 3; FCabinetSquare := -1; end; { TCabinetNumber } procedure TCabinetNumber.Delete; begin try if not Deleted then begin Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // end; except on E: Exception do addExceptionToLogEx('TCabinetNumber.Delete', E.Message); end; end; Function GetCabinetByNumber(Form: TF_Cad; CabinetID: Integer): TObject; var i: Integer; begin Result := nil; if Form.FNeedUpdateCheckedFigures then Form.UpdateCheckedFigures; for i := 0 to Form.FCheckedFigures.Count - 1 do begin if TObject(Form.FCheckedFigures[i]).ClassName = 'TCabinet' then begin if TCabinet(Form.FCheckedFigures[i]).FSCSID = CabinetID then begin result := TCabinet(Form.FCheckedFigures[i]); break; end; end else if TObject(Form.FCheckedFigures[i]).ClassName = 'TCabinetExt' then begin if TCabinetExt(Form.FCheckedFigures[i]).FSCSID = CabinetID then begin result := TCabinetExt(Form.FCheckedFigures[i]); break; end; end; end; end; procedure TCabinetNumber.Draw(DEngine: TPCDrawEngine; isFlue: Boolean); var DeltaX, DeltaY: Double; CabObj: TObject; ConnPoint: TDoublePoint; MaxX, MaxY, MinX, MinY: Double; //Tolik NumberRadius: Double; LenX, LenY: Double; RadiusNumber: Integer; CenX, CenY: Double; LayerHandle : Integer; // 02/11/2016-- DoubleRad: Double; TempCapt: TRichText; Procedure ChangeFontSizeToCircle; var i, CurrFontSize: Integer; OldStrings: TStringList; TempCapt: TRichText; FontName: string; DoubleRad: Double; CabCaption: String; Delta: Double; begin TempCapt := nil; TempCapt := TRichTextMod(Self.InFigures[1]); TempCapt.getbounds(MaxX, MinY, MinX, MaxY); GetTextSize(TRichText(Self.InFigures[1]).re.font.Size, [], TRichText(Self.InFigures[1]).re.font.Name, '', TRichText(Self.InFigures[1]).re.Lines, LenY{h}, LenX{w}); NumberRadius := Sqrt(Sqr(LenX) + Sqr(LenY))/2; DoubleRad := Double((TCircle(Self.InFigures[0]).Radius )); if NumberRadius > 0 then begin //if (Round(NumberRadius) > (TCircle(Self.InFigures[0]).Radius )) then if NumberRadius > DoubleRad then // так точнее begin if TRichText(Self.InFigures[1]).re.font.size > 2 then begin OldStrings := TStringList.Create; //ДАнные сохраняем for i := 0 to TRichText(Self.InFigures[1]).re.Lines.Count - 1 do begin OldStrings.Add(TRichText(Self.InFigures[1]).re.Lines[i]); end; TempCapt := TRichText(Self.InFigures[1]); CurrFontSize := TRichText(Self.InFigures[1]).re.font.size - 1; FontName := TempCapt.re.Font.Name; // удаляем из списка фигур номера Self.Infigures.delete(1); //объект убиваем GCadForm.PCad.Figures.Remove(TempCapt); FreeAndNil(TempCapt); // и пересоздаем if not IsCabinetExt then LayerHandle := TCabinet(cabObj).LayerHandle else LayerHandle := TCabinetExt(CabObj).LayerHandle; // определяем новые размеры надписи GetTextSize(CurrFontSize, [], FontName, '', OldStrings, LenY{h}, LenX{w}); // создаем TempCapt := TRichText.create(-100, -100, -100 + LenX{w}, -100 + LenY{h}, 1, ord(psSolid), clMaroon, ord(bsClear), clNone, LayerHandle, mydsNormal, GCadForm.PCad); // возврашаем как было TempCapt.re.Font.Name := FontName; TempCapt.re.Font.Size := CurrFontSize; TempCapt.re.Font.Color := clMaroon; TempCapt.re.Lines.Clear; // подписи возвращаем for i := 0 to OldStrings.Count - 1 do begin OldStrings[i] := FastReplace(OldStrings[i],#13#10,' '); TempCapt.re.Lines.Add(OldStrings[i]); end; FreeAndNil(oldStrings); // выставляем размер шрифта CabCaption := TempCapt.re.Lines[0]; TempCapt.re.Lines.Clear; TempCapt.re.font.size := CurrFontSize; CabCaption := FastReplace(CabCaption,#13#10,' '); TempCapt.re.Lines.Add(CabCaption); // центр CenX := (TempCapt.ap1.x + TempCapt.ap3.x)/2; CenY := (TempCapt.ap1.Y + TempCapt.ap3.Y)/2; // сдвигаем относительно круга (в центр) TempCapt.Move(TCircle(Self.InFigures[0]).CenterPoint.x - CenX, TCircle(Self.InFigures[0]).CenterPoint.y - CenY + 0.5); // добавляем в группу номера кабинета (ложим туда, где взяли) if infigures.count > 1 then inFigures.Insert(1,TempCapt) else inFigures.Add(TempCapt); // и так по кругу, пока не получится ОК ChangeFontSizeToCircle; end; end; end; end; begin try if Visible then begin //Tolik // кабинет, которому принадлежит номер CabObj := GetCabinetByNumber(TF_CAD(TPowerCad(Owner).Owner), FCabinetID); if CabObj = nil then exit; TCircle(Self.InFigures[0]).Radius := CircleRadius + 2; {if CircleRadius = 0 then TRichText(Self.InFigures[1]).re.font.size := 10 else TRichText(Self.InFigures[1]).re.font.size := 12; TRichText(Self.InFigures[1]).Move(TCircle(Self.InFigures[0]).CenterPoint.x - TRichText(Self.InFigures[1]).CenterPoint.x, TCircle(Self.InFigures[0]).CenterPoint.y - TRichText(Self.InFigures[1]).CenterPoint.y);} if not IsCabinetExt then begin // Tolik // !!!!!!!!!!! ВАЖНО !!!!! // при отрисовке номера кабинета нельзя привязываться к поинтам, так как пользователь может начать рисовать // кабинет не с левого верхнего угла, а, допустим, с нижнего левого или верхнего правого или правого нижнего и тогда порядок // координат будет не таким, как предполагалось в расчетах, поэтому здесь нужно брать границы прямоугольника и производить // вычисления по ним, иначе номер кабинета будет все время "Убегать" совсем не туда, куда хотел пользователь, а мы не можем // заставить пользователя все время рисовать кабинет слева-сверху вправо-вниз.... // Здесь на забываем, что ось У у нас перевернута, т.к. практически 0 - находится в левом верхнем углу экрана // поэтому получаемые значения минимума и максимума по оси У меняем местами, но названия оставим, дабы не ломать // алгоритм расчета, т.к. он математически правилен TCabinet(CabObj).getbounds(MaxX, MinY, MinX, MaxY); case FPositionIndex of 1:begin //Вверху DeltaX := ((MinX + MaxX) / 2) - Self.CenterPoint.x; DeltaY := (MaxY + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5; //Self.Move(DeltaX, DeltaY); end; 2:begin //Вверху справа DeltaX := (MaxX - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; DeltaY := (MaxY + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5; //Self.Move(DeltaX, DeltaY); end; 3:begin //Вверху слева DeltaX := (MinX + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5; DeltaY := (MaxY + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5; //Self.Move(DeltaX, DeltaY); end; 4:begin //По центру DeltaX := ((MinX + MaxX) / 2) - Self.CenterPoint.x; DeltaY := ((MaxY + MinY) / 2) - Self.CenterPoint.y; //Self.Move(DeltaX, DeltaY); end; 5:begin //Справа DeltaX := (MaxX - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; DeltaY := ((MaxY + MinY) / 2) - Self.CenterPoint.y; //Self.Move(DeltaX, DeltaY); end; 6:begin //Слева DeltaX := (MinX + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5; DeltaY := ((MaxY + MinY) / 2) - Self.CenterPoint.y; //Self.Move(DeltaX, DeltaY); end; 7:begin //Внизу DeltaX := ((MinX + MaxX) / 2) - Self.CenterPoint.x; DeltaY := (MinY - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; //Self.Move(DeltaX, DeltaY); end; 8:begin //Внизу справа DeltaX := (MaxX - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; DeltaY := (MinY - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; //Self.Move(DeltaX, DeltaY); end; 9:begin //Внизу слева DeltaX := (MinX + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5; DeltaY := (MinY - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; // Self.Move(DeltaX, DeltaY); end; end; //Tolik // Font Change to Cabinet Number if Self.InFigures.Count > 1 then begin TempCapt := TRichTextMod(Self.InFigures[1]); TempCapt.getbounds(MaxX, MinY, MinX, MaxY); GetTextSize(TRichText(Self.InFigures[1]).re.font.Size, [], TRichText(Self.InFigures[1]).re.font.Name, '', TRichText(Self.InFigures[1]).re.Lines, LenY{h}, LenX{w}); NumberRadius := Sqrt(Sqr(LenX) + Sqr(LenY))/2; DoubleRad := Double((TCircle(Self.InFigures[0]).Radius )); if NumberRadius > 0 then begin //if (Round(NumberRadius) > (TCircle(Self.InFigures[0]).Radius )) then if NumberRadius > DoubleRad then // так точнее begin TRichText(Self.InFigures[1]).re.font.size := 25; ChangeFontSizeToCircle; end; end; Self.Move(DeltaX, DeltaY); // можно и один раз написать, а не в каждом кейсе end; // { case FPositionIndex of 1:begin //Вверху DeltaX := ((TFigure(Cabobj).ActualPoints[1].x + TFigure(Cabobj).ActualPoints[3].x) / 2) - Self.CenterPoint.x; DeltaY := (TFigure(Cabobj).ActualPoints[1].y + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5; Self.Move(DeltaX, DeltaY); end; 2:begin //Вверху справа DeltaX := (TFigure(Cabobj).ActualPoints[3].x - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; DeltaY := (TFigure(Cabobj).ActualPoints[1].y + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5; Self.Move(DeltaX, DeltaY); end; 3:begin //Вверху слева DeltaX := (TFigure(Cabobj).ActualPoints[1].x + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5; DeltaY := (TFigure(Cabobj).ActualPoints[1].y + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5; Self.Move(DeltaX, DeltaY); end; 4:begin //По центру DeltaX := ((TFigure(Cabobj).ActualPoints[1].x + TFigure(Cabobj).ActualPoints[3].x) / 2) - Self.CenterPoint.x; DeltaY := ((TFigure(Cabobj).ActualPoints[1].y + TFigure(Cabobj).ActualPoints[3].y) / 2) - Self.CenterPoint.y; Self.Move(DeltaX, DeltaY); end; 5:begin //Справа DeltaX := (TFigure(Cabobj).ActualPoints[3].x - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; DeltaY := ((TFigure(Cabobj).ActualPoints[1].y + TFigure(Cabobj).ActualPoints[3].y) / 2) - Self.CenterPoint.y; Self.Move(DeltaX, DeltaY); end; 6:begin //Слева DeltaX := (TFigure(Cabobj).ActualPoints[1].x + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5; DeltaY := ((TFigure(Cabobj).ActualPoints[1].y + TFigure(Cabobj).ActualPoints[3].y) / 2) - Self.CenterPoint.y; Self.Move(DeltaX, DeltaY); end; 7:begin //Внизу DeltaX := ((TFigure(Cabobj).ActualPoints[1].x + TFigure(Cabobj).ActualPoints[3].x) / 2) - Self.CenterPoint.x; DeltaY := (TFigure(Cabobj).ActualPoints[3].y - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; Self.Move(DeltaX, DeltaY); end; 8:begin //Внизу справа DeltaX := (TFigure(Cabobj).ActualPoints[3].x - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; DeltaY := (TFigure(Cabobj).ActualPoints[3].y - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; Self.Move(DeltaX, DeltaY); end; 9:begin //Внизу слева DeltaX := (TFigure(Cabobj).ActualPoints[1].x + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5; DeltaY := (TFigure(Cabobj).ActualPoints[3].y - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; Self.Move(DeltaX, DeltaY); end; end; } // end else begin if (FPositionIndex <> 0)and (FPositionIndex <> 1) then begin ConnPoint := TFigure(CabObj).ActualPoints[FPositionIndex - 1]; TCabinetExt(CabObj).getbounds(MaxX, MaxY, MinX, MinY); if ((ConnPoint.x - TCircle(Self.InFigures[0]).Radius) < MinX) then DeltaX := (ConnPoint.x + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x + 0.5 else DeltaX := (ConnPoint.x - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.x - 0.5; if ((ConnPoint.y - TCircle(Self.InFigures[0]).Radius) < MinY) then DeltaY := (ConnPoint.y + TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y + 0.5 else DeltaY := (ConnPoint.y - TCircle(Self.InFigures[0]).Radius) - Self.CenterPoint.y - 0.5; //Tolik // Font Change to Cabinet Number if Self.InFigures.Count > 1 then begin TRichText(Self.InFigures[1]).re.font.size := 25; ChangeFontSizeToCircle; end; // Self.Move(DeltaX, DeltaY); end else if FPositionIndex = 1 then begin TCabinetExt(CabObj).getbounds(MaxX, MaxY, MinX, MinY); DeltaX := (MinX + MaxX) / 2; DeltaY := (MinY + MaxY) / 2; //Tolik // Font Change to Cabinet Number if Self.InFigures.Count > 1 then begin TempCapt := TRichTextMod(Self.InFigures[1]); TempCapt.getbounds(MaxX, MinY, MinX, MaxY); GetTextSize(TRichText(Self.InFigures[1]).re.font.Size, [], TRichText(Self.InFigures[1]).re.font.Name, '', TRichText(Self.InFigures[1]).re.Lines, LenY{h}, LenX{w}); NumberRadius := Sqrt(Sqr(LenX) + Sqr(LenY))/2; DoubleRad := Double((TCircle(Self.InFigures[0]).Radius )); if NumberRadius > 0 then begin //if (Round(NumberRadius) > (TCircle(Self.InFigures[0]).Radius )) then if NumberRadius > DoubleRad then // так точнее begin TRichText(Self.InFigures[1]).re.font.size := 25; ChangeFontSizeToCircle; end; end; self.move(DeltaX - Self.CenterPoint.x, DeltaY - Self.CenterPoint.y); end; end; end; if FPositionIndex <> 0 then inherited; end; except on E: Exception do addExceptionToLogEx('TCabinetNumber.Draw', E.Message); end; end; function TCabinetNumber.Edit: Boolean; var Cabinet: TFigure; begin try Result := False; if Visible then begin Cabinet := FindCabinetBySCSID(GCadForm, FCabinetID); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then begin ShowObjectInPM(TCabinet(Cabinet).FSCSID, TCabinet(Cabinet).Name); ActivateCabinetOnCAD(GCadForm.FCADListID, TCabinet(Cabinet).FSCSID); end else if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin ShowObjectInPM(TCabinetExt(Cabinet).FSCSID, TCabinetExt(Cabinet).Name); ActivateCabinetOnCAD(GCadForm.FCADListID, TCabinetExt(Cabinet).FSCSID); end; end; if Selected then Deselect; end; except on E: Exception do addExceptionToLogEx('TCabinetNumber.Edit', E.Message); end; end; function TCabinetNumber.isPointIn(x, y: double): boolean; begin Result := False; Result := inherited isPointIn(x, y); end; procedure TCabinetNumber.Select; begin // inherited; end; procedure TCabinetNumber.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var xInt: Integer; begin try inherited; case xCode of 30: begin xInt := pInt(data)^; FCabinetID := xInt; LockSelect := False; LockMove := True; LockModify := True; end; 31: begin xInt := pInt(data)^; FPositionIndex := xInt; end; 91: begin IsCabinetExt := PBoolean(Data)^; end; 32: begin xInt := pInt(data)^; CircleRadius := xInt; end; end; except on E: Exception do addExceptionToLogEx('TCabinetNumber.SetPropertyFromStream', E.Message); end; end; procedure TCabinetNumber.WriteToStream(Stream: TStream); var xInt: Integer; begin try inherited; xInt := FCabinetID; WriteField(30, Stream, xInt, sizeof(xInt)); xInt := FPositionIndex; WriteField(31, Stream, xInt, sizeof(xInt)); WriteField(32, Stream, CircleRadius, sizeof(CircleRadius)); WriteField(91, Stream, IsCabinetExt, sizeof(IsCabinetExt)); except on E: Exception do addExceptionToLogEx('TCabinetNumber.WriteToStream', E.Message); end; end; { TCadNorms } procedure TCadNorms.Build; begin try if FNormsList.Count > 0 then DrawTable else begin EndProgress; ShowMessage(cCadClasses_Mes22); end; except on E: Exception do addExceptionToLogEx('TCadNorms.Build', E.Message); end; end; constructor TCadNorms.create(LHandle: Integer; aOwner: TComponent); begin try inherited Create(LHandle, aOwner); FNormsList := TObjectList.Create; // размеры полей fTableWidth := 1; fTextSize := 7; fTextStyle := [fsBold]; fNumberSize := 10; fNameSize := 50; fIzmSize := 10; fCountSize := 10; fColumnSize := 12; fLineHeight := 6; AlwaysTogether := True; except on E: Exception do addExceptionToLogEx('TCadNorms.create', E.Message); end; end; //Tolik Destructor TCadNorms.Destroy; var CadNormStruct: TCadNormStruct; i: Integer; begin if FNormsList <> nil then begin FreeAndNil(FNormsList); end; inherited; end; // procedure TCadNorms.Delete; begin end; procedure TCadNorms.DrawTable; var i, j: Integer; x, y: double; Rect: TRectangle; Line: TLine; w, h: double; LHandle: Integer; BeginPoint: TDoublePoint; ToPoint: TDoublePoint; CadNormStruct: TCadNormStruct; CadNormColumn: TCadNormColumn; MustRebuild: Boolean; begin try LHandle := GCadForm.PCad.GetLayerHandle(1); h := FNormsList.Count * fLineHeight + fLineHeight * 2; CadNormStruct := TCADNormStruct(FNormsList[0]); w := fNumberSize + fNameSize + fIzmSize + fCountSize; for i := 0 to CadNormStruct.NormColumns.Count - 1 do begin CadNormColumn := TCadNormColumn(CadNormStruct.NormColumns[i]); w := w + CadNormColumn.Columns.Count * fColumnSize; end; BeginPoint := DoublePoint(-100, -100); Rect := TRectangle.create(BeginPoint.x, BeginPoint.y, BeginPoint.x + w, BeginPoint.y + h, fTableWidth, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Rect); Line := TLine.create(BeginPoint.x + fNumberSize + fNameSize + fIzmSize + fCountSize, BeginPoint.y + fLineHeight, BeginPoint.x + w, BeginPoint.y + fLineHeight, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); Line := TLine.create(BeginPoint.x + fNumberSize + fNameSize + fIzmSize + fCountSize, BeginPoint.y + fLineHeight * 2, BeginPoint.x + w, BeginPoint.y + fLineHeight * 2, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); Line := TLine.create(BeginPoint.x, BeginPoint.y + fLineHeight * 3, BeginPoint.x + w, BeginPoint.y + fLineHeight * 3, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); // прочертить вертикали for i := 1 to FNormsList.Count - 1 do begin Line := TLine.create(BeginPoint.x, BeginPoint.y + fLineHeight * 3 + i * fLineHeight, BeginPoint.x + w, BeginPoint.y + fLineHeight * 3 + i * fLineHeight, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); end; // прочертить горизонтали // основные поля Line := TLine.create(BeginPoint.x + fNumberSize, BeginPoint.y, BeginPoint.x + fNumberSize, BeginPoint.y + h, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); Line := TLine.create(BeginPoint.x + fNumberSize + fNameSize, BeginPoint.y, BeginPoint.x + fNumberSize + fNameSize, BeginPoint.y + h, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); Line := TLine.create(BeginPoint.x + fNumberSize + fNameSize + fIzmSize, BeginPoint.y, BeginPoint.x + fNumberSize + fNameSize + fIzmSize, BeginPoint.y + h, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); Line := TLine.create(BeginPoint.x + fNumberSize + fNameSize + fIzmSize + fCountSize, BeginPoint.y, BeginPoint.x + fNumberSize + fNameSize + fIzmSize + fCountSize, BeginPoint.y + h, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); // поля колонок x := fNumberSize + fNameSize + fIzmSize + fCountSize; for i := 0 to CadNormStruct.NormColumns.Count - 1 do begin CadNormColumn := TCadNormColumn(CadNormStruct.NormColumns[i]); for j := 0 to CadNormColumn.Columns.Count - 1 do begin x := x + fColumnSize; if j = CadNormColumn.Columns.Count - 1 then y := fLineHeight else y := fLineHeight * 2; Line := TLine.create(BeginPoint.x + x, BeginPoint.y + y, BeginPoint.x + x, BeginPoint.y + h, fTableWidth, ord(psSolid), clBlack, 0, LHandle, mydsNormal, GCadForm.PCad); AddFigure(Line); end; end; MustRebuild := DrawTextFileds(Rect.GetBoundRect); ToPoint.x := 25; ToPoint.y := GCadForm.PCad.WorkHeight - 10 - h; if MustRebuild then ReBuild else move(ToPoint.x - BeginPoint.x, ToPoint.y - BeginPoint.y); except on E: Exception do addExceptionToLogEx('TCadNorms.DrawTable', E.Message); end; end; function TCadNorms.DrawTextFileds(aBnd: TDoubleRect): Boolean; var i, j, k: Integer; FieldsList: TList; FieldBnd: TDoubleRect; StrField: String; x, y: double; CadNormStruct: TCadNormStruct; CadNormColumn: TCadNormColumn; SumColumn: Double; CurrX: double; tmpNumberSize: Double; tmpNameSize: Double; tmpIzmSize: Double; tmpCountSize: Double; tmpColumnSize: Double; GetTextWidth: Double; begin try Result := False; // шапка CadNormStruct := TCadNormStruct(FNormsList[0]); // основные поля StrField := CadNormStruct.Number; FieldBnd.Top := aBnd.Top; FieldBnd.Bottom := FieldBnd.Top + fLineHeight * 3; FieldBnd.Left := aBnd.Left; FieldBnd.Right := FieldBnd.Left + fNumberSize; tmpNumberSize := DrawTextToField(FieldBnd, StrField, True, fNumberSize); StrField := CadNormStruct.Name; FieldBnd.Top := aBnd.Top; FieldBnd.Bottom := FieldBnd.Top + fLineHeight * 3; FieldBnd.Left := aBnd.Left + fNumberSize; FieldBnd.Right := FieldBnd.Left + fNameSize; tmpNameSize := DrawTextToField(FieldBnd, StrField, True, fNameSize); StrField := CadNormStruct.Izm; FieldBnd.Top := aBnd.Top; FieldBnd.Bottom := FieldBnd.Top + fLineHeight * 3; FieldBnd.Left := aBnd.Left + fNumberSize + fNameSize; FieldBnd.Right := FieldBnd.Left + fIzmSize; tmpIzmSize := DrawTextToField(FieldBnd, StrField, True, fIzmSize); StrField := CadNormStruct.Count; FieldBnd.Top := aBnd.Top; FieldBnd.Bottom := FieldBnd.Top + fLineHeight * 3; FieldBnd.Left := aBnd.Left + fNumberSize + fNameSize + fIzmSize; FieldBnd.Right := FieldBnd.Left + fCountSize; tmpCountSize := DrawTextToField(FieldBnd, StrField, True, fCountSize); // поля колонок SumColumn := 0; CurrX := aBnd.Left + fNumberSize + fNameSize + fIzmSize + fCountSize; for i := 0 to CadNormStruct.NormColumns.Count - 1 do begin CadNormColumn := TCadNormColumn(CadNormStruct.NormColumns[i]); StrField := CadNormColumn.CableName; FieldBnd.Top := aBnd.Top + fLineHeight; FieldBnd.Bottom := aBnd.Top + fLineHeight * 2; FieldBnd.Left := aBnd.Left + fNumberSize + fNameSize + fIzmSize + fCountSize + SumColumn; FieldBnd.Right := FieldBnd.Left + (CadNormColumn.Columns.Count * fColumnSize); tmpColumnSize := DrawTextToField(FieldBnd, StrField, True, CadNormColumn.Columns.Count * fColumnSize); SumColumn := SumColumn + CadNormColumn.Columns.Count * fColumnSize; for j := 0 to CadNormColumn.Columns.Count - 1 do begin StrField := CadNormColumn.Columns[j]; FieldBnd.Top := aBnd.Top + fLineHeight * 2; FieldBnd.Bottom := aBnd.Top + fLineHeight * 3; FieldBnd.Left := CurrX; FieldBnd.Right := FieldBnd.Left + fColumnSize; CurrX := FieldBnd.Right; tmpColumnSize := DrawTextToField(FieldBnd, StrField); end; end; if TCadNormStruct(FNormsList[0]).NormColumns.Count > 0 then begin FieldBnd.Top := aBnd.Top; FieldBnd.Bottom := aBnd.Top + fLineHeight; FieldBnd.Left := aBnd.Left + fNumberSize + fNameSize + fIzmSize + fCountSize; FieldBnd.Right := FieldBnd.Left + SumColumn; DrawTextToField(FieldBnd, cCadClasses_Mes23, True, SumColumn); end; // все остальные поля tmpNumberSize := fNumberSize; tmpNameSize := fNameSize; tmpIzmSize := fIzmSize; tmpCountSize := fCountSize; tmpColumnSize := fColumnSize; for i := 1 to FNormsList.Count - 1 do begin CadNormStruct := TCadNormStruct(FNormsList[i]); // основные поля StrField := CadNormStruct.Number; FieldBnd.Top := aBnd.Top + fLineHeight * 2 + i * fLineHeight; FieldBnd.Bottom := FieldBnd.Top + fLineHeight; FieldBnd.Left := aBnd.Left; FieldBnd.Right := FieldBnd.Left + fNumberSize; GetTextWidth := DrawTextToField(FieldBnd, StrField, True); if GetTextWidth > tmpNumberSize then tmpNumberSize := GetTextWidth; StrField := CadNormStruct.Name; FieldBnd.Top := aBnd.Top + fLineHeight * 2 + i * fLineHeight; FieldBnd.Bottom := FieldBnd.Top + fLineHeight; FieldBnd.Left := aBnd.Left + fNumberSize; FieldBnd.Right := FieldBnd.Left + fNameSize; GetTextWidth := DrawTextToField(FieldBnd, StrField, False); if GetTextWidth > tmpNameSize then tmpNameSize := GetTextWidth; StrField := CadNormStruct.Izm; FieldBnd.Top := aBnd.Top + fLineHeight * 2 + i * fLineHeight; FieldBnd.Bottom := FieldBnd.Top + fLineHeight; FieldBnd.Left := aBnd.Left + fNumberSize + fNameSize; FieldBnd.Right := FieldBnd.Left + fIzmSize; GetTextWidth := DrawTextToField(FieldBnd, StrField, True); if GetTextWidth > tmpIzmSize then tmpIzmSize := GetTextWidth; StrField := CadNormStruct.Count; FieldBnd.Top := aBnd.Top + fLineHeight * 2 + i * fLineHeight; FieldBnd.Bottom := FieldBnd.Top + fLineHeight; FieldBnd.Left := aBnd.Left + fNumberSize + fNameSize + fIzmSize; FieldBnd.Right := FieldBnd.Left + fCountSize; GetTextWidth := DrawTextToField(FieldBnd, StrField, True); if GetTextWidth > tmpCountSize then tmpCountSize := GetTextWidth; CurrX := aBnd.Left + fNumberSize + fNameSize + fIzmSize + fCountSize; for j := 0 to CadNormStruct.NormColumns.Count - 1 do begin CadNormColumn := TCadNormColumn(CadNormStruct.NormColumns[j]); for k := 0 to CadNormColumn.Columns.Count - 1 do begin StrField := CadNormColumn.Columns[k]; FieldBnd.Top := aBnd.Top + fLineHeight * 2 + i * fLineHeight; FieldBnd.Bottom := FieldBnd.Top + fLineHeight; FieldBnd.Left := CurrX; FieldBnd.Right := FieldBnd.Left + fColumnSize; CurrX := FieldBnd.Right; GetTextWidth := DrawTextToField(FieldBnd, StrField, True); if GetTextWidth > tmpColumnSize then tmpColumnSize := GetTextWidth; end; end; end; // Check Textes Widths if tmpNumberSize > fNumberSize then begin fNumberSize := tmpNumberSize; Result := true; end; if tmpNameSize > fNameSize then begin fNameSize := tmpNameSize; Result := true; end; if tmpIzmSize > fIzmSize then begin fIzmSize := tmpIzmSize; Result := true; end; if tmpCountSize > fCountSize then begin fCountSize := tmpCountSize; Result := true; end; if tmpColumnSize > fColumnSize then begin fColumnSize := tmpColumnSize; Result := true; end; except on E: Exception do addExceptionToLogEx('TCadNorms.DrawTextFileds', E.Message); end; end; function TCadNorms.DrawTextToField(aFieldBnd: TDoubleRect; aText: string; aCentered: Boolean = True; aMaxWidth: Double = -1): Double; var i: integer; TextField: TRichText; FieldCP: TDoublePoint; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; HalfField: double; HalfText: double; ModCount: Integer; tmHeight: Integer; //Longint; Strings: TStringList; begin try Result := -1; FieldCP.x := (aFieldBnd.Left + aFieldBnd.Right) / 2; FieldCP.y := (aFieldBnd.Top + aFieldBnd.Bottom) / 2; //11.10.2011 - Упрощен способ расчета размеров {TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LayerHandle, mydsNormal, GCadForm.PCad); if aCentered then TextField.re.WordWrap := True else TextField.re.WordWrap := False; TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := fTextSize; TextField.re.Font.Style := fTextStyle; TextField.re.Font.Color := clBlack; TextField.re.Lines.Clear; TextField.re.Lines.Add(aText); // получить свойства xCanvas := TMetafileCanvas.Create(TextField.Metafile, 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 ; // нужно ограничить if aMaxWidth <> - 1 then begin if w > aMaxWidth then begin ModCount := trunc(w / aMaxWidth) + 1; w := aMaxWidth - 2; h := TM.tmHeight / 4 * ModCount + 1; end; end; FreeAndNil(xCanvas); // пересоздать с новыми свойствами if TextField <> nil then begin FreeAndNil(TextField); end;} Strings := TStringList.Create; Strings.Add(aText); GetTextSize(fTextSize, fTextStyle, GCadForm.FFontName, '', Strings, h, w, @tmHeight); //11.10.2011 ширина w не нужна if Strings.Count > 1 then h := tmHeight / 4 * Strings.Count + 1 else h := tmHeight / 4 * Strings.Count; //11.10.2011 нужно ограничить if aMaxWidth <> - 1 then begin if w > aMaxWidth then begin ModCount := trunc(w / aMaxWidth) + 1; w := aMaxWidth - 2; h := tmHeight / 4 * ModCount + 1; end; end; FreeAndNil(Strings); TextField := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LayerHandle, mydsNormal, GCadForm.PCad); if aCentered then TextField.re.WordWrap := True else TextField.re.WordWrap := False; TextField.re.Font.Name := GCadForm.FFontName; TextField.re.Font.Size := fTextSize; TextField.re.Font.Style := fTextStyle; TextField.re.Font.Color := clBlack; TextField.re.Lines.Clear; AText := FastReplace(AText,#13#10,' '); TextField.re.Lines.Add(aText); TextField.Move(FieldCP.x - TextField.CenterPoint.x, FieldCP.y - TextField.CenterPoint.y); if not aCentered then begin HalfField := abs(aFieldBnd.Left - aFieldBnd.Right) / 2; HalfText := w / 2; TextField.Move(HalfText - HalfField + 1, 0); end; AddFigure(TextField); Result := w; except on E: Exception do addExceptionToLogEx('TCadNorms.DrawTextToField', E.Message); end; end; function TCadNorms.Edit: Boolean; begin Result := False; end; function TCadNorms.isPointIn(x, y: double): boolean; var Bnd: TDoubleRect; MinX, MinY, MaxX, MaxY: Double; begin try Result := False; Bnd := GetBoundRect; MinX := Bnd.Left; MinY := Bnd.Top; MaxX := Bnd.Right; MaxY := Bnd.Bottom; if (x >= MinX) and (x <= MaxX) and (y >= MinY) and (y <= MaxY) then Result := True; except on E: Exception do addExceptionToLogEx('TCadNorms.isPointIn', E.Message); end; end; procedure TCadNorms.ReBuild; var i: Integer; begin try RemoveInFigureGrp(Self); RefreshCAD(GCadForm.PCad); Build; except on E: Exception do addExceptionToLogEx('TCadNorms.ReBuild', E.Message); end; end; procedure TCadNorms.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var xInt: Integer; xDbl: Double; begin try inherited; case xCode of 30: begin xInt := pInt(data)^; fTableWidth := xInt; FNormsList := GetOldNormsForCAD(GCadForm.FCADListID); end; 31: begin xInt := pInt(data)^; fTextSize := xInt; end; 32: begin xInt := pInt(data)^; fTextStyle := []; if xInt and $01 = $01 then fTextStyle := fTextStyle + [fsBold]; if xInt and $02 = $02 then fTextStyle := fTextStyle + [fsItalic]; if xInt and $04 = $04 then fTextStyle := fTextStyle + [fsUnderline]; if xInt and $08 = $08 then fTextStyle := fTextStyle + [fsStrikeOut]; end; 230: fNumberSize := pDouble(data)^; 231: fNameSize := pDouble(data)^; 232: fIzmSize := pDouble(data)^; 233: fCountSize := pDouble(data)^; 234: fColumnSize := pDouble(data)^; 235: fLineHeight := pDouble(data)^; end; except on E: Exception do addExceptionToLogEx('TCadNorms.SetPropertyFromStream', E.Message); end; end; procedure TCadNorms.WriteToStream(Stream: TStream); var xInt: Integer; xDbl: Double; begin try inherited; xInt := fTableWidth; WriteField(30, Stream, xInt, sizeof(xInt)); xInt := fTextSize; WriteField(31, Stream, xInt, sizeof(xInt)); xInt := $0; if fsBold in fTextStyle then xInt := xInt + $01; if fsItalic in fTextStyle then xInt := xInt + $02; if fsUnderline in fTextStyle then xInt := xInt + $04; if fsStrikeOut in fTextStyle then xInt := xInt + $08; WriteField(32, Stream, xInt, sizeof(xInt)); xDbl := fNumberSize; WriteField(230, Stream, xDbl, sizeof(xDbl)); xDbl := fNameSize; WriteField(231, Stream, xDbl, sizeof(xDbl)); xDbl := fIzmSize; WriteField(232, Stream, xDbl, sizeof(xDbl)); xDbl := fCountSize; WriteField(233, Stream, xDbl, sizeof(xDbl)); xDbl := fColumnSize; WriteField(234, Stream, xDbl, sizeof(xDbl)); xDbl := fLineHeight; WriteField(235, Stream, xDbl, sizeof(xDbl)); except on E: Exception do addExceptionToLogEx('TCadNorms.WriteToStream', E.Message); end; end; procedure TOrthoLine.DrawActiveTrace(ADEngine: TPCDrawEngine; aPoint1, aPoint2: TDoublePoint); var i: Integer; Bnd1, Bnd2: TDoubleRect; AngleDegrees, AngleRad: Double; dx, dy: double; p1, p2: TDoublePoint; delta: double; d1, d2: double; begin try delta := 1; // вычислить смещение if FSingleBlock <> nil then begin if FSingleBlock.InFigures.Count = 0 then begin if FSingleBlockDelta < 1 then FSingleBlockDelta := 1; delta := FSingleBlockDelta; end; if FSingleBlock.InFigures.Count = 1 then begin // Bnd1 := TFigure(FSingleBlock.InFigures[0]).GetBoundRect; // d1 := abs(Bnd1.Bottom - Bnd1.Top) / 2; delta := GrpSizeY / 2 + FSingleBlockDelta; end; if FSingleBlock.InFigures.Count = 2 then begin // Bnd1 := TFigure(FSingleBlock.InFigures[0]).GetBoundRect; // Bnd2 := TFigure(FSingleBlock.InFigures[1]).GetBoundRect; // d1 := abs(Bnd1.Bottom - Bnd1.Top) / 2; // d2 := abs(Bnd2.Bottom - Bnd2.Top) / 2; delta := GrpSizeY / 2 + FSingleBlockDelta; end end; // получить точку пересечения AngleDegrees := GetAngle(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); // Tolik 20/10/2015 //AngleDegrees := GetAngleDF(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); // AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; // Tolik 20/10/2015 округление здесь иногда приводит фигуру отрисовки не туда, куда след //if AngleDegrees >= 360 then AngleDegrees := round(AngleDegrees) mod 360; // AngleDegrees := round(AngleDegrees) mod 360; // AngleRad := AngleDegrees * pi / 180; dx := delta * Cos(AngleRad); dy := delta * Sin(AngleRad); if (AngleDegrees >= 180) and (AngleDegrees < 360) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if FIsRotated then begin dx := -dx; dy := -dy; end; p1.x := aPoint1.x + dx; p1.y := aPoint1.y + dy; p2.x := aPoint2.x + dx; p2.y := aPoint2.y + dy; ADEngine.drawline(p1, p2); except on E: Exception do addExceptionToLogEx('TOrthoLine.DrawActiveTrace', E.Message); end; end; procedure TOrthoLine.DrawProjectibleTrace(ADEngine: TPCDrawEngine; aPoint1, aPoint2: TDoublePoint); var i: Integer; Bnd1, Bnd2: TDoubleRect; AngleDegrees, AngleRad: Double; dx, dy: double; p1, p2: TDoublePoint; delta: double; pp1, pp2, pp3, pp4: TDoublePoint; d1, d2: double; begin try delta := 1; // вычислить смещение if FSingleBlock <> nil then begin if FSingleBlock.InFigures.Count = 0 then begin if FSingleBlockDelta < 1 then FSingleBlockDelta := 1; delta := FSingleBlockDelta; end; if FSingleBlock.InFigures.Count = 1 then begin // Bnd1 := TFigure(FSingleBlock.InFigures[0]).GetBoundRect; // d1 := abs(Bnd1.Bottom - Bnd1.Top) / 2; delta := GrpSizeY / 2 + FSingleBlockDelta; end; if FSingleBlock.InFigures.Count = 2 then begin // Bnd1 := TFigure(FSingleBlock.InFigures[0]).GetBoundRect; // Bnd2 := TFigure(FSingleBlock.InFigures[1]).GetBoundRect; // d1 := abs(Bnd1.Bottom - Bnd1.Top) / 2; // d2 := abs(Bnd2.Bottom - Bnd2.Top) / 2; delta := GrpSizeY / 2 + FSingleBlockDelta; end; end; // получить точку пересечения AngleDegrees := GetAngle(ActualPoints[1].x, ActualPoints[1].y, ActualPoints[2].x, ActualPoints[2].y); AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; // Tolik 20/10/2015 // if AngleDegrees >= 360 then AngleDegrees := round(AngleDegrees) mod 360; //AngleDegrees := round(AngleDegrees) mod 360; // AngleRad := AngleDegrees * pi / 180; dx := delta * Cos(AngleRad); dy := delta * Sin(AngleRad); if (AngleDegrees >= 180) and (AngleDegrees < 360) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if FIsRotated then begin dx := -dx; dy := -dy; end; p1.x := aPoint1.x + dx; p1.y := aPoint1.y + dy; p2.x := aPoint2.x + dx; p2.y := aPoint2.y + dy; ADEngine.drawline(p1, p2); except on E: Exception do addExceptionToLogEx('TOrthoLine.DrawProjectibleTrace', E.Message); end; end; { TSCSFigureGrp } constructor TSCSFigureGrp.create(LHandle: Integer; aOwner: TComponent); begin inherited create(LHandle, aOwner); end; function TSCSFigureGrp.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var distx, disty: double; vRect: TDoubleRect; ap: TDoublepoint; begin try // Result := inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); ap := DoublePoint(mp.coordx, mp.coordy); vRect := mp.Figure.GetBoundRect; distx := 0; distY := 0; If mp.SeqNbr in [3, 4, 5] then begin x := TraceFigure.ap2.x; distX := x - vRect.Right; ap.x := vRect.Left; end else if mp.SeqNbr in [1, 8, 7] then begin x := TraceFigure.ap1.x; distX := vRect.Left - x; ap.x := vRect.Right; end; If mp.SeqNbr in [1, 2, 3] then begin y := TraceFigure.ap1.y; distY := y - vRect.Top; ap.y := vRect.Bottom; end else if mp.SeqNbr in [5, 6, 7] then begin y := TraceFigure.ap3.y; distY := vRect.Bottom - y; ap.y := vRect.Top; end; if (distX <> 0) and (distY <> 0) then scale(1 + distx / (vRect.Right - vRect.Left), 1 + disty / (vRect.Top - vRect.Bottom), ap) else if distX = 0 then scale(1, 1 + disty / (vRect.Top - vRect.Bottom), ap) else if distY = 0 then scale(1 + distx / (vRect.Right - vRect.Left), 1, ap); ResetRegion; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.EndModification', E.Message); end; end; procedure TSCSFigureGrp.getbounds(var figMaxX, figMaxY, figMinX, figMinY: double); var i: Integer; InFigure: TFigure; MaxX, MaxY, MinX, MinY: double; isFirst: Boolean; begin try isFirst := True; for i := 0 to InFigures.Count - 1 do begin InFigure := TFigure(InFigures[i]); if not CheckFigureByClassName(InFigure, cTFigureGrpMod) then begin InFigure.GetBounds(MaxX, MaxY, MinX, MinY); if isFirst then begin figMaxX := MaxX; figMaxY := MaxY; figMinX := MinX; figMinY := MinY; isFirst := False; end else begin if MaxX > figMaxX then figMaxX := MaxX; if MaxY > figMaxY then figMaxY := MaxY; if MinX < figMinX then figMinX := MinX; if MinY < figMinY then figMinY := MinY; end; end; end; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.getbounds', E.Message); end; end; procedure TSCSFigureGrp.move(deltax, deltay: double); var i, j: Integer; InFigure: TFigure; moveFunc: TFigMoveEvent; MovedObject: TConnectorObject; CanMove: Boolean; begin try if ssCtrl in GGlobalShiftState then GGlobalShiftState := GGlobalShiftState - [ssCtrl]; // Move самого объекта // полностью взято с обработчика TFigure.Move for i := 1 to pointcount do begin originalpoints[i] := DoublePoint(originalpoints[i].x + deltax, originalpoints[i].y + deltay); Actualpoints[i] := DoublePoint(actualpoints[i].x + deltax, actualpoints[i].y + deltay); end; RotPoint := DoublePoint(RotPoint.x + deltaX, RotPoint.y + DeltaY); ResetRegion; for i := 0 to JoinedFigures.Count - 1 do begin if TFigure(JoinedFigures[i]) is TLine then TLine(JoinedFigures[i]).JoinFigureMoved(self, deltax, deltay) else if TFigure(JoinedFigures[i]) is TPolyLine then TPolyLine(JoinedFigures[i]).JoinFigureMoved(self, deltax, deltay); end; if DimLines.Count > 0 then CreateDimLines; if assigned(Fill) and (assigned(Fill.Grp)) then Fill.Move(deltaX, deltaY); MoveClipFigures(deltaX, deltaY); // --------------------------------------------- GDisableMove := True; // ВНУТРЕННИЕ СЕТИ if GCadForm.FSCSType = st_Internal then begin for i := 0 to inFigures.Count - 1 do begin InFigure := TFigure(InFigures[i]); if CheckFigureByClassName(InFigure, cTConnectorObject) then begin if not InFigure.LockMove then begin if TConnectorObject(InFigure).FConnRaiseType = crt_None then InFigure.move(deltax, deltay) else if TConnectorObject(InFigure).ConnectorType <> ct_Clear then InFigure.move(deltax, deltay); end; end else if CheckFigureByClassName(InFigure, cTOrthoLine) then begin if not InFigure.LockMove then begin if not TOrthoLine(InFigure).FIsRaiseUpDown then InFigure.move(deltax, deltay); end; end; end; end else // ВНЕШНИЕ СЕТИ if GCadForm.FSCSType = st_External then begin for i := 0 to inFigures.Count - 1 do begin InFigure := TFigure(InFigures[i]); if CheckFigureByClassName(InFigure, cTConnectorObject) then begin MovedObject := TConnectorObject(TConnectorObject(InFigure)); CanMove := True; for j := 0 to MovedObject.JoinedOrtholinesList.Count - 1 do if TOrthoLine(MovedObject.JoinedOrtholinesList[j]).FConnectingLine then CanMove := False; if CanMove then MovedObject.Move(deltax, deltay); end; end; end; GDisableMove := False; BDeltax := BDeltax + deltax; BDeltay := BDeltay + deltay; ResetRegion; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.move', E.Message); end; end; procedure TSCSFigureGrp.UnGroup; var i: integer; FFigure: TFigure; Conns, Lines: TList; CurConn: TConnectorObject; CurLine: TOrthoLine; begin try if AlwaysTogether then Exit; Combined := False; Deselect; Conns := TList.Create; Lines := TList.Create; for i := 0 to inFigures.Count - 1 do begin FFigure := TFigure(InFigures[i]); GCadForm.PCad.Figures.Add(FFigure); FFigure.Parent := nil; //30.05.2011 if CheckFigureByClassName(FFigure, cTConnectorObject) then begin Conns.Add(FFigure); FFigure.select; end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin Lines.Add(FFigure); FFigure.select; end; end; for i := 0 to Conns.Count - 1 do begin CurConn := TConnectorObject(Conns[i]); CurConn.FGroupObject := nil; end; for i := 0 to Lines.Count - 1 do begin CurLine := TOrthoLine(Lines[i]); CurLine.FGroupObject := nil; end; UnGrouped := true; ResetRegion; FreeAndNil(Conns); FreeAndNil(Lines); except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.UnGroup', E.Message); end; end; procedure TSCSFigureGrp.WriteToStream(Stream: TStream); begin inherited; end; procedure TSCSFigureGrp.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var mstr: TMemoryStream; Figure: Tfigure; begin try // inherited; Case xcode of 90: Combined := (pByte(data)^ = 1); 150: begin mStr := TMemoryStream.Create; mStr.Write(pByte(data)^,size); mStr.Position := 0; Figure := TFigure.CreateFromStream(mStr, LayerHandle, DrawStyle, Owner); AddToGrp(Figure); //28.04.2011 InFigures.Add(Figure); mStr.Free; end; end; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.SetPropertyFromStream', E.Message); end; end; procedure TSCSFigureGrp.RaiseProperties(CadFigList: TList); var i: Integer; FFigure: TFigure; begin try for i := 0 to InFigures.Count - 1 do begin FFigure := TFigure(InFigures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then TConnectorObject(FFigure).RaiseProperties(CadFigList) else if CheckFigureByClassName(FFigure, cTOrthoLine) then TOrthoLine(FFigure).RaiseProperties(CadFigList); end; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.RaiseProperties', E.Message); end; end; Procedure TSCSFigureGrp.Rotate(aAngle: Double; cPoint: TDoublePoint); //30.08.2012 var a, j: integer; fig: TFigure; Cad: TPCDrawing; Arc: TElpArc; pd1: TDoublePoint; ElpArc: TElpArc; ElpPoly: TPolyline; TmpFigures: TList; RotatedFigures: TList; ConnOldPoints: TList; OldPt: PDoublePoint; //OldPtFObjectFromRaisedLine: TDoublePoint; ObjIdx: Integer; TmpDX: Double; TmpDY: Double; RaiseConn, ObjFromRaise: TConnectorObject; ListToPassage, CurrGCadForm: TF_CAD; ConnToPassage: TConnectorObject; CurrConnToPassageID: Integer; procedure RotateConnObj(aConn: TFigure); begin if RotatedFigures.IndexOf(aConn) = -1 then begin TConnectorObject(aConn).FIsRotating := true; try // Запоминаем точку перед переворотом GetZeroMem(OldPt, SizeOf(TDoublePoint)); OldPt^ := TConnectorObject(aConn).ActualPoints[1]; // Переворот TConnectorObject(aConn).RotateByParams(aAngle,cPoint); if TConnectorObject(aConn).CaptionsGroup <> nil then TConnectorObject(aConn).CaptionsGroup.rotate(aAngle,cPoint); if TConnectorObject(aConn).NotesGroup <> nil then TConnectorObject(aConn).NotesGroup.rotate(aAngle,cPoint); finally TConnectorObject(aConn).FIsRotating := false; end; ConnOldPoints.Add(OldPt); RotatedFigures.Add(aConn); end; end; begin //inherited; //Exit; ///// EXIT ///// //TFigure(Self).Rotate(aAngle, cPoint); //inherited; TmpFigures := inFigures; inFigures := TList.Create; inherited; inFigures.Free; inFigures := TmpFigures; RotatedFigures := TList.Create; ConnOldPoints := TList.Create; AngletoPoint := AngleToPoint + aAngle; for a := 0 to inFigures.Count - 1 do begin fig := TFigure(inFigures[a]); if (fig is TElpArc) then begin Cad := TPCdrawing(owner); Cad.ClearUndoList; Arc := TElpArc(fig); ElpPoly := TPolyline(Arc.DuplicateAsBezier); InFigures[a] := ElpPoly; Arc.Destroy; TFigure(InFigures[a]).rotate(aAngle,cPoint); end else if fig is TConnectorObject then begin //if TConnectorObject(fig).ConnectorType <> ct_Clear then begin RotateConnObj(fig); for j := 0 to TConnectorObject(fig).JoinedConnectorsList.Count - 1 do RotateConnObj(TConnectorObject(TConnectorObject(fig).JoinedConnectorsList[j])); end; //if TConnectorObject(fig).ConnectorType <> ct_Clear then //begin // TConnectorObject(fig).RotateByParams(aAngle,cPoint); // for j := 0 to TConnectorObject(fig).JoinedConnectorsList.Count - 1 do // TConnectorObject(TConnectorObject(fig).JoinedConnectorsList[j]).RotateByParams(aAngle,cPoint); //end; end else if fig is TOrtholine then begin fig.rotate(aAngle,cPoint); RotateConnObj(TConnectorObject(TOrtholine(fig).JoinConnector1)); RotateConnObj(TConnectorObject(TOrtholine(fig).JoinConnector2)); //TConnectorObject(TOrtholine(fig).JoinConnector1).RotateByParams(aAngle,cPoint); //TConnectorObject(TOrtholine(fig).JoinConnector2).RotateByParams(aAngle,cPoint); //if TOrtholine(fig).FIsRaiseUpDown then begin if TOrtholine(fig).CaptionsGroup <> nil then TOrtholine(fig).CaptionsGroup.rotate(aAngle,cPoint); if TOrtholine(fig).NotesGroup <> nil then TOrtholine(fig).NotesGroup.rotate(aAngle,cPoint); end; {if TOrtholine(fig).DrawFigure <> nil then TOrtholine(fig).DrawFigure.rotate(aAngle,cPoint);} if TOrtholine(fig).FSingleBlock <> nil then begin //TOrtholine(fig).FSingleBlock.rotate(aAngle,cPoint);{} TOrtholine(fig).ReCreateDrawFigureBlock; end; if TOrtholine(fig).FObjectFromRaisedLine <> nil then begin //OldPtFObjectFromRaisedLine := TOrtholine(fig).FObjectFromRaisedLine.ActualPoints[1]; RotateConnObj(TOrtholine(fig).FObjectFromRaisedLine); end; if TOrtholine(fig).FIsRaiseUpDown then begin // м-э с.п. if TOrtholine(fig).FObjectFromRaisedLine <> nil then if (GetKeyState(VK_SHIFT) and 128) = 1 then //Если не нажата VK_SHIFT begin RaiseConn := GetRaiseConn(TOrtholine(fig).FObjectFromRaisedLine); if RaiseConn <> nil then if RaiseConn.FID_ConnToPassage <> -1 then begin ListToPassage := GetListOfPassage(RaiseConn.FID_ListToPassage); ConnToPassage := TConnectorObject(GetFigureByID(ListToPassage, RaiseConn.FID_ConnToPassage)); if ConnToPassage <> nil then begin ObjFromRaise := ConnToPassage.FObjectFromRaise; if ObjFromRaise <> nil then begin RotateConnObj(RaiseConn); ObjIdx := RotatedFigures.IndexOf(RaiseConn); if ObjIdx <> - 1 then begin OldPt := ConnOldPoints[ObjIdx]; TmpDX := RaiseConn.ActualPoints[1].x - OldPt^.x; TmpDY := RaiseConn.ActualPoints[1].y - OldPt^.y; CurrGCadForm := GCadForm; GCadForm := ListToPassage; CurrConnToPassageID := ConnToPassage.FID_ConnToPassage; ConnToPassage.FID_ConnToPassage := -1; try ObjFromRaise.MoveConnector(TmpDX, TmpDY); finally ConnToPassage.FID_ConnToPassage := CurrConnToPassageID; GCadForm := CurrGCadForm; end; end; end; end; end; {ObjIdx := RotatedFigures.IndexOf(TOrtholine(fig).FObjectFromRaisedLine); if ObjIdx <> - 1 then begin OldPt := ConnOldPoints[ObjIdx]; TmpDX := TOrtholine(fig).FObjectFromRaisedLine.ActualPoints[1].x - OldPt^.x; TmpDY := TOrtholine(fig).FObjectFromRaisedLine.ActualPoints[1].y - OldPt^.y; TConnectorObject(TOrtholine(fig).FObjectFromRaisedLine).MoveRaiseConnector(TmpDX, TmpDY); TConnectorObject(TOrtholine(fig).FObjectFromRaisedLine).MoveBetweenRaiseConnector(TmpDX, TmpDY); end;} end; //TConnectorObject(FObjectFromRaisedLine).Move(deltax, deltay); end; end else begin fig.rotate(aAngle,cPoint); end; end; // Tolik 03/05/2019 -- //ConnOldPoints.Free; FreeList(ConnOldPoints); // RotatedFigures.Free; Changed := True; CreateMetafile; ResetRegion; end; function TSCSFigureGrp.isPointIn(x, y: double): boolean; begin try Result := false; if (x > ap1.x) and (x < ap2.x) and (y > ap1.y) and (y < ap4.y) then Result := True; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.isPointIn', E.Message); end; end; function TSCSFigureGrp.Edit: Boolean; begin result := false; end; procedure TSCSFigureGrp.scale(percentx, percenty: double; rPoint: Tdoublepoint); var i, j: Integer; CurLine: TOrthoLine; CurConn: TConnectorObject; Point1, Point2: TDoublePoint; CP_Old, CP_New: TDoublePoint; deltax, deltay: Double; Old_point, Old_point1, Old_point2, New_point, New_point1, New_point2: TDoublePoint; AllConnsList, ConnsList, LinesList, MovedList: TList; MovedConnector1, MovedConnector2: TConnectorObject; CanMove: Boolean; RaiseConn, BaseConn: TConnectorObject; begin try for i := 1 to pointcount do begin actualpoints[i] := ScalePoint(rPoint, actualpoints[i], percentx, percenty); originalpoints[i] := ScalePoint(rPoint, originalpoints[i], percentx, percenty); end; radius := radius * percentx; if DimLines.Count > 0 then CreateDimLines; if assigned(Fill) then Fill.Scale(percentx, percenty, rPoint); ResetRegion; // ------------------------------------- AllConnsList := TList.Create; LinesList := TList.Create; ConnsList := TList.Create; MovedList := TList.Create; for i := 0 to inFigures.Count - 1 do begin If CheckFigureByClassName(TFigure(InFigures[i]), cTOrthoLine) then begin LinesList.Add(TOrthoLine(InFigures[i])); end else If CheckFigureByClassName(TFigure(InFigures[i]), cTConnectorObject) then begin AllConnsList.Add(TConnectorObject(InFigures[i])); if TConnectorObject(InFigures[i]).ConnectorType <> ct_Clear then if (TConnectorObject(InFigures[i]).JoinedConnectorsList.Count = 0) or CheckTrunkObject(TConnectorObject(InFigures[i])) then ConnsList.Add(TConnectorObject(InFigures[i])); end; end; // ВНУТРЕННИЕ СЕТИ if GCadForm.FSCSType = st_Internal then begin // МАСШТАБИРОВАНИЕ ТРАСС for i := 0 to LinesList.Count - 1 do begin CurLine := TOrthoLine(LinesList[i]); Old_point1 := CurLine.ActualPoints[1]; Old_point2 := CurLine.ActualPoints[2]; New_point1 := ScalePoint(rPoint, Old_point1, percentx, percenty); New_point2 := ScalePoint(rPoint, Old_point2, percentx, percenty); if not CurLine.FIsRaiseUpDown then begin // Move MovedConnector1 := TConnectorObject(CurLine.JoinConnector1); MovedConnector2 := TConnectorObject(CurLine.JoinConnector2); // Определение перемещающихся коннекторов // -1- if TConnectorObject(CurLine.JoinConnector1).JoinedConnectorsList.Count > 0 then MovedConnector1 := TConnectorObject(CurLine.JoinConnector1).JoinedConnectorsList[0]; if TConnectorObject(CurLine.JoinConnector1).FConnRaiseType <> crt_None then if TConnectorObject(CurLine.JoinConnector1).FObjectFromRaise <> nil then MovedConnector1 := TConnectorObject(CurLine.JoinConnector1).FObjectFromRaise; // -2- if TConnectorObject(CurLine.JoinConnector2).JoinedConnectorsList.Count > 0 then MovedConnector2 := TConnectorObject(CurLine.JoinConnector2).JoinedConnectorsList[0]; if TConnectorObject(CurLine.JoinConnector2).FConnRaiseType <> crt_None then if TConnectorObject(CurLine.JoinConnector2).FObjectFromRaise <> nil then MovedConnector2 := TConnectorObject(CurLine.JoinConnector2).FObjectFromRaise; // Перемещение через коннекторы if CheckNoFigureInList(MovedConnector1, MovedList) and (CurLine.FGroupObject = MovedConnector1.FGroupObject) then begin deltax := New_point1.x - Old_point1.x; deltay := New_point1.y - Old_point1.y; TConnectorObject(MovedConnector1).Move(deltax, deltay); MovedList.Add(MovedConnector1); // RaiseConn := GetRaiseConn(MovedConnector1); BaseConn := MovedConnector1.FObjectFromRaise; if RaiseConn <> nil then MovedList.Add(RaiseConn); if BaseConn <> nil then MovedList.Add(BaseConn); // end; if CheckNoFigureInList(MovedConnector2, MovedList) and (CurLine.FGroupObject = MovedConnector2.FGroupObject) then begin deltax := New_point2.x - Old_point2.x; deltay := New_point2.y - Old_point2.y; TConnectorObject(MovedConnector2).Move(deltax, deltay); MovedList.Add(MovedConnector2); // RaiseConn := GetRaiseConn(MovedConnector2); BaseConn := MovedConnector2.FObjectFromRaise; if RaiseConn <> nil then MovedList.Add(RaiseConn); if BaseConn <> nil then MovedList.Add(BaseConn); // end; end; CurLine.ResetRegion; end; // МАСШТАБИРОВАНИЕ ОБЪЕКТОВ for i := 0 to ConnsList.Count - 1 do begin CurConn := TConnectorObject(ConnsList[i]); Old_point := CurConn.ActualPoints[1]; New_point := ScalePoint(rPoint, Old_point, percentx, percenty); deltax := New_point.x - Old_point.x; deltay := New_point.y - Old_point.y; CurConn.Move(deltax, deltay); CurConn.ResetRegion; end; end else // ВНЕШНИЕ СЕТИ if GCadForm.FSCSType = st_external then begin // МАСШТАБИРОВАНИЕ ОБЪЕКТОВ for i := 0 to ConnsList.Count - 1 do begin CurConn := TConnectorObject(ConnsList[i]); Old_point := CurConn.ActualPoints[1]; New_point := ScalePoint(rPoint, Old_point, percentx, percenty); deltax := New_point.x - Old_point.x; deltay := New_point.y - Old_point.y; CurConn.Move(deltax, deltay); CurConn.ResetRegion; end; // МАСШТАБИРОВАНИЕ ТРАСС for i := 0 to LinesList.Count - 1 do begin CurLine := TOrthoLine(LinesList[i]); Old_point1 := CurLine.ActualPoints[1]; Old_point2 := CurLine.ActualPoints[2]; New_point1 := ScalePoint(rPoint, Old_point1, percentx, percenty); New_point2 := ScalePoint(rPoint, Old_point2, percentx, percenty); if not CurLine.FConnectingLine then begin // Move MovedConnector1 := TConnectorObject(CurLine.JoinConnector1); MovedConnector2 := TConnectorObject(CurLine.JoinConnector2); // Определение перемещающихся коннекторов // -1- if TConnectorObject(CurLine.JoinConnector1).JoinedConnectorsList.Count > 0 then MovedConnector1 := TConnectorObject(CurLine.JoinConnector1).JoinedConnectorsList[0]; if TConnectorObject(CurLine.JoinConnector1).FConnRaiseType <> crt_None then if TConnectorObject(CurLine.JoinConnector1).FObjectFromRaise <> nil then MovedConnector1 := TConnectorObject(CurLine.JoinConnector1).FObjectFromRaise; // -2- if TConnectorObject(CurLine.JoinConnector2).JoinedConnectorsList.Count > 0 then MovedConnector2 := TConnectorObject(CurLine.JoinConnector2).JoinedConnectorsList[0]; if TConnectorObject(CurLine.JoinConnector2).FConnRaiseType <> crt_None then if TConnectorObject(CurLine.JoinConnector2).FObjectFromRaise <> nil then MovedConnector2 := TConnectorObject(CurLine.JoinConnector2).FObjectFromRaise; // Перемещение через коннекторы if CheckNoFigureInList(MovedConnector1, MovedList) then begin deltax := New_point1.x - Old_point1.x; deltay := New_point1.y - Old_point1.y; CanMove := True; for j := 0 to MovedConnector1.JoinedOrtholinesList.Count - 1 do if TOrthoLine(MovedConnector1.JoinedOrtholinesList[j]).FConnectingLine then CanMove := False; if CanMove then begin MovedConnector1.Move(deltax, deltay); MovedList.Add(MovedConnector1); end; end; if CheckNoFigureInList(MovedConnector2, MovedList) then begin deltax := New_point2.x - Old_point2.x; deltay := New_point2.y - Old_point2.y; CanMove := True; for j := 0 to MovedConnector2.JoinedOrtholinesList.Count - 1 do if TOrthoLine(MovedConnector2.JoinedOrtholinesList[j]).FConnectingLine then CanMove := False; if CanMove then begin MovedConnector2.Move(deltax, deltay); MovedList.Add(MovedConnector2); end; end; end; CurLine.ResetRegion; end; end; Changed := True; CreateMetafile; ResetRegion; FreeAndNil(AllConnsList); FreeAndNil(LinesList); FreeAndNil(ConnsList); FreeAndNil(MovedList); except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.scale', E.Message); end; end; procedure TSCSFigureGrp.Delete; var i: Integer; FFigure: TFigure; CurLine: TOrthoLine; CurConn: TConnectorObject; begin try if Not Deleted then begin // Tolik -- 14/03/2016 -- {i := 0; while i < InFigures.Count do begin FFigure := TFigure(InFigures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin CurConn := TConnectorObject(FFigure); if Assigned(CurConn.CaptionsGroup) then CurConn.CaptionsGroup.Delete; if Assigned(CurConn.NotesGroup) then CurConn.NotesGroup.Delete; if Assigned(CurConn.DrawFigure) then CurConn.DrawFigure.Delete; DeleteObjectFromPM(CurConn.ID, CurConn.Name); RemoveFromGrp(CurConn); //28.04.2011 InFigures.Remove(CurConn); FreeAndNil(CurConn); end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin CurLine := TOrthoLine(FFigure); if Assigned(CurLine.CaptionsGroup) then CurLine.CaptionsGroup.Delete; if Assigned(CurLine.NotesGroup) then CurLine.NotesGroup.Delete; if Assigned(CurLine.MultilineCaptionBox) then TText/od(CurLine.MultilineCaptionBox).Delete; if Assigned(CurLine.FSingleBlock) then begin CurLine.DrawFigure.RemoveFromGrp(CurLine.FSingleBlock); //28.04.2011 CurLine.DrawFigure.InFigures.Remove(CurLine.FSingleBlock); CurLine.FSingleBlock.Delete; end; if Assigned(CurLine.DrawFigure) then CurLine.DrawFigure.Delete; DeleteObjectFromPM(CurLine.ID, CurLine.Name); RemoveFromGrp(CurLine); //28.04.2011 InFigures.Remove(CurLine); FreeAndNil(CurLine); end else i := i + 1; end;} for i := 0 to InFigures.count - 1 do begin FFigure := TFigure(InFigures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then TConnectorObject(FFigure).Delete else if CheckFigureByClassName(FFigure, cTOrthoLine) then TOrthoLine(FFigure).Delete; end; InFigures.Clear; // Deleted := True; GCadForm.PCad.Figures.Remove(Self); FreeAndNil(Self); RefreshCAD(GCadForm.Pcad); end; except on E: Exception do addExceptionToLogEx('TSCSFigureGrp.Delete', E.Message); end; end; procedure TConnectorObject.SetConnectedLinesDrawShadow(X, Y: Double); var i, j, k: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; JoinedLinesByVerticals: TList; // Tolik -- 12/04/2018 -- ConnFound: Boolean; begin if self.Id = -1 then exit; try // Tolik 16/04/2018 -- //if (FJoinedOrthoLinesByVerticals = nil) or ((FJoinedOrthoLinesByVerticals <> nil) and (FJoinedOrthoLinesByVerticals.Count = 0)) then //begin //FModConnsOtherSides := GetConnectorsOtherSides(Self); //end; // пустые соединители через трассы for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(GTempJoinedOrtholinesList[i]); if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then if not JoinedLine.FIsRaiseUpDown then if not JoinedLine.FisVertical then // Tolik --02/04/2018 -- begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; // Tolik 16/04/2018 -- //if JoinedLine.JoinConnector1 = Self then if JoinedLine.JoinConnector1.ID = Self.ID then // begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else //Tolik 16/04/2018 -- //if JoinedLine.JoinConnector2 = Self then if JoinedLine.JoinConnector2.ID = Self.ID then // begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end else begin // Tolik -- 16/04/2018 -- ConnFound := False; if FModConnsOtherSides <> nil then begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); if JoinedConn.JoinedConnectorsList.count > 0 then JoinedConn := TConnectorObject(JoinedConn.JoinedConnectorsList[0]); if FModConnsOtherSides.IndexOf(JoinedConn) <> -1 then begin ConnFound := True; JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else begin JoinedConn := TConnectorObject(JoinedLine.JoinConnector2); if JoinedConn.JoinedConnectorsList.count > 0 then JoinedConn := TConnectorObject(JoinedConn.JoinedConnectorsList[0]); if FModConnsOtherSides.IndexOf(JoinedConn) <> -1 then begin ConnFound := True; JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end; end; end; // // искать через глобальный указатель if not ConnFound then //Tolik 16/04/2018 -- begin if JoinedLine.JoinConnector1 = GLastConnector then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else if JoinedLine.JoinConnector2 = GLastConnector then begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end end; end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; // Объекты if GTempJoinedConnectorsList <> nil then begin for k := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(GTempJoinedConnectorsList[k]); for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[i]); if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin if not JoinedLine.FIsRaiseUpDown then if not JoinedLine.FIsVertical then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; if JoinedLine.JoinConnector1 = JoinedConn then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else if JoinedLine.JoinConnector2 = JoinedConn then begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; end; // трассы через с-п RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin // Tolik -- 18/04/2018 -- а если на вершине райза поинт будет...писец... не найдет ничего if RaiseConn.ConnectorType = ct_Clear then begin // for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin if not JoinedLine.FIsRaiseUpDown then if not JoinedLine.FisVertical then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; if JoinedLine.JoinConnector1 = RaiseConn then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else if JoinedLine.JoinConnector2 = RaiseConn then begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end else // Tolik 18/04/2018 -- это если поинт на вершине... begin for i := 0 to RaiseConn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(RaiseConn.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin if not JoinedLine.FIsRaiseUpDown then if not JoinedLine.FisVertical then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; if JoinedLine.JoinConnector1.ID = JoinedConn.ID then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else if JoinedLine.JoinConnector2.ID = JoinedConn.ID then begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; end; end else begin RaiseConn := GetRaiseConn(GLastConnector); if RaiseConn <> nil then begin // Tolik -- 18/04/2018 -- if RaiseConn.ConnectorType = ct_Clear then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if not JoinedLine.FIsRaiseUpDown then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; if JoinedLine.JoinConnector1 = RaiseConn then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else if JoinedLine.JoinConnector2 = RaiseConn then begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end else begin for i := 0 to RaiseConn.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(RaiseConn.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if FJoinedOrthoLinesByVerticals.IndexOf(JoinedLine) = -1 then begin if not JoinedLine.FIsRaiseUpDown then if not JoinedLine.FisVertical then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; if JoinedLine.JoinConnector1 = JoinedConn then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else if JoinedLine.JoinConnector2 = JoinedConn then begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; end; end; end; //Tolik 02/04/2018 -- if FJoinedOrthoLinesByVerticals <> nil then begin //if Self.ConnectorType = ct_Clear then begin for i := 0 to FJoinedOrthoLinesByVerticals.Count - 1 do begin JoinedLine := TOrthoLine(FJoinedOrthoLinesByVerticals[i]); //if not JoinedLine.tmpDrawShadow then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := True; JoinedConn := TConnectorObject(JoinedLine.JoinConnector1); { if JoinedConn.JoinedConnectorsList.Count > 0 then JoinedConn := TConnectorObject(JoinedConn.JoinedConnectorsList[0]);} if FModConnsOtherSides.IndexOf(JoinedConn) = -1 then begin JoinedLine.tmpShadowP1 := DoublePoint(X, Y); JoinedLine.tmpShadowP2 := DoublePoint(JoinedLine.ActualPoints[2].x, JoinedLine.ActualPoints[2].y); end else begin begin JoinedLine.tmpShadowP1 := DoublePoint(JoinedLine.ActualPoints[1].x, JoinedLine.ActualPoints[1].y); JoinedLine.tmpShadowP2 := DoublePoint(X, Y); end end; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.SetConnectedLinesDrawShadow', E.Message); end; end; // Tolik -- 22/04/2017 -- procedure TConnectorObject.SkipConnectedLinesDrawShadow; var i, j: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; begin try if deleted then exit; if Self.ConnectorType = ct_Clear then begin for i := 0 to JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedOrtholinesList[i]); if JoinedLine.tmpDrawShadow then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end else if Self.ConnectorType = ct_NB then begin for i := 0 to JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.tmpDrawShadow then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; // трассы через с-п // IGOR - Толян был закоментил весь кусок трассы через с-п, но оно таки надо // ибо возникают визуально оторванные трассы если резко дергать за УГОшки со с/п // и получим такое: "X:\Projects\Эксперт-СКС\! Screens\" bug_SkipConnectedLinesDrawShadow.JPG RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if not JoinedLine.FIsRaiseUpDown then begin if JoinedLine.tmpDrawShadow then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; // Tolik 02/04/2018 -- по вертикали -- if FJoinedOrthoLinesByVerticals <> nil then begin for i := 0 to FJoinedOrthoLinesByVerticals.Count - 1 do begin JoinedLine := TOrthoLine(FJoinedOrthoLinesByVerticals[i]); if JoinedLine.tmpDrawShadow then begin JoinedLine.Draw(GCadForm.PCad.DEngine, False); JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; FreeAndNil(FJoinedOrthoLinesByVerticals); if FModConnsOtherSides <> nil then FreeAndNil(FModConnsOtherSides); end; except on E: Exception do addExceptionToLogEx('TConnectorObject.SkipConnectedLinesDrawShadow', E.Message); end; end; // { procedure TConnectorObject.SkipConnectedLinesDrawShadow; var i, j: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; begin try for i := 0 to JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedOrtholinesList[i]); if JoinedLine.tmpDrawShadow then begin JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; for i := 0 to JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.tmpDrawShadow then begin JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; // трассы через с-п RaiseConn := GetRaiseConn(Self); if RaiseConn <> nil then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if not JoinedLine.FIsRaiseUpDown then begin if JoinedLine.tmpDrawShadow then begin JoinedLine.tmpDrawShadow := False; JoinedLine.Draw(GCadForm.PCad.DEngine, False); end; end; end; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.SkipConnectedLinesDrawShadow', E.Message); end; end; } procedure TConnectorObject.SetDrawFigurePercent(aPercent: Double); var MapScale: Double; Bnd: TDoubleRect; begin try MapScale := GCadForm.PCad.MapScale; Scale(aPercent / 100, aPercent / 100, ActualPoints[1]); DrawFigure.Scale(aPercent / 100, aPercent / 100, ActualPoints[1]); except on E: Exception do addExceptionToLogEx('TConnectorObject.SetDrawFigurePercent', E.Message); end; end; function TConnectorObject.GetPosWithAngle(aX, aY, aAngle: Double): TDoublePoint; var i, j: Integer; Trace: TOrthoLine; X1, Y1: Double; X, Y: Double; Len_X, Len_Y: double; Angle: double; AngleRad: Double; SetAngle: Double; SetAngleRad: Double; PartCount: Integer; RestCount: Double; deltaA: Double; oPoint, cPoint, p: TDoublePoint; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; begin try Result := DoublePoint(aX, aY); Trace := nil; if ConnectorType = ct_Clear then begin for i := 0 to GTempJoinedOrtholinesList.Count - 1 do begin if not TOrthoLine(GTempJoinedOrtholinesList[i]).FIsRaiseUpDown then begin Trace := TOrthoLine(GTempJoinedOrtholinesList[i]); if Trace.JoinConnector1 = GLastConnector then begin X1 := TConnectorObject(Trace.JoinConnector2).ActualPoints[1].x; Y1 := TConnectorObject(Trace.JoinConnector2).ActualPoints[1].y; end else if Trace.JoinConnector2 = GLastConnector then begin X1 := TConnectorObject(Trace.JoinConnector1).ActualPoints[1].x; Y1 := TConnectorObject(Trace.JoinConnector1).ActualPoints[1].y; end; Break; end; end; end else begin // на одном уровне for i := 0 to GTempJoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(GTempJoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin if not TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then begin Trace := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if Trace.JoinConnector1 = JoinedConn then begin X1 := TConnectorObject(Trace.JoinConnector2).ActualPoints[1].x; Y1 := TConnectorObject(Trace.JoinConnector2).ActualPoints[1].y; end else if Trace.JoinConnector2 = JoinedConn then begin X1 := TConnectorObject(Trace.JoinConnector1).ActualPoints[1].x; Y1 := TConnectorObject(Trace.JoinConnector1).ActualPoints[1].y; end; end; end; if Trace <> nil then Break; end; // через с-п if Trace = nil then begin RaiseConn := GetRaiseConn(GLastConnector); if RaiseConn <> nil then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin if not TOrthoLine(RaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin Trace := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if Trace.JoinConnector1 = RaiseConn then begin X1 := TConnectorObject(Trace.JoinConnector2).ActualPoints[1].x; Y1 := TConnectorObject(Trace.JoinConnector2).ActualPoints[1].y; end else if Trace.JoinConnector2 = RaiseConn then begin X1 := TConnectorObject(Trace.JoinConnector1).ActualPoints[1].x; Y1 := TConnectorObject(Trace.JoinConnector1).ActualPoints[1].y; end; Break; end; end; end; end; end; if Trace <> nil then begin X := GCurrMousePos.x; Y := GCurrMousePos.y; Len_X := abs(X1 - X); Len_Y := abs(Y1 - Y); AngleRad := Trace.GetAngleInRad(X1, Y1, X, Y); Angle := AngleRad * 180 / pi; PartCount := round(Angle) div round(aAngle); RestCount := round(Angle) mod round(aAngle); if RestCount > (aAngle / 2) then PartCount := PartCount + 1; // set angle SetAngle := PartCount * aAngle; SetAngleRad := SetAngle * pi / 180; deltaA := SetAngleRad - AngleRad; // повернуть точку на угол cPoint := DoublePoint(X1, Y1); oPoint := DoublePoint(X, Y); oPoint := DoublePoint(oPoint.x - cpoint.x, oPoint.y - cPoint.y); p.y := oPoint.x * sin(deltaA) + oPoint.y * cos(deltaA); p.x := oPoint.x * cos(deltaA) - oPoint.y * sin(deltaA); p := DoublePoint(p.x + cpoint.x, p.y + cpoint.y); Result.X := p.x; Result.Y := p.y; end; except on E: Exception do addExceptionToLogEx('TConnectorObject.GetPosWithAngle', E.Message); end; end; function TOrthoLine.GetAngleInRad(aX1, aY1, aX2, aY2: Double): Double; var dx, dy: Double; ang: Double; begin try Result := 0; dx := abs(aX2 - aX1); dy := abs(aY2 - aY1); if (dx = 0) and (dy = 0) then // error begin result := 0; exit; end; if dx = 0 then begin if aY2 > aY1 then result := pi / 2 else result := pi * 1.5; end else if dy = 0 then begin if aX2 > aX1 then result := 0 else result := pi; end else begin ang := arctan(dy / dx); if (aX2 > aX1) and (aY2 > aY1) then begin ang := ang; end else if (aX2 < aX1) and (aY2 > aY1) then begin ang := pi - ang; end else if (aX2 < aX1) and (aY2 < aY1) then begin ang := pi + ang; end else if (aX2 > aX1) and (aY2 < aY1) then begin ang := 2 * PI - ang; end; Result := ang; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetAngleInRad', E.Message); end; end; function TOrthoLine.CheckTraceNotHaveConnect(CheckAll: boolean = True): Boolean; var Conn1, Conn2: TConnectorObject; begin try Result := True; Conn1 := TConnectorObject(JoinConnector1); Conn2 := TConnectorObject(JoinConnector2); if (Conn1 <> nil) and (Conn2 <> nil) then begin if CheckAll then begin if CheckFigureByClassName(Conn1, cTConnectorObject) and CheckFigureByClassName(Conn2, cTConnectorObject) then if ((Conn1.JoinedConnectorsList.Count > 0) or (Conn1.JoinedOrtholinesList.Count > 1)) and ((Conn2.JoinedConnectorsList.Count > 0) or (Conn2.JoinedOrtholinesList.Count > 1)) then Result := False; end else begin if CheckFigureByClassName(Conn1, cTConnectorObject) and CheckFigureByClassName(Conn2, cTConnectorObject) then if ((Conn1.JoinedConnectorsList.Count > 0) or (Conn1.JoinedOrtholinesList.Count > 1)) or ((Conn2.JoinedConnectorsList.Count > 0) or (Conn2.JoinedOrtholinesList.Count > 1)) then Result := False; end; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.CheckTraceNotHaveConnect', E.Message); end; end; function TOrthoLine.DrawFigureRemoveCalc(TBGrpCP, OldAP1, OldAP2, NewAP1, NewAP2: TDoublePoint; aH: Double): TDoublePoint; var OldA, OldB, OldC: Double; NewA, NewB, NewC: Double; OldPart1, OldPart2: Double; NewPart1, NewPart2: Double; H, P: Double; KoefPart: Double; AngleDegrees: Double; AngleRad: Double; dx, dy: Double; divPoint: TDoublePoint; begin try Result := DoublePoint(0, 0); if FIsRaiseUpDown then begin Result.x := TBGrpCP.x + (NewAP1.x - OldAP1.x); Result.y := TBGrpCP.y + (NewAP1.y - OldAP1.y); end else begin OldA := SQRT(SQR(OldAP1.x - OldAP2.x) + SQR(OldAP1.y - OldAP2.y)); if OldA = 0 then begin Result.x := DrawFigure.CenterPoint.x; Result.y := DrawFigure.CenterPoint.y; Exit; end; OldB := SQRT(SQR(OldAP1.x - TBGrpCP.x) + SQR(OldAP1.y - TBGrpCP.y)); if OldB < 0.00001 then OldB := 0; OldC := SQRT(SQR(OldAP2.x - TBGrpCP.x) + SQR(OldAP2.y - TBGrpCP.y)); if OldC < 0.00001 then OldC := 0; P := (OldA + OldB + OldC) / 2; if P < 0.00001 then P := 0; { try H := (2 * SQRT(P * (P - OldA) * (P - OldB) * (P - OldC))) / OldA; except H := 0; end; } H := aH; // if (H > OldB) or (H > OldC) then H := 0; OldPart1 := SQRT(SQR(OldB) - SQR(H)); OldPart2 := SQRT(SQR(OldC) - SQR(H)); ///////////////////////////////////// NewA := SQRT(SQR(NewAP1.x - NewAP2.x) + SQR(NewAP1.y - NewAP2.y)); KoefPart := NewA / OldA; NewPart1 := KoefPart * OldPart1; NewPart2 := KoefPart * OldPart2; NewB := SQRT(SQR(NewPart1) + SQR(H)); NewC := SQRT(SQR(NewPart2) + SQR(H)); // получить точку пересечения //Tolik //AngleDegrees := GetAngle(NewAP1.x, NewAP1.y, NewAP2.x, NewAP2.y); AngleDegrees := GetAngleDF(NewAP1.x, NewAP1.y, NewAP2.x, NewAP2.y); // // Tolik 22/10/2015 округление может сдвинуть угошку не туда if AngleDegrees >= 360 then AngleDegrees := AngleDegrees - 360; // AngleRad := AngleDegrees * pi / 180; dx := NewPart1 * Cos(AngleRad); dy := NewPart1 * Sin(AngleRad); divPoint.x := NewAP1.x + dx; divPoint.y := NewAP1.y + dy; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; // Tolik 22/10/2015 округление может сдвинуть угошку не туда if AngleDegrees >= 360 then begin AngleDegrees := AngleDegrees - 360; end; AngleRad := AngleDegrees * pi / 180; dx := H * Cos(AngleRad); dy := H * Sin(AngleRad); if (AngleDegrees >= 0) and (AngleDegrees < 180) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if FIsRotated then begin dx := -dx; dy := -dy; end; Result.x := divPoint.x + dx; Result.y := divPoint.y + dy; end; except Result.x := DrawFigure.CenterPoint.x; Result.y := DrawFigure.CenterPoint.y; // on E: Exception do addExceptionToLogEx('TOrthoLine.DrawFigureRemoveCalc', E.Message); end; end; function TOrthoLine.CalcHDrawFigure: Double; var A, B, C: Double; H, P: Double; KoefPart: Double; begin try A := SQRT(SQR(ActualPoints[1].x - ActualPoints[2].x) + SQR(ActualPoints[1].y - ActualPoints[2].y)); if A = 0 then begin Result := 0; Exit; end; B := SQRT(SQR(ActualPoints[1].x - DrawFigure.CenterPoint.x) + SQR(ActualPoints[1].y - DrawFigure.CenterPoint.y)); if B < 0.00001 then B := 0; C := SQRT(SQR(ActualPoints[2].x - DrawFigure.CenterPoint.x) + SQR(ActualPoints[2].y - DrawFigure.CenterPoint.y)); if C < 0.00001 then C := 0; P := (A + B + C) / 2; if P < 0.00001 then P := 0; // try H := (2 * SQRT(P * (P - A) * (P - B) * (P - C))) / A; except H := 0; end; Result := H; except Result := 0; // on E: Exception do addExceptionToLogEx('TOrthoLine.CalcHDrawFigure', E.Message); end; end; function TOrthoLine.CalcHCaptionsGroup: Double; var A, B, C: Double; H, P: Double; KoefPart: Double; begin try A := SQRT(SQR(ActualPoints[1].x - ActualPoints[2].x) + SQR(ActualPoints[1].y - ActualPoints[2].y)); if A = 0 then begin Result := 0; Exit; end; // Tolik -- 22/12/2016-- // if CaptionsGroup <> nil then if ((CaptionsGroup <> nil) and (tmpCaptionsGroup <> nil)) then begin if CaptionsGroup <> nil then B := SQRT(SQR(ActualPoints[1].x - CaptionsGroup.CenterPoint.x) + SQR(ActualPoints[1].y - CaptionsGroup.CenterPoint.y)) else B := SQRT(SQR(ActualPoints[1].x - tmpCaptionsGroup.CenterPoint.x) + SQR(ActualPoints[1].y - tmpCaptionsGroup.CenterPoint.y)); if B < 0.00001 then B := 0; if CaptionsGroup <> nil then C := SQRT(SQR(ActualPoints[2].x - CaptionsGroup.CenterPoint.x) + SQR(ActualPoints[2].y - CaptionsGroup.CenterPoint.y)) else C := SQRT(SQR(ActualPoints[2].x - tmpCaptionsGroup.CenterPoint.x) + SQR(ActualPoints[2].y - tmpCaptionsGroup.CenterPoint.y)); end else begin // Tolik -- 04/04/2017 -- if ((CaptionsGroup <> nil) and (tmpCaptionsGroup = nil)) then begin B := SQRT(SQR(ActualPoints[1].x - CaptionsGroup.CenterPoint.x) + SQR(ActualPoints[1].y - CaptionsGroup.CenterPoint.y)); if B < 0.00001 then B := 0; C := SQRT(SQR(ActualPoints[2].x - CaptionsGroup.CenterPoint.x) + SQR(ActualPoints[2].y - CaptionsGroup.CenterPoint.y)); end else begin // Result := 0; Exit; end; end; if C < 0.00001 then C := 0; P := (A + B + C) / 2; if P < 0.00001 then P := 0; // try H := (2 * SQRT(P * (P - A) * (P - B) * (P - C))) / A; except H := 0; end; Result := H; except Result := 0; // on E: Exception do addExceptionToLogEx('TOrthoLine.CalcHCaptionsGroup', E.Message); end; end; function TOrthoLine.GetBreakPointOnShadowTrace(P1, P2: TDoublePoint; aCtrl: Boolean): TDoublePoint; begin try // горизонталь - вертикаль if aCtrl then begin Result.x := P1.x; Result.y := P2.y; end else // вертикаль - горизонталь begin Result.x := P2.x; Result.y := P1.y; end; except on E: Exception do addExceptionToLogEx('TOrthoLine.GetBreakPointOnShadowTrace', E.Message); end; end; function TOrthoLine.ConnectorByNum(aNum: Integer): TConnectorObject; begin Result := nil; case aNum of 1: Result := TConnectorObject(JoinConnector1); // соединитель 1 2: Result := TConnectorObject(JoinConnector2); // соединитель 2 end; end; procedure TOrthoLine.SetNewLength(aVal: Double); var i: Integer; p1Idx, p2Idx: Integer; Conn1, Conn2: TConnectorObject; //MConn: TConnectorObject; // Move Connector //Conn: TConnectorObject; // Connector CurrPt, NewPt: TDoublepoint; dx, dy: Double; begin if FLineRaiseType = lrt_None then begin Conn1 := ConnectorByNum(1); Conn2 := ConnectorByNum(2); if Assigned(Conn1) = Assigned(Conn2) then if Conn1.ActualZOrder[1] = Conn2.ActualZOrder[1] then begin // Если вторая точка ближе к началу координат if GetLineLength(Conn2.ActualPoints[1], Doublepoint(0,0)) < GetLineLength(Conn1.ActualPoints[1], Doublepoint(0,0)) then ExchangeObjects(Conn1, Conn2); NewPt := MPoint(Conn2.ActualPoints[1], Conn1.ActualPoints[1], -1*(aVal-FLength) * 1000/TPowerCad(Owner).MapScale); //NewPt := MPoint(Conn2.ActualPoints[1], Conn1.ActualPoints[1], -1*(aVal-FLength)); CurrPt := Conn2.ActualPoints[1]; dx := NewPt.x - CurrPt.x; dy := NewPt.y - CurrPt.y; //Tolik //Conn2.Move(dx, dy); if Conn2.JoinedConnectorsList.Count = 0 then Conn2.Move(dx, dy) else begin for i := 0 to Conn2.JoinedConnectorsList.Count - 1 do begin if TConnectorObject(Conn2.JoinedConnectorsList[i]).ConnectorType = ct_NB then begin TConnectorObject(Conn2.JoinedConnectorsList[i]).Move(dx,dy); Break; //// BREAK ////; end; end; end; // if Assigned(TPowerCad(Owner).OnFigureMoved) then TPowerCad(Owner).OnFigureMoved(Owner, Self, dx, dy); end; end; end; procedure TConnectorObject.DeSelect; begin try inherited; //DeSelectSCSFigureInPM(ID); except on E: Exception do AddExceptionToLogEx('TConnectorObject.DeSelect', E.Message); end; end; constructor TFigureGrpMod.create(LHandle: Integer; aOwner: TComponent); begin try inherited; fFromApproach := nil; fFromHouse := nil; fRMode := false; fTraceMod := false; fHasParent := true; except on E: Exception do AddExceptionToLogEx('TFigureGrpMod.create', E.Message); end; end; function TFigureGrpMod.EndRotate(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean; var s: Integer; a1, a2, a: Double; isCreate: Boolean; begin try if (fFromApproach = nil) or (fFromHouse = nil) then exit; if mp.SeqNbr = 5 then begin RotPoint := TraceFigure.RotPoint; end else begin a1 := GetRadOfLine(rotPoint,DoublePoint(mp.CoordX ,mp.CoordY)); a2 := GetRadOfLine(rotPoint,DoublePoint(x,y)); a := a2-a1; s := sign(a); a := abs(a); if abs(a - 0) < (pi / 180) * 5 then a := 0; if abs(a - pi / 2) < (pi / 180) * 5 then a := pi / 2; if abs(a - 3 * (pi / 2)) < (pi / 180) * 5 then a := 3 * (pi / 2); if abs(a - pi) < (pi / 180) * 5 then a := pi; if abs(a - 2 * pi) < (pi / 180) * 5 then a := 2 * pi; Rotate(s * a, RotPoint); isCreate := True; { if not fFromHouse.IsPointInRegion(ap1.x, ap1.y) then isCreate := False; if not fFromHouse.IsPointInRegion(ap2.x, ap2.y) then isCreate := False; if not fFromHouse.IsPointInRegion(ap3.x, ap3.y) then isCreate := False; if not fFromHouse.IsPointInRegion(ap4.x, ap4.y) then isCreate := False; } //Tolik if not fFromHouse.IsPointInRegionByRegObj(ap1.x, ap1.y) then isCreate := False; if not fFromHouse.IsPointInRegionByRegObj(ap2.x, ap2.y) then isCreate := False; if not fFromHouse.IsPointInRegionByRegObj(ap3.x, ap3.y) then isCreate := False; if not fFromHouse.IsPointInRegionByRegObj(ap4.x, ap4.y) then isCreate := False; // if not isCreate then begin ShowMessage(cHouse_Mes1); Rotate(- s * a, RotPoint); end; end; rMode := false; fRMode := false; Deselect; except on E: Exception do AddExceptionToLogEx('TFigureGrpMod.EndRotate', E.Message); end; end; function TFigureGrpMod.TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var GRect: TDoubleRect; isTrace: Boolean; p1_in: boolean; p2_in: boolean; begin try if (fFromApproach = nil) or (fFromHouse = nil) then exit; If MP.SeqNbr in [3,4,5] then begin { p1_in := fFromHouse.IsPointInRegion(x,TraceFigure.ActualPoints[2].y); p2_in := fFromHouse.IsPointInRegion(x,TraceFigure.ActualPoints[3].y);} //Tolik p1_in := fFromHouse.IsPointInRegionByRegObj(x,TraceFigure.ActualPoints[2].y); p2_in := fFromHouse.IsPointInRegionByRegObj(x,TraceFigure.ActualPoints[3].y); // if p1_in and p2_in then begin TraceFigure.ActualPoints[2] := DoublePoint(x,TraceFigure.ActualPoints[2].y); TraceFigure.ActualPoints[3] := DoublePoint(x,TraceFigure.ActualPoints[3].y); end; end else if MP.SeqNbr in [1,8,7] then begin { p1_in := fFromHouse.IsPointInRegion(x,TraceFigure.ActualPoints[1].y); p2_in := fFromHouse.IsPointInRegion(x,TraceFigure.ActualPoints[4].y);} //Tolik p1_in := fFromHouse.IsPointInRegionByRegObj(x,TraceFigure.ActualPoints[1].y); p2_in := fFromHouse.IsPointInRegionByRegObj(x,TraceFigure.ActualPoints[4].y); // if p1_in and p2_in then begin TraceFigure.ActualPoints[1] := DoublePoint(x,TraceFigure.ActualPoints[1].y); TraceFigure.ActualPoints[4] := DoublePoint(x,TraceFigure.ActualPoints[4].y); end; end; If mp.SeqNbr in [1,2,3] then begin {p1_in := fFromHouse.IsPointInRegion(TraceFigure.ActualPoints[1].x,y); p2_in := fFromHouse.IsPointInRegion(TraceFigure.ActualPoints[2].x,y);} //Tolik p1_in := fFromHouse.IsPointInRegionByRegObj(TraceFigure.ActualPoints[1].x,y); p2_in := fFromHouse.IsPointInRegionByRegObj(TraceFigure.ActualPoints[2].x,y); // if p1_in and p2_in then begin TraceFigure.ActualPoints[1] := DoublePoint(TraceFigure.ActualPoints[1].x,y); TraceFigure.ActualPoints[2] := DoublePoint(TraceFigure.ActualPoints[2].x,y); end; end else if mp.SeqNbr in [5,6,7] then begin {p1_in := fFromHouse.IsPointInRegion(TraceFigure.ActualPoints[3].x,y); p2_in := fFromHouse.IsPointInRegion(TraceFigure.ActualPoints[4].x,y);} //Tolik p1_in := fFromHouse.IsPointInRegionByRegObj(TraceFigure.ActualPoints[3].x,y); p2_in := fFromHouse.IsPointInRegionByRegObj(TraceFigure.ActualPoints[4].x,y); // if p1_in and p2_in then begin TraceFigure.ActualPoints[3] := DoublePoint(TraceFigure.ActualPoints[3].x,y); TraceFigure.ActualPoints[4] := DoublePoint(TraceFigure.ActualPoints[4].x,y); end; end; except on E: Exception do AddExceptionToLogEx('TFigureGrpMod.TraceModification', E.Message); end; end; function TFigureGrpMod.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var Bnd: TDoubleRect; begin try if (fFromApproach = nil) or (fFromHouse = nil) then exit; inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); fTraceMod := False; Deselect; Bnd := GetBoundRect; fFromApproach.GrpSizeX := Bnd.Right - Bnd.Left; fFromApproach.GrpSizeY := Bnd.Bottom - Bnd.Top; fFromApproach.FOriginalSizeX := fFromApproach.GrpSizeX; fFromApproach.FOriginalSizeY := fFromApproach.GrpSizeY; fFromApproach.ActualPoints[1] := DoublePoint((Bnd.Left + Bnd.Right) / 2, (Bnd.Top + Bnd.Bottom) / 2); except on E: Exception do AddExceptionToLogEx('TFigureGrpMod.EndModification', E.Message); end; end; procedure TFigureGrpMod.move(deltax, deltay: double); begin try inherited; except on E: Exception do AddExceptionToLogEx('TFigureGrpMod.move', E.Message); end; end; function TConnectorObject.IsApproachInHouse(adeltax, adeltay: double): Boolean; var isMove: boolean; p1, p2, p3, p4: TDoublePoint; begin try isMove := True; if DrawFigure <> nil then begin p1 := DoublePoint(ActualPoints[1].x - GrpSizeX / 2, ActualPoints[1].y - GrpSizeY / 2); p2 := DoublePoint(ActualPoints[1].x + GrpSizeX / 2, ActualPoints[1].y - GrpSizeY / 2); p3 := DoublePoint(ActualPoints[1].x + GrpSizeX / 2, ActualPoints[1].y + GrpSizeY / 2); p4 := DoublePoint(ActualPoints[1].x - GrpSizeX / 2, ActualPoints[1].y + GrpSizeY / 2); end else begin p1 := ActualPoints[1]; p2 := ActualPoints[1]; p3 := ActualPoints[1]; p4 := ActualPoints[1]; end; { if not fHouse.IsPointInRegion(p1.x + adeltax, p1.y + adeltay) then isMove := False; if not fHouse.IsPointInRegion(p2.x + adeltax, p2.y + adeltay) then isMove := False; if not fHouse.IsPointInRegion(p3.x + adeltax, p3.y + adeltay) then isMove := False; if not fHouse.IsPointInRegion(p4.x + adeltax, p4.y + adeltay) then isMove := False;} //Tolik if not fHouse.IsPointInRegionByRegObj(p1.x + adeltax, p1.y + adeltay) then isMove := False; if not fHouse.IsPointInRegionByRegObj(p2.x + adeltax, p2.y + adeltay) then isMove := False; if not fHouse.IsPointInRegionByRegObj(p3.x + adeltax, p3.y + adeltay) then isMove := False; if not fHouse.IsPointInRegionByRegObj(p4.x + adeltax, p4.y + adeltay) then isMove := False; // Result := isMove; except on E: Exception do AddExceptionToLogEx('TConnectorObject.IsApproachInHouse', E.Message); end; end; procedure TConnectorObject.RotateByParams(aAngleRad: Double; aPoint: TDoublePoint); var PointObject: TConnectorObject; //AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; DrawFigureAngle: Double; SavedPtCount: Integer; begin PointObject := Self; AngleDeg := RadToDeg(aAngleRad); if (AngleDeg > 360) or (AngleDeg < 0) then begin AngleDeg := CorrectAngle(AngleDeg); aAngleRad := DegToRad(AngleDeg); end; if CheckTrunkObject(PointObject) then begin RotateTrunkObject(PointObject, AngleDeg); Exit; end; //AngleRad := Angle / 180 * pi; SavedPtCount := PointCount; PointCount := 1; try PointObject.Rotate(aAngleRad, aPoint); finally PointCount := SavedPtCount; end; PointObject.DrawFigure.Rotate(aAngleRad, aPoint); // PointObject.CenterPoint PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + aAngleRad; if PointObject.FDrawFigureAngle >= 2 * pi then PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi; // Корректируем угол если не в 0..360 DrawFigureAngle := RadToDeg(PointObject.FDrawFigureAngle); if (DrawFigureAngle > 360) or (DrawFigureAngle < 0) then begin DrawFigureAngle := CorrectAngle(DrawFigureAngle); PointObject.FDrawFigureAngle := DegToRad(DrawFigureAngle); end; // Tolik -- //Bnd := PointObject.DrawFigure.GetBoundRect; Bnd := PointObject.DrawFigure.GetBoundRectWithoutAutoCreatedFigures; // PointObject.GrpSizeX := Bnd.Right - Bnd.Left; PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // // Если не modFigure в режиме вращения if Not FIsRotating then begin {CurrCaptionAngle := 0; //#From Oleg# //14.09.2010 if PointObject.FCaptionsViewType = cv_Right then CurrCaptionAngle := 0; if PointObject.FCaptionsViewType = cv_Down then CurrCaptionAngle := 90; if PointObject.FCaptionsViewType = cv_Left then CurrCaptionAngle := 180; if PointObject.FCaptionsViewType = cv_Up then CurrCaptionAngle := 270; CurrCaptionAngle := CurrCaptionAngle + Angle; CurrCaptionAngle := round(CurrCaptionAngle) mod 360;} if (AngleDeg >= 0) and (AngleDeg <= 45) then PointObject.FCaptionsViewType := cv_Right else if (AngleDeg > 45) and (AngleDeg < 135) then PointObject.FCaptionsViewType := cv_Down else if (AngleDeg >= 135) and (AngleDeg <= 225) then PointObject.FCaptionsViewType := cv_Left else if (AngleDeg > 225) and (AngleDeg < 315) then PointObject.FCaptionsViewType := cv_Up else if (AngleDeg >= 315) and (AngleDeg <= 360) then PointObject.FCaptionsViewType := cv_Right; Self.DefRaizeDrawFigurePos; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end; end; procedure TConnectorObject.DefRaizeDrawFigurePos; var RaiseLine: TOrthoLine; deltax, deltay: Double; BlockBnd: TDoubleRect; DrawFigureBnd: TDoubleRect; DrawFigureKoeff: Double; BasisPoint, CrossPoint1, CrossPoint2: TDoublePoint; begin RaiseLine := GetRaiseLine(Self); if RaiseLine <> nil then begin if not RaiseLine.Deleted then //Tolik 27/11/2020 -- begin if RaiseLine.FSingleBlock.InFigures.Count = 0 then begin BlockBnd := RaiseLine.FSingleBlock.GetBoundRect; end else begin BlockBnd := TFigure(RaiseLine.FSingleBlock.InFigures[0]).GetBoundRect; end; DrawFigureBnd := RaiseLine.DrawFigure.GetBoundRect; DrawFigureKoeff := RaiseLine.FDrawFigurePercent/100; // GetRaiseConn(Self).FObjectFromRaise if RaiseLine.FObjectFromRaisedLine <> nil then begin BasisPoint := GetBasisPointByObjFromRaise(RaiseLine.FObjectFromRaisedLine); //if FObjectFromRaisedLine.DrawFigure.InFigures.Count > 0 then begin BasisPoint.x := BasisPoint.x - 1; BasisPoint.y := BasisPoint.y + 1; end; end else begin BasisPoint.x := (RaiseLine.ActualPoints[1].x + RaiseLine.ActualPoints[2].x) / 2; BasisPoint.y := (RaiseLine.ActualPoints[1].y + RaiseLine.ActualPoints[2].y) / 2; end; CrossPoint1.x := BasisPoint.x; CrossPoint1.y := BasisPoint.y; //CrossPoint2.x := BasisPoint.x + Round(4*DrawFigureKoeff); //CrossPoint2.y := BasisPoint.y - Round(4*DrawFigureKoeff); CrossPoint2.x := BasisPoint.x + Round4(4 * DrawFigureKoeff); CrossPoint2.y := BasisPoint.y - Round4(4 * DrawFigureKoeff); RaiseLine.DrawFigure.ActualPoints[1] := DoublePoint((DrawFigureBnd.Left + DrawFigureBnd.Right) / 2, (BlockBnd.Top + BlockBnd.Bottom) / 2); deltax := BasisPoint.x - RaiseLine.DrawFigure.ActualPoints[1].x; deltay := BasisPoint.y - RaiseLine.DrawFigure.ActualPoints[1].y; deltax := deltax + 2.7 * DrawFigureKoeff; deltay := deltay - 2.7 * DrawFigureKoeff; //FDrawFigure := TFigureGrpMod(GCadForm.PCad.AddCustomFigure (GLN(LayerHandle), DrawFigure, False)); RaiseLine.DrawFigure.move(deltax, deltay); //RaiseLine.DrawFigure.LockModify := True; //RaiseLine.MoveTextBox(RaiseLine.DrawFigure, CrossPoint1, CrossPoint2, True); end; end; end; {Procedure TConnectorObject.Rotate(aAngle: Double; cPoint: TDoublePoint); var Bnd: TDoubleRect; DrawFigureAngle: Double; PointObject: TConnectorObject; begin inherited; PointObject := Self; PointObject.DrawFigure.Rotate(aAngle, cPoint); // PointObject.CenterPoint PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + aAngle; if PointObject.FDrawFigureAngle >= 2 * pi then PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi; // Корректируем угол если не в 0..360 DrawFigureAngle := RadToDeg(PointObject.FDrawFigureAngle); if (DrawFigureAngle > 360) or (DrawFigureAngle < 0) then begin DrawFigureAngle := CorrectAngle(DrawFigureAngle); PointObject.FDrawFigureAngle := DegToRad(DrawFigureAngle); end; Bnd := PointObject.DrawFigure.GetBoundRect; PointObject.GrpSizeX := Bnd.Right - Bnd.Left; PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top; end;} procedure TSCSFigureGrp.getboundsWithOutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: double); begin getbounds(figMaxX, figMaxY, figMinX, figMinY); end; { TCabinetExt } constructor TCabinetExt.create(Points: TDoublePointArr; w, s, c, abrs, abrc: integer; row: integer; aClosed: Boolean; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent); var p: TDoublePoint; begin try Inherited; FSCSID := -1; FIndex := -1; FType := ct_Virtual; FNumberObject := nil; FNumberObjectIndex := -1; //Tolik FCabinetSquare := -1; // Visible := False; if aDrawStyle <> dsTrace then TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; CabinetConfig.aWorkRoom := true; cabinetconfig.POintCount := Self.PointCount; CabinetConfig.NumRadius := 3; except on E: Exception do AddExceptionToLogEx('TCabinetExt.create', E.Message); end; end; class function TCabinetExt.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var ObjParams: TObjectParams; GetSCSID, GetIndex: Integer; points: TDoublePointArr; a: integer; cad: TPCDrawing; begin try // создание с тулсы на панели КАД Result := nil; if Shadow.PointCount < 4 then exit; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; SetLength(points,Shadow.PointCount-2); for a := 1 to Shadow.PointCount - 2 do points[a - 1] := Shadow.ActualPoints[a]; cad := TPCDrawing(aOwner); Result := TCabinetExt.create(points, 2, ord(psSolid), clMaroon, ord(bsClear), clBlack, 0, true, LHandle, mydsNormal, aOwner); TCabinetExt(Result).FType := ct_Visual; ObjParams := CreateRoomFromCADToPM(GCadForm.FCADListID); GetSCSID := ObjParams.ID; GetIndex := ObjParams.MarkID; TCabinetExt(Result).FSCSID := GetSCSID; TCabinetExt(Result).ID := GetSCSID; //08.11.2011 TCabinetExt(Result).FIndex := GetIndex; TCabinetExt(Result).FNumberObject := CreateNumberObjectOnCAD(TCabinetExt(Result), GCadForm.FShowCabinetsNumbers); TCabinetExt(Result).FNumberObject.IsCabinetExt := True; TCabinetExt(Result).FNumberObject.FPositionIndex := 1; TCabinetExt(Result).FNumberObject.CircleRadius := 3; //Tolik TCabinetExt(Result).FCabinetSquare := -1; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), Result, False); GCadForm.AddSCSFigure(Result); //08.11.2011 MoveObjectsToCabinetOnCreate(TCabinetExt(Result)); if GCadForm.FShowCabinetsBounds then TCabinetExt(Result).Visible := True; Result := nil; // *UNDO* GCadForm.FCanSaveForUndo := True; TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; //Tolik SetLength(points,0); // except on E: Exception do AddExceptionToLogEx('TCabinetExt.CreateFromShadow', E.Message); end; end; procedure TCabinetExt.Delete; var AFigure: TFigure; j: Integer; begin try if not Self.Deleted then begin if Owner <> nil then //08.11.2011 TF_CAD(TPowerCad(Owner).Owner).RemoveSCSFigure(Self); Deleted := True; // Tolik //GCadForm.FRemFigures.Add(Self); TF_CAD(TPowerCad(Owner).Owner).FRemFigures.Add(Self); // if FNumberObject <> nil then FNumberObject.Delete; //Проверка фигуры на вхождение в кабинет GCadForm.UpdateCheckedFigures; for j := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[j]); GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; end; except on E: Exception do addExceptionToLogEx('TCabinetExt.Delete', E.Message); end; end; procedure TCabinetExt.Draw(DEngine: TPCDrawEngine; isFlue: Boolean); var CabCP: TDoublePoint; CabCP2: TDoublePoint; ConnPoint: TDoublePoint; aHRGN: HRGN; aFont: TFont; SCSList: TSCSList; RoomObject: TSCSCatalog; aText: string; xCanvas: TMetafileCanvas; h, w: double; aFontSize: integer; aFontName: string; MaxX, MaxY, MinX, MinY: Double; begin try if fType = ct_Visual then if Visible then begin aText := ''; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(Owner).Owner).FCADListID); if SCSList <> nil then begin RoomObject := SCSList.GetCatalogFromReferencesBySCSID(self.FSCSID); if RoomObject <> nil then aText := RoomObject.NameShort; end; if (aText <> '')and(CabinetConfig.CabinetSignPos <> 0) then begin aFont := TFont.Create; aFont.Name := TF_CAD(TPowerCad(Owner).Owner).PCad.Font.Name; //TF_CAD(TPowerCad(Owner).Owner).Font.Name; aFont.Size := 10; aFont.color := clMaroon; //clBlack; aFontSize := aFont.Size; aFontName := aFont.Name; GetTextSize(aFontSize, [], aFontName, aText, nil, h, w); ConnPOint := Self.ActualPoints[CabinetConfig.CabinetSignPos]; CabCP := ConnPOint; Self.getbounds(MaxX, MaxY, MinX, MinY); {CabCP2.x := CabCP.x + w; CabCP2.y := CabCP.y - h/2; } if CabCP.x = MaxX then begin CabCP2.x := CabCP.x - w; end else begin CabCP2.x := CabCP.x + w; end; if ((CabCP.y - h/2) nil then // begin // getbounds(MaxX, MaxY, MinX, MinY); // CP.x := (MinX + MaxX) / 2; // CP.y := (MinY + MaxY) / 2; // FNumberObject.move(CP.x - FNumberObject.CenterPoint.x, CP.y - FNumberObject.CenterPoint.y); // end; CenterNumberObject; MoveObjectsToCabinetOnMove(Self); except on E: Exception do addExceptionToLogEx('TCabinet.EndModification', E.Message); end; end; function TCabinetExt.isPointIn(x, y: Double): boolean; var a : integer; lp: Integer; begin try result := false; if closed then lp := PointCount else lp := pointcount-1; For a := 1 to lp do begin if IsPointInSegment(a, x, y) then begin result := true; SelectedPoint := a; exit; end; end; except on E: Exception do AddExceptionToLogEx('TCabinetExt.isPointIn', E.Message); end; end; function TCabinetExt.isPointInMod(x, y: Double): boolean; var i, count: Integer; points: TDoublePointArr; begin try Result := false; {if IsPointInRegion(x, y) then result := true;} //Tolik result := IsPointInRegionByRegObj(x, y); // if not Result then begin count := Length(actuals); SetLength(points, count); for i := 0 to count - 1 do points[i] := ActualPoints[i + 1]; if PtInPolygon(Points, DoublePoint(x, y)) then result := true; end; //Tolik SetLength(points, 0); // except on E: Exception do AddExceptionToLogEx('TCabinetExt.isPointInMod', E.Message); end; end; procedure TCabinetExt.Move(deltax, deltay: Double); begin try inherited; if FNumberObject <> nil then if not FNumberObject.Selected then FNumberObject.move(deltax, deltay); MoveObjectsToCabinetOnMove(Self); except on E: Exception do AddExceptionToLogEx('TCabinetExt.Move', E.Message); end; end; procedure TCabinetExt.RaiseProperties(CadFigList: TList); var LHandle9: Integer; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else //Tolik // FiguresList := GCadForm.PCad.Figures; FiguresList := CadFigList; // if FNumberObjectIndex = - 1 then FNumberObject := Nil else begin FNumberObject := TCabinetNumber(FiguresList.Items[FNumberObjectIndex]); FNumberObject.Visible := CabinetConfig.AworkRoom; FNumberObject.CircleRadius := CabinetConfig.NumRadius; FNumberObject.IsCabinetExt := True; FNumberObject.FPositionIndex := CabinetConfig.CabinetNumPos; end; Visible := False; // если на старом слое - перенести на новый LHandle9 := GCadForm.PCad.GetLayerHandle(9); if LayerHandle <> LHandle9 then begin LayerHandle := LHandle9; if FNumberObject <> nil then FNumberObject.LayerHandle := LHandle9; end; except on E: Exception do addExceptionToLogEx('TCabinet.RaiseProperties', E.Message); end; end; procedure TCabinetExt.select; begin try if fType = ct_Visual then if Visible then inherited; except on E: Exception do AddExceptionToLogEx('TCabinetExt.select', E.Message); end; end; procedure TCabinetExt.SetPropertyFromStream(xCode: Byte; data: Pointer; size: Integer); var xInt: Integer; xBool: Boolean; xDbl: Double; begin try inherited; case xCode of 30: begin xInt := pInt(data)^; FSCSID := xInt; FFalseFloorHeight := GCadForm.FFalseFloorHeight; ID := xInt; //08.11.2011 if ID <> 0 then //08.11.2011 TF_CAD(TPowerCad(Owner).Owner).AddSCSFigure(Self); end; 31: begin xInt := pInt(data)^; FIndex := xInt; end; 32: begin xInt := pInt(data)^; FType := TCabinetType(xInt); end; 33: begin xInt := pInt(data)^; FNumberObjectIndex := xInt; end; 230:begin xDbl := pDouble(data)^; FFalseFloorHeight := xDbl; end; 240:begin CabinetConfig := PRoomConfig(data)^; end; 241:begin xDbl := pDouble(data)^; FCabinetSquare := xDbl; end; end; TF_CAD(TPowerCad(Owner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TCabinetExt.SetPropertyFromStream', E.Message); end; end; procedure TCabinetExt.WriteToStream(Stream: TStream); var xInt: Integer; xBool: Boolean; xDbl: Double; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; inherited; xInt := FSCSID; WriteField(30, Stream, xInt, sizeof(xInt)); xInt := FIndex; WriteField(31, Stream, xInt, sizeof(xInt)); xInt := Ord(FType); WriteField(32, Stream, xInt, sizeof(xInt)); if FNumberObject <> nil then begin xInt := FiguresList.IndexOf(FNumberObject); WriteField(33, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(33, Stream, xInt, sizeof(xInt)); end; xDbl := FFalseFloorHeight; WriteField(230, Stream, xDbl, sizeof(xDbl)); WriteField(240, Stream, CabinetConfig, sizeof(CabinetConfig)); //Tolik WriteField(241, Stream, FCabinetSquare, sizeof(FCabinetSquare)); // except on E: Exception do addExceptionToLogEx('TCabinetExt.WriteToStream', E.Message); end; end; procedure TCabinetExt.Initialize; begin inherited; FClassIndex := ciCabinetExt; CabinetConfig.aWorkRoom := true; cabinetconfig.IsCabinetExt := True; cabinetconfig.POintCount := Self.PointCount; CabinetConfig.CabinetNumPos := 1; CabinetConfig.CabinetSignPos := 0; CabinetConfig.NumRadius := 3; FCabinetSquare := -1; end; procedure TCabinetExt.CenterNumberObject; var CP: TDoublePoint; MaxX, MaxY, MinX, MinY: Double; begin if FNumberObject <> nil then begin getbounds(MaxX, MaxY, MinX, MinY); CP.x := (MinX + MaxX) / 2; CP.y := (MinY + MaxY) / 2; FNumberObject.move(CP.x - FNumberObject.CenterPoint.x, CP.y - FNumberObject.CenterPoint.y); end; end; procedure TOrthoLine.DrawVertical(ADEngine: TPCDrawEngine); var CrossPoint1, CrossPoint2: TDoublePoint; BasisPoints: TDoublePoint; Points: TDoublePointArr; PenStyle: TPenStyle; RaiseLine: TOrthoLine; isDrawRaise: Boolean; GetConn: TConnectorObject; begin try ADEngine.Canvas.Brush.Color := clMaroon; ADEngine.Canvas.Brush.Style := bsClear; PenStyle := ADEngine.Canvas.Pen.Style; ADEngine.Canvas.Pen.Style := psSolid; ADEngine.Canvas.Pen.Color := clMaroon; ADEngine.Canvas.Pen.Width := 2; if JoinConnector1 <> nil then begin if TConnectorObject(JoinConnector1).JoinedConnectorsList.Count = 0 then GetConn := TConnectorObject(JoinConnector1) else GetConn := TConnectorObject(TConnectorObject(JoinConnector1).JoinedConnectorsList[0]); BasisPoints.x := GetConn.ActualPoints[1].x; BasisPoints.y := GetConn.ActualPoints[1].y; end else begin BasisPoints.x := ActualPoints[1].x; BasisPoints.y := ActualPoints[1].y; end; { // СТРЕЛКАМИ ------------------ CrossPoint1.x := BasisPoints.x; CrossPoint1.y := BasisPoints.y; CrossPoint2.x := BasisPoints.x + 4; CrossPoint2.y := BasisPoints.y - 4; ADEngine.drawline(CrossPoint1, CrossPoint2); SetLength(Points, 4); Points[0] := DoublePoint(BasisPoints.x + 2, BasisPoints.y - 3); Points[1] := DoublePoint(BasisPoints.x + 4, BasisPoints.y - 4); Points[2] := DoublePoint(BasisPoints.x + 3, BasisPoints.y - 2); Points[3] := DoublePoint(BasisPoints.x + 2, BasisPoints.y - 3); ADEngine.drawpolyline(Points, True); BasisPoints.x := BasisPoints.x + 1; BasisPoints.y := BasisPoints.y + 0; CrossPoint1.x := BasisPoints.x; CrossPoint1.y := BasisPoints.y; CrossPoint2.x := BasisPoints.x + 4; CrossPoint2.y := BasisPoints.y - 4; ADEngine.drawline(CrossPoint1, CrossPoint2); SetLength(Points, 4); Points[0] := DoublePoint(BasisPoints.x + 1, BasisPoints.y - 2); Points[1] := DoublePoint(BasisPoints.x, BasisPoints.y); Points[2] := DoublePoint(BasisPoints.x + 2, BasisPoints.y - 1); Points[3] := DoublePoint(BasisPoints.x + 1, BasisPoints.y - 2); ADEngine.drawpolyline(Points, True); } ADEngine.DrawCircle(BasisPoints, 1); CrossPoint1 := DoublePoint(BasisPoints.x, BasisPoints.y - 0.6); CrossPoint2 := DoublePoint(BasisPoints.x, BasisPoints.y + 0.6); ADEngine.drawline(CrossPoint1, CrossPoint2); CrossPoint1 := DoublePoint(BasisPoints.x - 0.6, BasisPoints.y); CrossPoint2 := DoublePoint(BasisPoints.x + 0.6, BasisPoints.y); ADEngine.drawline(CrossPoint1, CrossPoint2); ADEngine.Canvas.Pen.Style := PenStyle; except on E: Exception do AddExceptionToLogEx('TOrthoLine.DrawVertical', E.Message); end; end; { TBetweenFloorDownVertex } class function TBetweenFloorDownVertex.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var CAD: TF_CAD; //ListParams: TListParams; RaiseOnFigure, RaiseConn, RaiseConnPassage: TConnectorObject; SavedFlag: Boolean; ListToPassage: TF_CAD; SelectedFigure: TFigure; i: Integer; SCSList: TSCSList; SCSCatalog: TSCSCatalog; SCSTopCompon: TSCSComponent; PassCompons: TSCSComponents; DefSelId: Integer; begin CAD := TF_CAD(TPowerCad(aOwner).Owner); //ListParams := GetListParams(CAD.FCADListID); RaiseOnFigure := CAD.CreateConnForFloorRaise(shadow.ap1.x, shadow.ap1.y, CAD.FLineHeight, LHandle); GPopupFigure := RaiseOnFigure; SavedFlag := ShowCreateRaiseQuery; ShowCreateRaiseQuery := false; try FSCS_Main.aCreateFloorRaiseDown.Execute; // После предлогаеи подключится к ТО RaiseConn := GetRaiseConn(RaiseOnFigure); if RaiseConn <> nil then begin ListToPassage := GetListByID(RaiseConn.FID_ListToPassage); RaiseConnPassage := TConnectorObject(GetFigureByID(ListToPassage, RaiseConn.FID_ConnToPassage)); if RaiseConnPassage <> nil then begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(RaiseConn.FID_ListToPassage); if SCSList <> nil then begin PassCompons := TSCSComponents.Create(false); DefSelId := 0; for i := 0 to SCSList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := SCSList.ChildCatalogReferences[i]; if SCSCatalog.ItemType = itSCSConnector then if SCSCatalog.SCSComponents.Count > 0 then begin SCSTopCompon := SCSCatalog.SCSComponents[0]; PassCompons.Add(SCSTopCompon); if DefSelId = 0 then if SCSTopCompon.ComponentType.SysName = ctsnCupBoard then DefSelId := SCSTopCompon.ID; end; end; if PassCompons.Count > 0 then begin ListToPassage.BringToFront; //F_ProjMan.F_InputBox.SelectComponentFromList('qqqq', PassCompons); SCSTopCompon := F_ProjMan.SelectComponentFromList(PassCompons, '', cCadClasses_Mes35_1, cCadClasses_Mes35_2, '', 0, [], nil, nil, DefSelId); if SCSTopCompon <> nil then begin SCSCatalog := SCSTopCompon.GetFirstParentCatalog; if SCSCatalog <> nil then begin SelectedFigure := GetFigureByID(ListToPassage, SCSCatalog.SCSID); if (SelectedFigure <> nil) and (SelectedFigure is TConnectorObject) then begin GCadForm := ListToPassage; try GCadForm.PCad.DeselectAll(0); //SelectedFigure.Select; //RaiseConnPassage.Select; CreateTraceByConnectors(GCadForm, TConnectorObject(SelectedFigure), RaiseConnPassage.FObjectFromRaise); //AutoCreateTraces; FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(SelectedFigure)); finally GCadForm := CAD; end; end; end; end; CAD.BringToFront; end; FreeAndNil(PassCompons); end; end; end; finally ShowCreateRaiseQuery := SavedFlag; GPopupFigure := nil; end; Result := nil; end; { TBetweenFloorUpVertex } class function TBetweenFloorUpVertex.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var CAD: TF_CAD; //ListParams: TListParams; RaiseOnFigure, RaiseConn, RaiseConnPassage: TConnectorObject; SavedFlag: Boolean; IDFloorDown: Integer; ListDown: TF_CAD; ListToPassage: TF_CAD; SelectedFigure, SelFigureToPassage: TFigure; JoinComponOtherFigure: TFigure; JoinFigPoint: TDoublePoint; i: Integer; SCSList, SCSListToPassage: TSCSList; SCSCatalog, SCSCatalogToPassage: TSCSCatalog; JoinCompon, JoinComponOther: TSCSComponent; IDIdx: Integer; // Tolik ComponId: Integer; PointFigure : TFigure; // function SelectListJoinCompon(aList: TSCSList; const aCaption, aMsg: String; aSelId: Integer=0): TSCSComponent; var Compons: TSCSComponents; SCSTopCompon: TSCSComponent; DefSelId: Integer; i: Integer; begin Result := nil; Compons := TSCSComponents.Create(false); DefSelId := aSelId; for i := 0 to SCSList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := SCSList.ChildCatalogReferences[i]; if SCSCatalog.ItemType = itSCSConnector then if SCSCatalog.SCSComponents.Count > 0 then begin SCSTopCompon := SCSCatalog.SCSComponents[0]; if IsComunicationComponEx(SCSTopCompon) then begin Compons.Add(SCSTopCompon); if DefSelId = 0 then if SCSTopCompon.ComponentType.SysName = ctsnCupBoard then DefSelId := SCSTopCompon.ID; end; end; end; if Compons.Count > 0 then Result := F_ProjMan.SelectComponentFromList(Compons, '', aCaption, aMsg, '', 0, [], nil, nil, DefSelId); FreeAndNil(Compons); end; begin CAD := TF_CAD(TPowerCad(aOwner).Owner); {IDFloorDown := GetListIDForCreatePassage(GCadForm.FCADListID, 1); if IDFloorDown <> 0 then begin ListDown := GetListByID(IDFloorDown); if ListDown <> nil then begin GCadForm := ListDown; SavedFlag := ShowCreateRaiseQuery; ShowCreateRaiseQuery := false; try ListDown.BringToFront; RaiseOnFigure := ListDown.CreateConnForFloorRaise(shadow.ap1.x, shadow.ap1.y, ListDown.FLineHeight, LHandle); GPopupFigure := RaiseOnFigure; FSCS_Main.aCreateFloorRaiseUp.Execute; finally ShowCreateRaiseQuery := SavedFlag; GPopupFigure := nil; GCadForm := CAD; GCadForm.BringToFront; end; end; end;} RaiseOnFigure := CAD.CreateConnForFloorRaise(shadow.ap1.x, shadow.ap1.y, CAD.FLineHeight, LHandle); GPopupFigure := RaiseOnFigure; SavedFlag := ShowCreateRaiseQuery; ShowCreateRaiseQuery := false; try FSCS_Main.aCreateFloorRaiseUp.Execute; // После предлогаеи подключится к ТО RaiseConn := GetRaiseConn(RaiseOnFigure); if RaiseConn <> nil then begin ListToPassage := GetListByID(RaiseConn.FID_ListToPassage); SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(CAD.FCADListID); if SCSList <> nil then begin JoinCompon := SelectListJoinCompon(SCSList, cCadClasses_Mes35_1, cCadClasses_Mes35_2); if JoinCompon <> nil then begin SCSCatalog := JoinCompon.GetFirstParentCatalog; if SCSCatalog <> nil then begin SelectedFigure := GetFigureByID(CAD, SCSCatalog.SCSID); if (SelectedFigure <> nil) and (SelectedFigure is TConnectorObject) then begin GCadForm.PCad.DeselectAll(0); //SelectedFigure.Select; //RaiseConnPassage.Select; CreateTraceByConnectors(GCadForm, TConnectorObject(SelectedFigure), RaiseOnFigure, true); //AutoCreateTraces; FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(SelectedFigure)); //04.07.2013 - ищем такой же объект на верхнем листе (если єто біла копия, то он есть на ней) if ListToPassage <> nil then begin RaiseConnPassage := TConnectorObject(GetFigureByID(ListToPassage, RaiseConn.FID_ConnToPassage)); if RaiseConnPassage <> nil then begin SCSListToPassage := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(ListToPassage.FCADListID); if SCSListToPassage <> nil then begin IDIdx := -1; if SCSListToPassage.FObjIDsBeforeCopy <> nil then IDIdx := SCSListToPassage.FObjIDsBeforeCopy.IndexOf(SCSCatalog.ID); if IDIdx <> -1 then begin SCSCatalogToPassage := SCSListToPassage.GetCatalogFromReferences(SCSListToPassage.FObjIDsAfterCopy[IDIdx]); if SCSCatalogToPassage <> nil then begin SelFigureToPassage := GetFigureByID(ListToPassage, SCSCatalogToPassage.SCSID); ListToPassage.BringToFront; if GCadForm = ListToPassage then begin CreateTraceByConnectors(ListToPassage, TConnectorObject(SelFigureToPassage), RaiseConnPassage.FObjectFromRaise, true); end; end; end else begin {//08.07.2013 ListToPassage.BringToFront; if GCadForm = ListToPassage then begin SelFigureToPassage := ListToPassage.CreateConnector(SelectedFigure.ap1.x, SelectedFigure.ap1.y, CAD.FLineHeight, ListToPassage.PCad.GetLayerHandle(lnSCSCommon), ct_Clear, cCadClasses_Mes12); if SelFigureToPassage <> nil then CreateTraceByConnectors(ListToPassage, TConnectorObject(SelFigureToPassage), RaiseConnPassage.FObjectFromRaise); end;} //08.07.2013 - выбор объекта для создания на новом листе, чтобы подключить к нему м-э JoinFigPoint := SelectedFigure.ap1; // сначала координаты по выбраному объекту на исходном листе JoinComponOther := SelectListJoinCompon(SCSList, cCadClasses_Mes35_1_1, cCadClasses_Mes35_3, JoinCompon.ID); {JoinComponOtherFigure := nil; if JoinComponOther <> nil then begin JoinComponOtherFigure := GetFigureByID(CAD, JoinComponOther.GetFirstParentCatalog.SCSID); if JoinComponOtherFigure <> nil then JoinFigPoint := JoinComponOtherFigure.ap1; end;} ListToPassage.BringToFront; if GCadForm = ListToPassage then begin if JoinComponOther <> nil then // Tolik 11/05/2018 -- begin // Tolik -- 06/12/2017 -- не с того листа взяты настройки (высота размещения линий) //SelFigureToPassage := ListToPassage.CreateConnector(JoinFigPoint.x, JoinFigPoint.y, CAD.FLineHeight, ListToPassage.PCad.GetLayerHandle(lnSCSCommon), ct_Clear, cCadClasses_Mes12); SelFigureToPassage := ListToPassage.CreateConnector(JoinFigPoint.x, JoinFigPoint.y, ListToPassage.FLineHeight, ListToPassage.PCad.GetLayerHandle(lnSCSCommon), ct_Clear, cCadClasses_Mes12); if SelFigureToPassage <> nil then begin if JoinComponOther <> nil then begin SCSCatalogToPassage := SCSListToPassage.GetCatalogFromReferencesBySCSID(SelFigureToPassage.ID); if SCSCatalogToPassage <> nil then begin RefreshCAD(ListToPassage.PCad); // Tolik -- 22/09/2016 -- CopyComponentToPMSCSObject(JoinComponOther, SCSCatalogToPassage, true); PointFigure := GetFigureByID(GCadForm, SCSCatalogToPassage.SCSId); // ComponId := CopyComponentToSCSObject(JoinComponOther.ID, SCSCatalogToPassage.ID, False); // end; end; CreateTraceByConnectors(ListToPassage, TConnectorObject(SelFigureToPassage), RaiseConnPassage.FObjectFromRaise, true); end; end; end; end; end; end; end; end; end; end; end; if ListToPassage <> nil then ListToPassage.BringToFront; end; finally ShowCreateRaiseQuery := SavedFlag; GPopupFigure := nil; end; Result := nil; end; //======================07.11.2013 самыков================================== procedure TConnectorObject.SetIsSnap(const Value: Boolean); begin if FisSnap = Value then exit; FisSnap := Value; if Value then Draw(GCadForm.PCad.DEngine, false) else begin FFindSnapEnable := true; //if (GCadForm.PCad.Selection <> nil) and (GCadForm.PCad.Selection.Count > 0) and (GCadForm.PCad.Selection[0] <> nil) // and (TConnectorObject(GCadForm.PCad.Selection[0]).FindSnapTimer <> nil) // and (TConnectorObject(GCadForm.PCad.Selection[0]).FindSnapTimer.tag = 1) //then // GCadForm.PCad.FirstDrag:=false; GCadForm.PCad.Refresh; if (CheckFigureByClassName(GCadForm.PCad.TraceFigure, 'TOrthoLine')) then GCadForm.PCad.TraceFigure.NotNeedToDraw := True; GCadForm.PCad._DrawTrace; //для отрисовки новой trace shadow if (CheckFigureByClassName(GCadForm.PCad.TraceFigure, 'TOrthoLine')) then GCadForm.PCad.TraceFigure.NotNeedToDraw := false; end; end; procedure TOrthoLine.SetIsSnap(const Value: Boolean); begin if FisSnap=Value then exit; FisSnap := Value; if Value then Draw(GCadForm.PCad.DEngine, false) else begin GCadForm.PCad.Refresh; if (CheckFigureByClassName(GCadForm.PCad.TraceFigure, 'TOrthoLine')) then GCadForm.PCad.TraceFigure.NotNeedToDraw := True; GCadForm.PCad._DrawTrace; //для отрисовки новой trace shadow if (CheckFigureByClassName(GCadForm.PCad.TraceFigure, 'TOrthoLine')) then GCadForm.PCad.TraceFigure.NotNeedToDraw := false; end; end; //======================07.11.2013 самыков================================== procedure TConnectorObject.OnFindSnapTimer(Sender: TObject); //13.11.2013 самыков begin if not FFindSnapEnable then exit; // Tolik -- 15/03/2017 -- бывает, что таймер не успевает срабатывать и получаем вместо TConnectorObject // TRectangle (TraceFigure)? потом может произойти удаление коннектора (просто так), так что во избежание // добавлена проверка на имя класса // if GCadForm.PCad.TraceFigure = nil then if (GCadForm.PCad.TraceFigure = nil) or (GCadForm.PCad.TraceFigure.ClassName <> cTConnectorObject) then exit; //GCadForm.mProtocol.Lines.Add('timer'); FFindSnapEnable:=false; if FindSnapTimer.tag = 1 then begin //call from tracemodification GFigureSnap := TConnectorObject(GCadForm.PCad.TraceFigure).FindSnapObject(GCadForm.PCad.TraceFigure.ActualPoints[1].x, GCadForm.PCad.TraceFigure.ActualPoints[1].y); if (GPrevFigureSnap <> nil) AND (GPrevFigureSnap <> GFigureSnap) then DrawSnapFigures(GPrevFigureSnap, False); if GFigureSnap <> nil then begin DrawSnapFigures(GFigureSnap, True); GPrevFigureSnap := GFigureSnap; // Tolik 10/04/2017 -- //end; end else begin // IGOR - не нужно тут рефреш када - Толян был добавил, но не известно зачем (что этим рихтовалось?) // если делать рефреш - получим такое: //Небольшой баг - при перемещении за коннетор УГО - пропадает квадратик синий и изначальная трасса //"X:\Projects\Эксперт-СКС\! Screens\" bug_move_connector240.JPG //GCadForm.PCad.Refresh; end; end else FindObjectsOnMove(FDeltaPoint.x, FDeltaPoint.y); FFindSnapEnable:=true; FindSnapTimer.Enabled:=false; end; procedure TConnectorObject.CreateSnapTimer(CheckDrawStyle: Boolean = True); begin //if CheckDrawStyle and (DrawStyle <> dsTrace) then // exit; if FindSnapTimer <> nil then exit; FindSnapTimer := TTimer.Create(nil); FindSnapTimer.Enabled:=false; FindSnapTimer.OnTimer:=OnFindSnapTimer; if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin //if TPowerCad(GCadForm.PCad).Figures.Count > 1000 then if GCadForm.FCheckedFigures.Count > 1000 then FindSnapTimer.Interval := 150 else FindSnapTimer.Interval := 50; end else FindSnapTimer.Interval := 150; FFindSnapEnable:=true; end; procedure TOrthoLine.GetBoundsWithOutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); begin GetBounds(figMaxX, figMaxY, figMinX, figMinY); end; procedure TTextMod.GetBoundsWithoutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); begin GetBounds(figMaxX, figMaxY, figMinX, figMinY); end; procedure TFigureGrpMod.GetBoundsWithoutGrpSize(var figMaxX, figMaxY, figMinX, figMinY: Double); begin GetBounds(figMaxX, figMaxY, figMinX, figMinY); end; initialization if FigureClasses.IndexOf(TBetweenFloorDownVertex) = -1 then FigureClasses.Add(TBetweenFloorDownVertex); if FigureClasses.IndexOf(TBetweenFloorUpVertex) = -1 then FigureClasses.Add(TBetweenFloorUpVertex); end.